commit 7c464be0ef41b23b6f221fce8b8d5c405771eaad
parent 2816c8c7bae0ed0bacd00b77a9c5dd5d3ed19a42
Author: Tomas Hlavaty <tom@logand.com>
Date: Sun, 31 Aug 2014 21:55:57 +0200
der fixes and improvements
Diffstat:
| M | der.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
+
