cl-rw

Layered streams for Common Lisp
git clone https://logand.com/git/cl-rw.git/
Log | Files | Refs

commit 08efd6d9f21b422d9c7770709267fb20f81254d1
parent 7c464be0ef41b23b6f221fce8b8d5c405771eaad
Author: Tomas Hlavaty <tom@logand.com>
Date:   Sat, 20 Sep 2014 13:32:57 +0200

fix der decoder

Diffstat:
Mder.lisp | 38+++++++++++++++++++++++++++-----------
1 file changed, 27 insertions(+), 11 deletions(-)

diff --git a/der.lisp b/der.lisp @@ -83,7 +83,7 @@ (let ((m (rw:next-u8 reader)) (z 0)) ;; TODO as octet string? - (dotimes (i (1- n) (cons 'bit-string (ash z (- m)))) + (dotimes (i (1- n) (cons 'bit-string (cons m (ash z (- m))))) (setq z (logior (ash z 8) (rw:next-u8 reader))))))) (4 ;; octet-string ;; TODO variant with bounds @@ -239,16 +239,14 @@ (rw:write-u8 writer (if (cdr x) 255 0))) (bit-string (rw:write-u8 writer 3) - (let* ((x (cdr x)) - (nbits (ceiling (log x 2))) ;; TODO use integer-length - (nbytes (ceiling nbits 8)) - (m (- (* nbytes 8) nbits))) + (let* ((m (cadr x)) + (x (ash (cddr x) m)) + (nbytes (ceiling (log x 256)))) (len (+ 1 nbytes)) (rw:write-u8 writer m) - (do ((i (- nbits 8) (- i 8))) - ((minusp i)) - (rw:write-u8 writer (ldb (byte 8 i) x))) - (rw:write-u8 writer (ash (ldb (byte (- 8 m) 0) x) m)))) + (loop + for i from (1- nbytes) downto 0 + do (rw:write-u8 writer (ldb (byte 8 (* 8 i)) x))))) (oid (rw:write-u8 writer 6) (let* ((b (make-array 42 :fill-pointer 0 :adjustable t)) @@ -340,8 +338,26 @@ (48 14 2 1 #x80 6 9 #x2b 6 1 4 1 #x82 #x37 #x15 #x14)) ((set -128 (oid 1 3 6 1 4 1 311 21 20)) (49 16 48 14 2 1 #x80 6 9 #x2b 6 1 4 1 #x82 #x37 #x15 #x14)) - ((bit-string . #x12345) - (3 4 7 145 162 128))))) + ((bit-string 7 . #x12345) + (3 4 7 145 162 128)) + ((bit-string 0 . 2698675166254423367516254728464483749335066557673396396108386839514779489334034500324580997831747386071008453389756292324108345979589057920899409611221513386337727594567671688384339497590058060942411175326729608798043193698773547875145474433044091370658538092792546412868245105307028798977746453087673869761039285801616342559358044930049) + (3 129 141 0 + 48 129 137 2 129 129 0 190 108 252 172 88 61 44 244 2 196 54 234 121 210 + 210 109 187 113 178 18 221 62 24 169 233 140 184 208 68 149 157 121 142 + 197 120 199 45 11 143 102 161 53 203 99 66 68 198 7 185 44 217 3 172 75 + 207 70 140 178 29 180 232 112 37 121 95 238 135 94 47 141 217 157 50 42 + 42 90 233 119 5 180 145 138 55 114 178 56 28 117 191 40 208 75 167 181 + 49 36 201 14 178 137 153 55 95 175 220 201 180 9 124 38 129 234 159 152 + 83 53 138 75 187 159 227 220 197 148 150 3 101 147 2 3 1 0 1)) + ((bit-string 0 . 118034060124092381042289152588939068226888691459037221227696280629223206095830260576779540892200452501272518674360944045140270719338674600852168851119591300542021466662967353378826595297215969104790405581663753704791058639429297119582166792869070820194273847407288579294634063908956456813605370210920536000302) + (3 129 129 0 + 168 22 9 103 226 192 63 113 163 84 253 199 177 202 0 36 253 22 43 188 + 146 85 229 191 251 36 223 176 216 103 195 166 18 84 153 187 248 65 159 + 135 222 114 80 11 75 66 62 112 10 212 26 56 102 149 163 50 50 221 21 87 + 226 208 93 252 194 170 148 181 129 151 70 81 62 179 99 53 164 235 3 196 + 252 10 68 125 227 216 117 185 44 34 62 227 205 92 244 197 25 251 123 126 + 128 169 217 173 8 16 188 13 240 145 107 68 240 135 130 38 22 15 237 227 + 161 152 2 127 171 248 199 46))))) (dolist (test tests t) ;; (print (list :@@@ test)) ;; (finish-output)