cl-rw

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

commit 7c464be0ef41b23b6f221fce8b8d5c405771eaad
parent 2816c8c7bae0ed0bacd00b77a9c5dd5d3ed19a42
Author: Tomas Hlavaty <tom@logand.com>
Date:   Sun, 31 Aug 2014 21:55:57 +0200

der fixes and improvements

Diffstat:
Mder.lisp | 49+++++++++++++++++++++++++++++++++++--------------
1 file changed, 35 insertions(+), 14 deletions(-)

diff --git a/der.lisp b/der.lisp @@ -176,14 +176,14 @@ (defun encode (writer x) (labels ((len (n) (assert (<= 0 n)) - (if (logbitp 7 n) + (if (< n #x80) + (rw:write-u8 writer n) (let ((nn (ceiling (log n 256)))) - (assert (<= nn #x7f)) + (assert (<= 1 nn #x7f)) (rw:write-u8 writer (logior #x80 nn)) (loop for i from (1- nn) downto 0 - do (rw:write-u8 writer (ldb (byte 8 (* 8 i)) n)))) - (rw:write-u8 writer n))) + do (rw:write-u8 writer (ldb (byte 8 (* 8 i)) n)))))) (ascii (x) (len (length x)) (loop @@ -237,7 +237,18 @@ (rw:write-u8 writer 1) (rw:write-u8 writer 1) (rw:write-u8 writer (if (cdr x) 255 0))) - ;;(bit-string 3) + (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))) + (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)))) (oid (rw:write-u8 writer 6) (let* ((b (make-array 42 :fill-pointer 0 :adjustable t)) @@ -279,13 +290,17 @@ (ascii (cdr x))) (set (rw:write-u8 writer 49) - (let* ((b (make-array 42 :fill-pointer 0 :adjustable t)) - (w (rw:writer b))) - (encode w (cdr x)) - (len (length b)) - (loop - for x across b - do (rw:write-u8 writer x)))) + (seq (list (cdr x)))) + (???-key-identifier + (rw:write-u8 writer 80) + (seq (list (cdr x)))) + (???-signed-certificate-version + (rw:write-u8 writer 160) + ;; (int inside) 2 = signed certificate v3 + (seq (list (cdr x)))) + (???-signed-certificate-extensions + (rw:write-u8 writer 163) + (seq (list (cdr x)))) (t ;; sequence (rw:write-u8 writer 48) (seq x))))))) @@ -325,7 +340,8 @@ (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))))) (dolist (test tests t) ;; (print (list :@@@ test)) ;; (finish-output) @@ -337,7 +353,8 @@ ;;(decode (rw:reader '(6 6 #x2a #x86 #x48 #x86 #xf7 #x0d))) ;;(decode (rw:reader '(3 4 6 #x6e #x5d #xc0))) ; '(:bit-string "011011100101110111") -;;(encode w '(:bit-string "011011100101110111")) ;; '(3 4 6 #x6e #x5d #xc0) +;;(encode w '(bit-string "011011100101110111")) ;; '(3 4 6 #x6e #x5d #xc0) + (defun read-pem-key (reader) (let ((x (rw:till reader '(#\return #\newline)))) (rw:skip reader) @@ -381,3 +398,7 @@ (loop while (progn (rw:skip r) (rw:peek r)) collect (read-pem-key r))))) + +;;(read-pem-file "~/sw/gvfs/test/files/testcert.pem") +;;openssl x509 -in ~/sw/gvfs/test/files/testcert.pem -noout -text +