320 lines
7.8 KiB
Smalltalk
320 lines
7.8 KiB
Smalltalk
"
|
|
(C) 2011 by Holger Hans Peter Freyther
|
|
All Rights Reserved
|
|
|
|
This program is free software: you can redistribute it and/or modify
|
|
it under the terms of the GNU Affero General Public License as
|
|
published by the Free Software Foundation, either version 3 of the
|
|
License, or (at your option) any later version.
|
|
|
|
This program is distributed in the hope that it will be useful,
|
|
but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
GNU Affero General Public License for more details.
|
|
|
|
You should have received a copy of the GNU Affero General Public License
|
|
along with this program. If not, see <http://www.gnu.org/licenses/>.
|
|
"
|
|
|
|
Object subclass: BERTag [
|
|
| classType tagValue constructed |
|
|
<category: 'OsmoASN1'>
|
|
<comment: 'I am a TAG as of X.690'>
|
|
|
|
BERTag class >> classUniversal [
|
|
<category: 'class'>
|
|
^ 0
|
|
]
|
|
|
|
BERTag class >> classApplication [
|
|
<category: 'class'>
|
|
^ 1
|
|
]
|
|
|
|
BERTag class >> classContext [
|
|
<category: 'class'>
|
|
^ 2
|
|
]
|
|
|
|
BERTag class >> classPrivate [
|
|
<category: 'class'>
|
|
^ 3
|
|
]
|
|
|
|
BERTag class >> new [
|
|
<category: 'creation'>
|
|
^ super new initialize
|
|
]
|
|
|
|
BERTag class >> parseFrom: aStream [
|
|
<category: 'creation'>
|
|
^ self new
|
|
parseFrom: aStream;
|
|
yourself
|
|
]
|
|
|
|
BERTag class >> fromTuple: aTuple [
|
|
<category: 'creation'>
|
|
^ self new
|
|
fromTuple: aTuple;
|
|
yourself
|
|
]
|
|
|
|
BERTag class >> endOfContents [
|
|
<category: 'x690 types'>
|
|
^ self fromTuple: #(0 false 0)
|
|
]
|
|
|
|
BERTag class >> boolean [
|
|
<category: 'x690 types'>
|
|
^ self fromTuple: #(0 false 1)
|
|
]
|
|
|
|
BERTag class >> integer [
|
|
<category: 'x690 types'>
|
|
^ self fromTuple: #(0 false 2)
|
|
]
|
|
|
|
BERTag class >> octetString [
|
|
<category: 'x690 types'>
|
|
^ self fromTuple: #(0 false 4)
|
|
]
|
|
|
|
BERTag class >> null [
|
|
<category: 'x690 types'>
|
|
^ self fromTuple: #(0 false 5)
|
|
]
|
|
|
|
BERTag class >> enumerated [
|
|
<category: 'x690 types'>
|
|
^ self fromTuple: #(0 false 10)
|
|
]
|
|
|
|
BERTag class >> sequence [
|
|
<category: 'x690 types'>
|
|
^ self fromTuple: #(0 true 16)
|
|
]
|
|
|
|
BERTag class >> set [
|
|
<category: 'x690 types'>
|
|
^ self fromTuple: #(0 true 17)
|
|
]
|
|
|
|
initialize [
|
|
<category: 'init'>
|
|
classType := BERTag classUniversal.
|
|
tagValue := 0.
|
|
constructed := false.
|
|
]
|
|
|
|
= aOther [
|
|
<category: 'compare'>
|
|
|
|
(aOther isKindOf: self class) ifTrue: [^self asTuple = aOther asTuple].
|
|
^ self asTuple = aOther.
|
|
]
|
|
|
|
parseExtendedTag: aStream [
|
|
<category: 'decoding'>
|
|
|
|
^ self error: 'Extended tags are not implemented yet'.
|
|
]
|
|
|
|
parseFrom: aStream [
|
|
| tmp |
|
|
<category: 'decoding'>
|
|
|
|
tmp := aStream next.
|
|
classType := (tmp bitAnd: 16rC0) bitShift: -6.
|
|
constructed := (tmp bitAnd: 16r20) > 0.
|
|
tagValue := tmp bitAnd: 16r1F.
|
|
|
|
"This is an extended tag"
|
|
(tagValue = 16r1F) ifTrue: [
|
|
self parseExtendedTag: aStream.
|
|
].
|
|
]
|
|
|
|
fromTuple: aTuple [
|
|
<category: 'decoding'>
|
|
|
|
classType := aTuple first bitAnd: 16r3.
|
|
constructed := aTuple second.
|
|
tagValue := aTuple third.
|
|
]
|
|
|
|
writeExtendedTag: aStream [
|
|
<category: 'encoding'>
|
|
self error: 'Cannot encode extended tag.'
|
|
]
|
|
|
|
writeOn: aStream [
|
|
<category: 'encoding'>
|
|
tagValue >= 16r1F
|
|
ifTrue: [self writeExtendedTag: aStream.]
|
|
ifFalse: [| tag |
|
|
tag := classType bitShift: 6.
|
|
self isConstructed ifTrue: [tag := tag bitOr: 16r20].
|
|
tag := tag bitOr: self tagValue.
|
|
aStream nextPut: tag.
|
|
].
|
|
]
|
|
|
|
classType [
|
|
<category: 'accessing'>
|
|
^ classType
|
|
]
|
|
|
|
isConstructed [
|
|
<category: 'accessing'>
|
|
^ constructed
|
|
]
|
|
|
|
isPrimitive [
|
|
<category: 'accessing'>
|
|
^ self isConstructed not
|
|
]
|
|
|
|
tagValue [
|
|
<category: 'accessing'>
|
|
^ tagValue
|
|
]
|
|
|
|
asTuple [
|
|
<category: 'conversion'>
|
|
^ Array with: self classType with: self isConstructed with: self tagValue.
|
|
]
|
|
|
|
printOn: aStream [
|
|
<category: 'printing'>
|
|
^ aStream nextPutAll: '%1 %2' % {self class. self asTuple.}
|
|
]
|
|
]
|
|
|
|
Object subclass: BERLength [
|
|
<category: 'OsmoASN1'>
|
|
<comment: 'I can handle the length for definite and indefinite length. I wonder
|
|
of myself if I should be class or instance based or even be a SmallInteger or an
|
|
extension to a SmallInteger. Should I have a method called isIndefinite. Time will tell.'>
|
|
|
|
BERLength class >> new [
|
|
^ self error: 'Only use the class helper functions'
|
|
]
|
|
|
|
BERLength class >> parseMultiOctet: len from: aStream [
|
|
"I should handle paragraph 8.1.3.5. But I don't."
|
|
<category: 'private-decoding'>
|
|
^ self error: 'Decoding multi octet length is not implemented'.
|
|
]
|
|
|
|
BERLength class >> parseFrom: aStream [
|
|
| len |
|
|
<category: 'decoding'>
|
|
|
|
len := aStream next.
|
|
^ (len bitAnd: 16r80) > 0
|
|
ifTrue: [self parseMultiOctet: len from: aStream]
|
|
ifFalse: [len].
|
|
]
|
|
|
|
BERLength class >> writeMultiOctet: aLength on: aStream [
|
|
<category: 'private-encoding'>
|
|
^ self error: 'Multi octet writing is not implemented yet'.
|
|
]
|
|
|
|
BERLength class >> writeLength: aLength on: aStream [
|
|
<category: 'encoding'>
|
|
|
|
^ aLength > 16r7F
|
|
ifTrue: [self writeMultiOctet: aLength on: aStream]
|
|
ifFalse: [aStream nextPut: aLength].
|
|
]
|
|
]
|
|
|
|
Object subclass: BERTLVStream [
|
|
| base |
|
|
<category: 'OsmoASN1'>
|
|
<comment: 'I am a Tag Value Length (TLV) Stream for Basic Encoding Rules (BER)
|
|
of X.690 and provide very basic reading of a stream.'>
|
|
|
|
BERTLVStream class >> on: aStream [
|
|
<category: 'creation'>
|
|
^ self new
|
|
stream: aStream;
|
|
yourself
|
|
]
|
|
|
|
stream: aStream [
|
|
<category: 'init'>
|
|
base := aStream.
|
|
]
|
|
|
|
atEnd [
|
|
<category: 'decoding'>
|
|
^ base atEnd
|
|
]
|
|
|
|
next [
|
|
| tag len dat |
|
|
<category: 'decoding'>
|
|
|
|
tag := BERTag parseFrom: base.
|
|
len := BERLength parseFrom: base.
|
|
dat := base next: len.
|
|
|
|
^ Array with: tag with: dat.
|
|
]
|
|
|
|
nextAll [
|
|
| ret |
|
|
ret := OrderedCollection new.
|
|
|
|
[self atEnd] whileFalse: [ret add: self next].
|
|
|
|
^ ret
|
|
]
|
|
|
|
nextAllRecursive [
|
|
| ret |
|
|
ret := OrderedCollection new.
|
|
|
|
[self atEnd] whileFalse: [| dat |
|
|
dat := self next.
|
|
dat first isConstructed
|
|
ifTrue: [|other|
|
|
other := (self class on: dat second readStream) nextAllRecursive.
|
|
ret add: (Array with: dat first with: other)]
|
|
ifFalse: [ret add: dat].
|
|
].
|
|
|
|
^ ret
|
|
]
|
|
]
|
|
|
|
BERTLVStream subclass: DERTLVStream [
|
|
<category: 'OsmoASN1'>
|
|
<comment: 'I am DER Stream. I can produce valid DER streams
|
|
from a tupled input.'>
|
|
|
|
nextPut: aTuple [
|
|
aTuple first writeOn: base.
|
|
aTuple first isConstructed
|
|
ifTrue: [
|
|
| stream der |
|
|
stream := WriteStream on: (base species new: 1).
|
|
(self class on: stream) nextPutAll: aTuple second.
|
|
|
|
BERLength writeLength: stream contents size on: base.
|
|
base nextPutAll: stream contents.
|
|
]
|
|
ifFalse: [
|
|
BERLength writeLength: aTuple second size on: base.
|
|
base nextPutAll: aTuple second.
|
|
].
|
|
]
|
|
|
|
nextPutAll: aTupleList [
|
|
aTupleList do: [:each | self nextPut: each].
|
|
]
|
|
]
|