From ec1e5a94dbaee45a14c33f84e8a8446d378d9ea2 Mon Sep 17 00:00:00 2001
From: Holger Hans Peter Freyther <zecke@selfish.org>
Date: Tue, 29 Mar 2011 21:25:20 +0200
Subject: [PATCH] ber: Start with BER encoding/decoding for streams

Start with a very simple tag class
---
 BERTLVStream.st     | 140 ++++++++++++++++++++++++++++++++++++++++++++
 BERTLVStreamTest.st |  43 ++++++++++++++
 package.xml         |   4 ++
 3 files changed, 187 insertions(+)
 create mode 100644 BERTLVStream.st
 create mode 100644 BERTLVStreamTest.st

diff --git a/BERTLVStream.st b/BERTLVStream.st
new file mode 100644
index 0000000..ff15bc4
--- /dev/null
+++ b/BERTLVStream.st
@@ -0,0 +1,140 @@
+"
+ (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: 'osmo-asn1'>
+    <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
+    ]
+
+    initialize [
+        <category: 'init'>
+        classType := BERTag classUniversal.
+        tagValue := 0.
+        constructed := false.
+    ]
+
+    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 not.
+        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 isPrimitive with: self tagValue.
+    ]
+]
diff --git a/BERTLVStreamTest.st b/BERTLVStreamTest.st
new file mode 100644
index 0000000..52b57dc
--- /dev/null
+++ b/BERTLVStreamTest.st
@@ -0,0 +1,43 @@
+"
+ (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/>.
+"
+
+TestCase subclass: BERTagTest [
+    testSimpleTag [
+        <category: 'test'>
+        self assert: (BERTag parseFrom: #(16rA1) asByteArray readStream) asTuple = #(2 false 1).
+    ]
+
+    testFromTuple [
+        | tuple |
+        <category: 'test'>
+
+        tuple := #(2 false 1).
+        self assert: (BERTag fromTuple: tuple) asTuple = tuple.
+    ]
+
+    testWriteTuple [
+        | tuple stream |
+        <category: 'test'>
+
+        tuple := #(2 false 1).
+        stream := WriteStream on: (ByteArray new: 1).
+        (BERTag fromTuple: tuple) writeOn: stream.
+
+        self assert: stream contents = #(16rA1) asByteArray
+    ]
+]
diff --git a/package.xml b/package.xml
index 460e7ea..f22cbf3 100644
--- a/package.xml
+++ b/package.xml
@@ -3,10 +3,14 @@
     <namespace>Osmo</namespace>
 
     <filein>BER.st</filein>
+    <filein>BERTLVStream.st</filein>
 
     <test>
         <sunit>Osmo.BERTest</sunit>
+        <sunit>Osmo.BERTagTest</sunit>
+        <sunit>Osmo.BERTLVStreamTest</sunit>
         <filein>Tests.st</filein>
+        <filein>BERTLVStreamTest.st</filein>
     </test>
 
     <file>BER.st</file>