smalltalk
/
osmo-st-asn1
Archived
1
0
Fork 0
Code Pull Requests Releases Activity

ber: Remove the old Squeak ASN1 code that is not used anymore

master
Holger Hans Peter Freyther 2011-09-27 16:54:14 +02:00
parent b77da9be3f
commit 0c4edb83a2
3 changed files with 0 additions and 710 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

491
BER.st
View File

@ -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
View File

@ -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')
]
]

6
package.xml
View File

@ -2,19 +2,13 @@
<name>OsmoASN1</name>
<namespace>Osmo</namespace>
<filein>BER.st</filein>
<filein>BERTLVStream.st</filein>
<test>
<sunit>Osmo.BERTest</sunit>
<sunit>Osmo.BERTagTest</sunit>
<sunit>Osmo.BERTLVStreamTest</sunit>
<sunit>Osmo.BERLengthTest</sunit>
<sunit>Osmo.DERTLVStreamTest</sunit>
<filein>Tests.st</filein>
<filein>BERTLVStreamTest.st</filein>
</test>
<file>BER.st</file>
<file>Tests.st</file>
</package>