aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorHolger Hans Peter Freyther <zecke@selfish.org>2011-03-30 14:43:51 +0200
committerHolger Hans Peter Freyther <zecke@selfish.org>2011-03-30 14:43:51 +0200
commit4d5a287b1bc1f222a494fe2ff9f20bc0a207606b (patch)
treeca4468f03b3c1607a3ea580236892382f09195f4
parentac7437d3d496fd7e2bc6171ffb96d2bbad7f8e2a (diff)
ber: Create a simple DER Stream and test re-encoding
-rw-r--r--BERTLVStream.st26
-rw-r--r--BERTLVStreamTest.st22
-rw-r--r--package.xml1
3 files changed, 49 insertions, 0 deletions
diff --git a/BERTLVStream.st b/BERTLVStream.st
index 1b3235f..0488231 100644
--- a/BERTLVStream.st
+++ b/BERTLVStream.st
@@ -283,3 +283,29 @@ of X.690 and provide very basic reading of a stream.'>
^ ret
]
]
+
+BERTLVStream subclass: DERTLVStream [
+ <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].
+ ]
+]
diff --git a/BERTLVStreamTest.st b/BERTLVStreamTest.st
index ef470a2..113672d 100644
--- a/BERTLVStreamTest.st
+++ b/BERTLVStreamTest.st
@@ -112,3 +112,25 @@ TestCase subclass: BERTLVStreamTest [
self assert: value second size = 3.
]
]
+
+TestCase subclass: DERTLVStreamTest [
+ <comment: 'I test DER encoding to some degree'>
+
+ testDecodeEncodeAll [
+ | data decoded stream |
+ "I test that we can encode what we decode. At least to
+ some very very basic degree."
+
+ data := #(16rA1 16r13 16r02 16r01 16r04 16r02 16r01 16r3B
+ 16r30 16r0B 16r04 16r01 16r0F 16r04 16r06 16r2A
+ 16rD5 16r4C 16r16 16r1B 16r01) asByteArray.
+
+ decoded := (DERTLVStream on: data readStream) nextAllRecursive.
+
+ stream := WriteStream on: (ByteArray new: 20).
+ (DERTLVStream on: stream) nextPutAll: decoded.
+
+ self assert: data ~= decoded.
+ self assert: stream contents = data.
+ ]
+]
diff --git a/package.xml b/package.xml
index 52dfad9..4e10edc 100644
--- a/package.xml
+++ b/package.xml
@@ -10,6 +10,7 @@
<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>