ber: Remove the old Squeak ASN1 code that is not used anymore
This commit is contained in:
parent
b77da9be3f
commit
0c4edb83a2
491
BER.st
491
BER.st
|
@ -1,491 +0,0 @@
|
||||||
"======================================================================
|
|
||||||
|
|
|
||||||
| 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.
|
|
||||||
|
|
|
||||||
======================================================================"
|
|
||||||
|
|
||||||
|
|
||||||
Object subclass: BERElement [
|
|
||||||
| length lengthLength value tagHeader tagLength |
|
|
||||||
|
|
||||||
<category: 'LDAP-BER'>
|
|
||||||
<comment: nil>
|
|
||||||
|
|
||||||
BERElement class >> elementClasses [
|
|
||||||
^
|
|
||||||
{BERInteger.
|
|
||||||
BEROctetString.
|
|
||||||
BERSequence.
|
|
||||||
BEREnumerated.
|
|
||||||
BERBoolean.
|
|
||||||
BERSet.
|
|
||||||
BERNull.
|
|
||||||
|
|
||||||
}
|
|
||||||
]
|
|
||||||
|
|
||||||
BERElement class >> identifyIncomingElement: firstByte [
|
|
||||||
"so why are we doing this in a comparision here, instead of asking the class wether it handles the element?"
|
|
||||||
|
|
||||||
| type |
|
|
||||||
type := self elementClasses
|
|
||||||
detect: [:each | each tagValue = firstByte asInteger]
|
|
||||||
ifNone: [nil].
|
|
||||||
^type
|
|
||||||
]
|
|
||||||
|
|
||||||
BERElement class >> new [
|
|
||||||
"this is here only to easily see who is using it down the heriarchy through the browser"
|
|
||||||
|
|
||||||
^self basicNew initialize
|
|
||||||
]
|
|
||||||
|
|
||||||
BERElement class >> newFrom: aStream [
|
|
||||||
| firstByte element elementClass |
|
|
||||||
firstByte := aStream next.
|
|
||||||
"Transcript show: '*** Next byte is: ', firstByte asString; cr."
|
|
||||||
elementClass := self identifyIncomingElement: firstByte.
|
|
||||||
elementClass ifNil:
|
|
||||||
[self error:
|
|
||||||
'invalid tag -- make sure class is in identifyIncomingElements: ', firstByte asString.].
|
|
||||||
element := elementClass new setTag: firstByte.
|
|
||||||
"we should read the tag here, instead of just the first byte"
|
|
||||||
element readLengthFrom: aStream.
|
|
||||||
element decode: aStream.
|
|
||||||
^element
|
|
||||||
]
|
|
||||||
|
|
||||||
BERElement class >> tagValue [
|
|
||||||
self subclassResponsibility
|
|
||||||
]
|
|
||||||
|
|
||||||
decode: aStream [
|
|
||||||
self subclassResponsibility
|
|
||||||
]
|
|
||||||
|
|
||||||
initialize [
|
|
||||||
tagHeader := 0
|
|
||||||
]
|
|
||||||
|
|
||||||
length [
|
|
||||||
^length
|
|
||||||
]
|
|
||||||
|
|
||||||
lengthLength [
|
|
||||||
^lengthLength
|
|
||||||
]
|
|
||||||
|
|
||||||
readLengthFrom: aStream [
|
|
||||||
| octets firstOctet |
|
|
||||||
firstOctet := aStream next asInteger.
|
|
||||||
firstOctet < 128
|
|
||||||
ifTrue:
|
|
||||||
["short definite length"
|
|
||||||
|
|
||||||
length := firstOctet.
|
|
||||||
lengthLength := 1]
|
|
||||||
ifFalse:
|
|
||||||
["long definite length"
|
|
||||||
|
|
||||||
octets := aStream next: (firstOctet bitXor: 128).
|
|
||||||
lengthLength := (firstOctet bitXor: 128) + 1. "the lengthlenghlength byte.. ugh."
|
|
||||||
length := octets contents inject: 0
|
|
||||||
into: [:injectedValue :each | (injectedValue bitShift: 8) + each asInteger]].
|
|
||||||
^length
|
|
||||||
]
|
|
||||||
|
|
||||||
setTag: aTag [
|
|
||||||
tagHeader := aTag.
|
|
||||||
tagLength := 1
|
|
||||||
]
|
|
||||||
|
|
||||||
tagLength [
|
|
||||||
^1
|
|
||||||
]
|
|
||||||
|
|
||||||
tagSetApplication [
|
|
||||||
tagHeader := tagHeader bitOr: 64
|
|
||||||
]
|
|
||||||
|
|
||||||
tagSetContext [
|
|
||||||
tagHeader := tagHeader bitOr: 128
|
|
||||||
]
|
|
||||||
|
|
||||||
totalLength [
|
|
||||||
^self length + self lengthLength + self tagLength
|
|
||||||
]
|
|
||||||
|
|
||||||
value [
|
|
||||||
^value
|
|
||||||
]
|
|
||||||
|
|
||||||
value: aValue [
|
|
||||||
value := aValue
|
|
||||||
]
|
|
||||||
|
|
||||||
writeBodyOn: aStream [
|
|
||||||
self subclassResponsibility
|
|
||||||
]
|
|
||||||
|
|
||||||
writeLength: aLength on: aStream [
|
|
||||||
| octets octetsIndex remainderValue netOctets |
|
|
||||||
octetsIndex := 1.
|
|
||||||
aLength < 128
|
|
||||||
ifTrue:
|
|
||||||
["short definite length"
|
|
||||||
|
|
||||||
aStream nextPut: (Character value: aLength)
|
|
||||||
|
|
||||||
"long definite length"]
|
|
||||||
ifFalse:
|
|
||||||
["why were we using value in this block, instead of aLength?"
|
|
||||||
|
|
||||||
octets := ByteArray new: (self intDigitLength: aLength) + 1.
|
|
||||||
remainderValue := aLength.
|
|
||||||
[remainderValue > 0] whileTrue:
|
|
||||||
[octets at: octetsIndex put: (remainderValue bitAnd: 255).
|
|
||||||
octetsIndex := octetsIndex + 1.
|
|
||||||
remainderValue := remainderValue bitShift: -8].
|
|
||||||
octets at: octetsIndex put: (octetsIndex - 1 bitOr: 128).
|
|
||||||
|
|
||||||
"hton"
|
|
||||||
netOctets := ByteArray new: octetsIndex.
|
|
||||||
(1 to: octetsIndex)
|
|
||||||
do: [:i | netOctets at: i put: (octets at: octetsIndex + 1 - i)].
|
|
||||||
aStream nextPutAll: netOctets asString].
|
|
||||||
^octetsIndex
|
|
||||||
]
|
|
||||||
|
|
||||||
writeOn: aStream [
|
|
||||||
aStream nextPut: (Character value: (self class tagValue bitOr: tagHeader)).
|
|
||||||
self writeBodyOn: aStream
|
|
||||||
]
|
|
||||||
|
|
||||||
writeOn: aStream withTag: aTag [
|
|
||||||
| combinedTag |
|
|
||||||
combinedTag := self class tagValue bitOr: tagHeader.
|
|
||||||
|
|
||||||
"here we are supposing that if we are given a tag, we dont need the universal tag value
|
|
||||||
im not really sure on wether its correct or not ."
|
|
||||||
|
|
||||||
"however, we are in .25 and its proved to be correct so far"
|
|
||||||
aTag ifNotNil:
|
|
||||||
[combinedTag := (combinedTag bitOr: 31) bitXor: 31.
|
|
||||||
combinedTag := combinedTag bitOr: aTag].
|
|
||||||
aStream nextPut: (Character value: combinedTag).
|
|
||||||
self writeBodyOn: aStream
|
|
||||||
]
|
|
||||||
]
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
BERElement subclass: BERBoolean [
|
|
||||||
|
|
||||||
<category: 'LDAP-BER'>
|
|
||||||
<comment: nil>
|
|
||||||
|
|
||||||
BERBoolean class >> tagValue [
|
|
||||||
^1
|
|
||||||
]
|
|
||||||
|
|
||||||
decode: aStream [
|
|
||||||
value := aStream next.
|
|
||||||
value := value > 0
|
|
||||||
]
|
|
||||||
|
|
||||||
writeBodyOn: aStream [
|
|
||||||
self writeLength: 1 on: aStream.
|
|
||||||
(value = 0 or: [value = false])
|
|
||||||
ifTrue: [aStream nextPut: (Character value: 0)]
|
|
||||||
ifFalse: [aStream nextPut: (Character value: 255)]
|
|
||||||
]
|
|
||||||
]
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
BERElement subclass: BERConstruct [
|
|
||||||
| elements |
|
|
||||||
|
|
||||||
<category: 'LDAP-BER'>
|
|
||||||
<comment: nil>
|
|
||||||
|
|
||||||
BERConstruct class >> new [
|
|
||||||
^self basicNew initialize
|
|
||||||
]
|
|
||||||
|
|
||||||
addElement: anElement [
|
|
||||||
self addElement: anElement withTag: nil
|
|
||||||
]
|
|
||||||
|
|
||||||
addElement: anElement withTag: aContextTag [
|
|
||||||
| taggedElement |
|
|
||||||
taggedElement := Association
|
|
||||||
new;
|
|
||||||
key: aContextTag value: anElement.
|
|
||||||
elements addLast: taggedElement
|
|
||||||
]
|
|
||||||
|
|
||||||
decode: aStream [
|
|
||||||
| elementLen part |
|
|
||||||
elementLen := self length.
|
|
||||||
[elementLen > 0] whileTrue:
|
|
||||||
[part := self class newFrom: aStream.
|
|
||||||
elementLen := elementLen - part totalLength.
|
|
||||||
self addElement: part]
|
|
||||||
]
|
|
||||||
|
|
||||||
elements [
|
|
||||||
^elements
|
|
||||||
]
|
|
||||||
|
|
||||||
initialize [
|
|
||||||
super initialize.
|
|
||||||
elements := OrderedCollection new
|
|
||||||
]
|
|
||||||
|
|
||||||
writeBodyOn: aStream [
|
|
||||||
| data dataStream |
|
|
||||||
data := Array new.
|
|
||||||
dataStream := WriteStream on: data.
|
|
||||||
elements
|
|
||||||
do: [:taggedElement | taggedElement value writeOn: dataStream withTag: taggedElement key].
|
|
||||||
|
|
||||||
"shouldnt we move this somewhere else?"
|
|
||||||
self writeLength: dataStream contents size on: aStream.
|
|
||||||
aStream nextPutAll: dataStream contents
|
|
||||||
]
|
|
||||||
]
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
BERElement subclass: BERInteger [
|
|
||||||
|
|
||||||
<category: 'LDAP-BER'>
|
|
||||||
<comment: nil>
|
|
||||||
|
|
||||||
BERInteger class >> tagValue [
|
|
||||||
^2
|
|
||||||
]
|
|
||||||
|
|
||||||
decode: aStream [
|
|
||||||
| highBitPos xorMask |
|
|
||||||
value := 0.
|
|
||||||
(1 to: length)
|
|
||||||
do: [:i | value := (value bitShift: 8) + aStream next asInteger].
|
|
||||||
|
|
||||||
"if the high bit is set, we have negative"
|
|
||||||
highBitPos := value highBit.
|
|
||||||
highBitPos = (length * 8)
|
|
||||||
ifTrue:
|
|
||||||
[xorMask := (1 bitShift: highBitPos) - 1.
|
|
||||||
value := value bitXor: xorMask.
|
|
||||||
value := (value + 1) negated]
|
|
||||||
]
|
|
||||||
|
|
||||||
intDigitLength: anInt [
|
|
||||||
"From Squeak: SmallInteger digitlength.
|
|
||||||
Called from BERInteger writeBodyOn: "
|
|
||||||
|
|
||||||
"Answer the number of indexable fields in the receiver. This value is the
|
|
||||||
same as the largest legal subscript. Included so that a SmallInteger can
|
|
||||||
behave like a LargePositiveInteger or LargeNegativeInteger."
|
|
||||||
|
|
||||||
(anInt < 16r100 and: [anInt > -16r100]) ifTrue: [^ 1].
|
|
||||||
(anInt < 16r10000 and: [anInt > -16r10000]) ifTrue: [^ 2].
|
|
||||||
(anInt < 16r1000000 and: [anInt > -16r1000000]) ifTrue: [^ 3].
|
|
||||||
^ 4
|
|
||||||
]
|
|
||||||
|
|
||||||
writeBodyOn: aStream [
|
|
||||||
| octets netOctets isNegative remainderValue octetsIndex |
|
|
||||||
isNegative := value < 0.
|
|
||||||
octets := ByteArray new: (self intDigitLength: value) + 2.
|
|
||||||
|
|
||||||
"put value into octet array, covert negatives as appropiate"
|
|
||||||
isNegative not
|
|
||||||
ifTrue:
|
|
||||||
[value = 0
|
|
||||||
ifTrue:
|
|
||||||
[octetsIndex := 1.
|
|
||||||
octets at: octetsIndex put: 0]
|
|
||||||
ifFalse:
|
|
||||||
[remainderValue := value.
|
|
||||||
octetsIndex := 0.
|
|
||||||
[remainderValue > 0] whileTrue:
|
|
||||||
[octetsIndex := octetsIndex + 1.
|
|
||||||
octets at: octetsIndex put: (remainderValue bitAnd: 255).
|
|
||||||
remainderValue := remainderValue bitShift: -8]]]
|
|
||||||
ifFalse:
|
|
||||||
["negatives are in two's complement -- to convert: 1. change to positive. 2. substract 1, 3. xor everythnig"
|
|
||||||
|
|
||||||
remainderValue := value negated.
|
|
||||||
remainderValue := remainderValue - 1.
|
|
||||||
octetsIndex := 0.
|
|
||||||
|
|
||||||
[octetsIndex := octetsIndex + 1.
|
|
||||||
octets at: octetsIndex put: ((remainderValue bitXor: 255) bitAnd: 255).
|
|
||||||
remainderValue := remainderValue bitShift: -8.
|
|
||||||
remainderValue > 0]
|
|
||||||
whileTrue].
|
|
||||||
|
|
||||||
"if originally we had a positive, and highest bit is set in the beginning of the array, we prefix the array with a zero byte"
|
|
||||||
"if said bit is set and original was negative, prefix with a all-ones byte"
|
|
||||||
"we actually test the end of the array because we are switching it around later for network order"
|
|
||||||
value > 0
|
|
||||||
ifTrue:
|
|
||||||
[((octets at: octetsIndex) bitAnd: 128) > 0
|
|
||||||
ifTrue:
|
|
||||||
[octetsIndex := octetsIndex + 1.
|
|
||||||
octets at: octetsIndex put: 0]].
|
|
||||||
value < 0
|
|
||||||
ifTrue:
|
|
||||||
[((octets at: octetsIndex) bitAnd: 128) = 0
|
|
||||||
ifTrue:
|
|
||||||
[octetsIndex := octetsIndex + 1.
|
|
||||||
octets at: octetsIndex put: 255]].
|
|
||||||
|
|
||||||
"hton"
|
|
||||||
netOctets := ByteArray new: octetsIndex.
|
|
||||||
(1 to: octetsIndex)
|
|
||||||
do: [:i | netOctets at: i put: (octets at: octetsIndex + 1 - i)].
|
|
||||||
self writeLength: octetsIndex on: aStream.
|
|
||||||
aStream nextPutAll: netOctets asString.
|
|
||||||
^octetsIndex
|
|
||||||
]
|
|
||||||
]
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
BERInteger subclass: BEREnumerated [
|
|
||||||
|
|
||||||
<category: 'LDAP-BER'>
|
|
||||||
<comment: nil>
|
|
||||||
|
|
||||||
BEREnumerated class >> tagValue [
|
|
||||||
^10
|
|
||||||
]
|
|
||||||
|
|
||||||
decode: aStream [
|
|
||||||
super decode: aStream
|
|
||||||
]
|
|
||||||
]
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
BERElement subclass: BERNull [
|
|
||||||
|
|
||||||
<category: 'LDAP-BER'>
|
|
||||||
<comment: nil>
|
|
||||||
|
|
||||||
BERNull class >> tagValue [
|
|
||||||
^5
|
|
||||||
]
|
|
||||||
|
|
||||||
decode: aStream [
|
|
||||||
"not sure about this.. should it be 0?"
|
|
||||||
|
|
||||||
"length := 1."
|
|
||||||
|
|
||||||
value := nil
|
|
||||||
]
|
|
||||||
|
|
||||||
writeBodyOn: aStream [
|
|
||||||
self writeLength: 0 on: aStream
|
|
||||||
]
|
|
||||||
]
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
BERElement subclass: BEROctetString [
|
|
||||||
|
|
||||||
<category: 'LDAP-BER'>
|
|
||||||
<comment: nil>
|
|
||||||
|
|
||||||
BEROctetString class >> tagValue [
|
|
||||||
^4
|
|
||||||
]
|
|
||||||
|
|
||||||
decode: aStream [
|
|
||||||
value := aStream next: length
|
|
||||||
]
|
|
||||||
|
|
||||||
writeBodyOn: aStream [
|
|
||||||
self writeLength: value size on: aStream.
|
|
||||||
aStream nextPutAll: value.
|
|
||||||
"theorically we should convert it to UTF8"
|
|
||||||
^value size
|
|
||||||
]
|
|
||||||
]
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
BERConstruct subclass: BERSequence [
|
|
||||||
|
|
||||||
<category: 'LDAP-BER'>
|
|
||||||
<comment: nil>
|
|
||||||
|
|
||||||
BERSequence class >> tagValue [
|
|
||||||
"SEQUENCE + Constructed"
|
|
||||||
|
|
||||||
^16 + 32
|
|
||||||
]
|
|
||||||
|
|
||||||
decode: aStream [
|
|
||||||
^super decode: aStream
|
|
||||||
]
|
|
||||||
]
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
BERConstruct subclass: BERSet [
|
|
||||||
|
|
||||||
<category: 'LDAP-BER'>
|
|
||||||
<comment: nil>
|
|
||||||
|
|
||||||
BERSet class >> tagValue [
|
|
||||||
"SET + Constructed"
|
|
||||||
|
|
||||||
^17 + 32
|
|
||||||
]
|
|
||||||
|
|
||||||
decode: aStream [
|
|
||||||
^super decode: aStream
|
|
||||||
]
|
|
||||||
]
|
|
||||||
|
|
||||||
|
|
213
Tests.st
213
Tests.st
|
@ -1,213 +0,0 @@
|
||||||
"======================================================================
|
|
||||||
|
|
|
||||||
| 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 )
|
|
||||||
]
|
|
||||||
]
|
|
||||||
|
|
||||||
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')
|
|
||||||
]
|
|
||||||
|
|
||||||
]
|
|
||||||
|
|
|
@ -2,19 +2,13 @@
|
||||||
<name>OsmoASN1</name>
|
<name>OsmoASN1</name>
|
||||||
<namespace>Osmo</namespace>
|
<namespace>Osmo</namespace>
|
||||||
|
|
||||||
<filein>BER.st</filein>
|
|
||||||
<filein>BERTLVStream.st</filein>
|
<filein>BERTLVStream.st</filein>
|
||||||
|
|
||||||
<test>
|
<test>
|
||||||
<sunit>Osmo.BERTest</sunit>
|
|
||||||
<sunit>Osmo.BERTagTest</sunit>
|
<sunit>Osmo.BERTagTest</sunit>
|
||||||
<sunit>Osmo.BERTLVStreamTest</sunit>
|
<sunit>Osmo.BERTLVStreamTest</sunit>
|
||||||
<sunit>Osmo.BERLengthTest</sunit>
|
<sunit>Osmo.BERLengthTest</sunit>
|
||||||
<sunit>Osmo.DERTLVStreamTest</sunit>
|
<sunit>Osmo.DERTLVStreamTest</sunit>
|
||||||
<filein>Tests.st</filein>
|
|
||||||
<filein>BERTLVStreamTest.st</filein>
|
<filein>BERTLVStreamTest.st</filein>
|
||||||
</test>
|
</test>
|
||||||
|
|
||||||
<file>BER.st</file>
|
|
||||||
<file>Tests.st</file>
|
|
||||||
</package>
|
</package>
|
||||||
|
|
Reference in New Issue