From 0c4edb83a281951d847c61f296ef6f6e9b6b7b9c Mon Sep 17 00:00:00 2001 From: Holger Hans Peter Freyther Date: Tue, 27 Sep 2011 16:54:14 +0200 Subject: [PATCH] ber: Remove the old Squeak ASN1 code that is not used anymore --- BER.st | 491 ---------------------------------------------------- Tests.st | 213 ----------------------- package.xml | 6 - 3 files changed, 710 deletions(-) delete mode 100644 BER.st delete mode 100644 Tests.st diff --git a/BER.st b/BER.st deleted file mode 100644 index 3f8037f..0000000 --- a/BER.st +++ /dev/null @@ -1,491 +0,0 @@ -"====================================================================== -| -| Copyright (c) 2004-2009 -| Ragnar Hojland Espinosa , -| -| 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 | - - - - - 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 [ - - - - - 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 | - - - - - 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 [ - - - - - 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 [ - - - - - BEREnumerated class >> tagValue [ - ^10 - ] - - decode: aStream [ - super decode: aStream - ] -] - - - - -BERElement subclass: BERNull [ - - - - - 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 [ - - - - - 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 [ - - - - - BERSequence class >> tagValue [ - "SEQUENCE + Constructed" - - ^16 + 32 - ] - - decode: aStream [ - ^super decode: aStream - ] -] - - - - -BERConstruct subclass: BERSet [ - - - - - BERSet class >> tagValue [ - "SET + Constructed" - - ^17 + 32 - ] - - decode: aStream [ - ^super decode: aStream - ] -] - - diff --git a/Tests.st b/Tests.st deleted file mode 100644 index 89ae64f..0000000 --- a/Tests.st +++ /dev/null @@ -1,213 +0,0 @@ -"====================================================================== -| -| Copyright (c) 2004-2009 -| Ragnar Hojland Espinosa , -| -| 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') - ] - -] - diff --git a/package.xml b/package.xml index 4e10edc..c762018 100644 --- a/package.xml +++ b/package.xml @@ -2,19 +2,13 @@ OsmoASN1 Osmo - BER.st BERTLVStream.st - Osmo.BERTest Osmo.BERTagTest Osmo.BERTLVStreamTest Osmo.BERLengthTest Osmo.DERTLVStreamTest - Tests.st BERTLVStreamTest.st - - BER.st - Tests.st