diff options
Diffstat (limited to 'Tests.st')
-rw-r--r-- | Tests.st | 287 |
1 files changed, 287 insertions, 0 deletions
diff --git a/Tests.st b/Tests.st new file mode 100644 index 0000000..eb683de --- /dev/null +++ b/Tests.st @@ -0,0 +1,287 @@ +"====================================================================== +| +| Copyright (c) 2004-2009 +| Ragnar Hojland Espinosa <ragnar@ragnar-hojland.com>, +| +| Contributions by: +| Göran Krampe +| Andreas Raab +| +| Ported by: +| Stephen Woolerton +| +| Permission is hereby granted, free of charge, to any person obtaining +| a copy of this software and associated documentation files (the +| 'Software'), to deal in the Software without restriction, including +| without limitation the rights to use, copy, modify, merge, publish, +| distribute, sublicense, and/or sell copies of the Software, and to +| permit persons to whom the Software is furnished to do so, subject to +| the following conditions: +| +| The above copyright notice and this permission notice shall be +| included in all copies or substantial portions of the Software. +| +| THE SOFTWARE IS PROVIDED 'AS IS', WITHOUT WARRANTY OF ANY KIND, +| EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +| MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. +| IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY +| CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, +| TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE +| SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. +| + ======================================================================" + +TestCase subclass: BERTest [ + + BERTest class >> getBooleanTestSet [ + ^ { { 0 . '010100' }. + { 1 . '0101FF' }. + { 255 . '0101FF' }. + { 1000 . '0101FF' }. + { false . '010100' }. + { true . '0101FF' }. + } + ] + + testBooleanEncoding [ + |ber stream tests output | + ber := BERBoolean new. + stream := ReadWriteStream on: (String new). + + tests := self class getBooleanTestSet. + tests do: [:test | + stream := ReadWriteStream on: (String new). + ber value: (test at: 1). + Transcript cr; showCr: ('value: %1, BooleanEncoded: %2' bindWith: (test at: 1) with: (test at: 2)). + ber writeOn: stream. + output := self stringHex: stream contents asString. + Transcript show: 'Expected: ', (test at: 2), ' Got: ', output; cr. + self assert: (output = (test at: 2)) ] + ] + + stringHex: aString [ + | stream | + stream := WriteStream on: (String new: self size * 4). + aString do: [ :ch | stream nextPutAll: (self charHex: ch) ]. + ^stream contents + ] + + charHex: ch [ + | hexVal | + ^(ch value < 16) + ifTrue: ['0',(ch value printString: 16)] + ifFalse: [ch value printString: 16] + ] + + BERTest class >> getIntegerTestSet [ + ^ { {27066 . '020269BA'}. + {-27066 . '02029646'}. + {72 . '020148' }. + {127 . '02017F'}. + {-128. '020180'}. + {128 . '02020080'}. + { 0 . '020100' }. + { 256 . '02020100'}. + {4294967290 . '020500FFFFFFFA'}. + { 1 . '020101'}. + {-1 . '0201FF'}. + { -129 . '0202FF7F'}. + } + ] + + testIntegerEncoding [ + | ber byte stream tests output valueStream value | + + ber := BERInteger new. + stream := ReadWriteStream on: (String new). + + tests := self class getIntegerTestSet. + + + tests do: [:test | + valueStream := ReadStream on: (test at: 2). + value := test at: 1. + "made stream a string as notthing in it. Have found asCharacter + is the problem so TODO is put stream declaration back how it was" + stream := ReadWriteStream on: (String new). + Transcript cr; showCr: 'value: ', value printString, ' IntegerEncoded: ',valueStream contents. + + [valueStream atEnd] whileFalse: [ + byte := (valueStream next digitValue ) * 16. + byte := byte + valueStream next digitValue. + "code below, don't use 'byte asCharacter' since if + value >127 get UnicodeCharacter returned" + stream nextPut: (Character value: byte) ] . + stream reset. + ber := BERInteger newFrom: stream. + "(ber class = BERInteger) ifTrue: [Transcript showCr: 'isBERInt']." + Transcript showCr: 'Expected: ', (value printString),' Got: ', (ber value printString). + self assert: (ber value = value ) + ] + ] + +testOctetStringEncoding [ + |ber stream tests| + ber := BEROctetString new. + stream := ReadWriteStream on: (String new). + + tests := { { 'hello' . 5 . '040568656C6C6F' } }. + + tests do: [:test | + stream := ReadWriteStream on: (String new). + ber value: (test at: 1). + ber writeOn: stream. + self assert: ((self stringHex: stream contents asString) = (test at: 3)) ] +] + + testSequenceEncoding [ + |ber0 ber1 ber2 stream| + ber0 := BERSequence new. + ber1 := BERInteger new value: 17. + ber2 := BERInteger new value: 170. + + ber0 addElement: ber1. + ber0 addElement: ber2. + stream := ReadWriteStream on: (String new). + + ber0 writeOn: stream. + '' displayNl.'Sequence Encoding Test ...' displayNl. stream contents inspect displayNl. + "self assert: (stream contents asString asHex = '3007020111020200AA') " + self assert: ((self stringHex: (stream contents asString)) = '3007020111020200AA') + ] + + + + + testIntegerDecoding [ + "changes are + 1. no stream reset command in GST so just reinitialize same as the first time + 2. No asCharacter, use Character value: byte instread + 3. Instead as asString in the Transcript, use printString" + + |ber stream tests value valueStream byte | + stream := ReadWriteStream on: (String new). + + tests := self class getIntegerTestSet. + '' displayNl.'Integer Decoding Test ...' displayNl. + tests do: [:test | + valueStream := ReadStream on: (test at: 2). + value := test at: 1. + stream := ReadWriteStream on: (String new). + + [valueStream atEnd] whileFalse: [ + byte := (valueStream next digitValue * 16). + byte := byte + valueStream next digitValue. + "stream nextPut: (byte asCharacter) + code below, don't use 'byte asCharacter' since if + value >127 get UnicodeCharacter returned" + stream nextPut: (Character value: byte) ] . + + stream reset. + ber := BERInteger newFrom: stream. + "self assert: (ber class = BERInteger)." + + Transcript show: 'Expected: ', (value printString), ' Got: ', (ber value printString); cr. "stream contents inspect displayNl." + self assert: (ber value = value ) + ] + ] + + testBindRequest [ + | encoded | + '' displayNl.'Beginning testBindRequest...' displayNl. + + encoded _ LDAPEncoder bindRequest: 1 username: 'cn=admin,dc=linalco,dc=test' credentials: 'secret' method: nil. + "encoded _ encoded asString asHex." + encoded := self stringHex: encoded asString. + + Transcript show: 'testBindRequest got: ', encoded; cr. + self assert: (encoded = '302D0201016028020103041B636E3D61646D696E2C64633D6C696E616C636F2C64633D746573748006736563726574') + ] + + + + testBindRequestHere [ + | stream mesg req encoded | + stream := ReadWriteStream on: String new. + mesg := BERSequence new. + mesg addElement: (BERInteger new value: 1). + + req := BERSequence new tagSetApplication. + req addElement: (BERInteger new value: 3). + req addElement: (BEROctetString new value: 'cn=admin,dc=linalco,dc=test'). + req addElement: ((BEROctetString new) + tagSetContext; + value: 'secret') + withTag: 0. + mesg addElement: req withTag: 0. + mesg writeOn: stream. + encoded := stream contents. + encoded inspect. + encoded := self stringHex: encoded asString. + + Transcript show: 'testBindRequest got: ', encoded; cr. + self assert: (encoded = '302D0201016028020103041B636E3D61646D696E2C64633D6C696E616C636F2C64633D746573748006736563726574') + ] + + testAddRequest [ + | encoded attrs | + attrs := Dictionary new. + attrs at: 'objectClass' put: (OrderedCollection new addLast: 'person'; yourself). + attrs at: 'cn' put: (OrderedCollection new addLast: 'test2'; yourself). + attrs at: 'sn' put: (OrderedCollection new addLast: 'test2'; yourself). + + encoded := LDAPEncoder addRequest: 1 dn: 'cn=test2,dc=linalco,dc=test' attrs: attrs. + encoded := self stringHex: encoded asString ."original code uses an 'asHex' method" + + '' displayNl. Transcript show: 'testAddRequest got: ', encoded; cr; cr. + self assert: (encoded = '305B0201016856041B636E3D74657374322C64633D6C696E616C636F2C64633D7465737430373017040B6F626A656374436C61737331080406706572736F6E300D0402636E310704057465737432300D0402736E310704057465737432') + ] + + testDelRequest [ + | encoded | + encoded := LDAPEncoder delRequest: 1 dn: 'cn=test2,dc=linalco,dc=test'. + encoded := self stringHex: encoded asString ."original code uses an 'asHex' method" + + Transcript show: 'testDelRequest got: ', encoded; cr; cr. + self assert: (encoded = '30200201014A1B636E3D74657374322C64633D6C696E616C636F2C64633D74657374') + ] + + testModifyRequest [ + | encoded ops | + ops := { + LDAPAttrModifier set: 'sn' to: { 'test5sn' . 'foo' . 'bar' } . + LDAPAttrModifier addTo: 'description' values: {'rchueo'} }. + encoded := LDAPEncoder modifyRequest: 1 dn: 'cn=test5,dc=linalco,dc=test' ops: ops. + encoded := self stringHex: encoded asString ."original code uses an 'asHex' method" + + Transcript show: 'testModifyRequest got: ', encoded; cr. + self assert: (encoded = '3062020101665D041B636E3D74657374352C64633D6C696E616C636F2C64633D74657374303E301E0A010230190402736E311304077465737435736E0403666F6F0403626172301C0A01003017040B6465736372697074696F6E3108040672636875656F') + + ] + + testSearchRequest [ + | encoded | + encoded := LDAPEncoder searchRequest: 1 base: 'dc=linalco, dc=test' scope: (LDAPConnection wholeSubtree) deref: (LDAPConnection derefNever) filter: (LDAPFilter with: 'objectclass' ) attrs: (OrderedCollection new) wantAttrsOnly: false. + encoded := self stringHex: encoded asString ."original code uses an 'asHex' method" + + '' displayNl. Transcript show: 'testSearchRequest got: ', encoded; cr. + self assert: (encoded = '30380201016333041364633D6C696E616C636F2C2064633D746573740A01020A0100020100020100010100870B6F626A656374636C6173733000') + ] + + +] + +" ------------------------------------- " +| suite tester | +suite := TestSuite named: 'Set Tests'. +suite addTest: (BERTest selector: #testIntegerEncoding). +suite addTest: (BERTest selector: #testBooleanEncoding). +suite addTest: (BERTest selector: #testOctetStringEncoding). +suite addTest: (BERTest selector: #testSequenceEncoding). +suite addTest: (BERTest selector: #testIntegerDecoding). +suite addTest: (BERTest selector: #testBindRequest) . +suite addTest: (BERTest selector: #testAddRequest). +suite addTest: (BERTest selector: #testDelRequest). +suite addTest: (BERTest selector: #testModifyRequest). +suite addTest: (BERTest selector: #testSearchRequest). + |