commit 9b173e2b93cc88b06b8fd7f29cd1655edc3df89f
parent 8d003f61b730453806db6149dce10700eae272f0
Author: Tomas Hlavaty <tom@logand.com>
Date: Sun, 3 Aug 2014 20:53:14 +0200
der decoder added
Diffstat:
| M | cl-rw.asd | | | 3 | ++- |
| A | der.lisp | | | 218 | +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ |
2 files changed, 220 insertions(+), 1 deletion(-)
diff --git a/cl-rw.asd b/cl-rw.asd
@@ -51,4 +51,5 @@
(:file "calendar")
(:file "ui")
(:file "cas")
- (:file "zip")))
+ (:file "zip")
+ (:file "der")))
diff --git a/der.lisp b/der.lisp
@@ -0,0 +1,218 @@
+;;; Copyright (C) 2014 Tomas Hlavaty <tom@logand.com>
+;;;
+;;; Permission is hereby granted, free of charge, to any person
+;;; obtaining a copy of this software and associated documentation
+;;; files (the "Software"), to deal in the Software without
+;;; restriction, including without limitation the rights to use, copy,
+;;; modify, merge, publish, distribute, sublicense, and/or sell copies
+;;; of the Software, and to permit persons to whom the Software is
+;;; furnished to do so, subject to the following conditions:
+;;;
+;;; The above copyright notice and this permission notice shall be
+;;; included in all copies or substantial portions of the Software.
+;;;
+;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
+;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
+;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
+;;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
+;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
+;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
+;;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
+;;; DEALINGS IN THE SOFTWARE.
+
+(defpackage :rw.der
+ (:use :cl)
+ (:export :decode
+ :encode))
+
+(in-package :rw.der)
+
+;; http://www.itu.int/ITU-T/studygroups/com17/languages/X.690-0207.pdf
+;; http://www.planetlarg.net/encyclopedia/ssl-secure-sockets-layer/der-distinguished-encoding-rules-certificate-encoding
+;; ftp://ftp.rsasecurity.com/pub/pkcs/ascii/layman.asc
+;; http://luca.ntop.org/Teaching/Appunti/asn1.html
+;; http://tools.ietf.org/html/rfc5280
+;; http://www.ietf.org/rfc/rfc3280.txt
+;; https://en.wikipedia.org/wiki/X.509
+
+(defun octets-to-utf8-string (x)
+ #-(or sbcl)
+ (error "TODO port RW.DER::OCTETS-TO-UTF8-STRING")
+ #+sbcl
+ (sb-ext:octets-to-string x :external-format :utf-8))
+
+(defun utf8-string-to-octets (x)
+ #-(or sbcl)
+ (error "TODO port RW.DER::UTF8-STRING-TO-OCTETS")
+ #+sbcl
+ (sb-ext:string-to-octets x :external-format :utf-8))
+
+(defun decode (reader)
+ (labels ((len ()
+ (let ((n (rw:next-u8 reader)))
+ (if (zerop (ldb (byte 8 7) n))
+ n
+ (let ((z 0))
+ (dotimes (i (logand #x7f n) z)
+ (setq z (logior (ash z 8) (rw:next-u8 reader))))))))
+ (ascii ()
+ (let* ((n (len))
+ (z (make-string n)))
+ (dotimes (i n z)
+ (let ((c (rw:next-u8 reader)))
+ (assert (< 0 c #x80))
+ (setf (char z i) (code-char c)))))))
+ (let ((tag (rw:next-u8 reader)))
+ ;;(print tag)
+ (ecase tag
+ ;; primitive
+ (1 ;; boolean
+ (assert (eql 1 (rw:next-u8 reader)))
+ (cons 'boolean (ecase (rw:next-u8 reader) (0 nil) (255 t))))
+ (2 ;; integer
+ (let ((n (len)))
+ (assert (plusp n))
+ (let* ((z (rw:next-u8 reader))
+ (p (zerop (ldb (byte 8 7) z))))
+ (dotimes (i (1- n))
+ (setq z (logior (ash z 8) (rw:next-u8 reader))))
+ (if p z (- z (expt 2 (* 8 n)))))))
+ (3 ;; bit_string
+ (let ((n (len)))
+ (assert (plusp n))
+ (let ((m (rw:next-u8 reader))
+ (z 0))
+ ;; TODO as octet string?
+ (dotimes (i (1- n) (cons 'bit_string (ash z (- m))))
+ (setq z (logior (ash z 8) (rw:next-u8 reader)))))))
+ (4 ;; octet_string
+ ;; TODO variant with bounds
+ #+nil
+ (let* ((n (len)) ;; TODO why like SEQ in certificates?
+ (r (rw:peek-reader (rw:shorter-reader reader n))))
+ (loop
+ while (rw:peek r)
+ collect (decode r)))
+ ;;(decode (rw:shorter-reader reader (len)))
+ ;;#+nil
+ (let* ((n (len))
+ (z (make-array n
+ :element-type '(unsigned-byte 8)
+ :initial-element 0)))
+ (dotimes (i n z)
+ (setf (aref z i) (rw:next-u8 reader)))))
+ (5 ;; null
+ (assert (eql 0 (rw:next-u8 reader))))
+ (6 ;; object_identifier
+ (let (z (n (len)))
+ (assert (plusp n))
+ (multiple-value-bind (d m) (floor (rw:next-u8 reader) 40)
+ (push d z)
+ (push m z))
+ (decf n)
+ (loop
+ while (plusp n)
+ do (let (e (a 0))
+ (loop
+ until (zerop (ldb (byte 8 7)
+ (setq e (rw:next-u8 reader))))
+ do (progn
+ (decf n)
+ (setq a (logior (ash a 7) (logand #x7f e)))))
+ (decf n)
+ (push (logior (ash a 7) e) z)))
+ (cons 'oid (nreverse z))))
+ (12 ;; UTF8String
+ (let* ((n (len))
+ (z (make-array n
+ :element-type '(unsigned-byte 8)
+ :initial-element 0)))
+ (dotimes (i n (cons 'utf8string (octets-to-utf8-string z)))
+ (setf (aref z i) (rw:next-u8 reader)))))
+ (19 ;; printablestring
+ (cons 'printable_string (ascii)))
+ #+nil
+ (20 ;; t61string TeletexString #x14
+ (let* ((n (rw:next-u8 reader))
+ (z (make-string n)))
+ (dotimes (i n (cons 't61string z))
+ (setf (char z i) (code-char (rw:next-u8 reader))))))
+ (22 ;; ia5string
+ (cons 'ia5string (ascii)))
+ (23 ;; utctime
+ ;; YYMMDDhhmmZ
+ ;; YYMMDDhhmm+hh'mm'
+ ;; YYMMDDhhmm-hh'mm'
+ ;; YYMMDDhhmmssZ
+ ;; YYMMDDhhmmss+hh'mm'
+ ;; YYMMDDhhmmss-hh'mm'
+ (cons 'utctime (ascii)))
+ #+nil
+ (30 ;; BMPString #x1e
+ )
+ ;; constructed
+ (48 ;; SEQUENCE #x30
+ (loop
+ with r = (rw:peek-reader (rw:shorter-reader reader (len)))
+ while (rw:peek r)
+ collect (decode r)))
+ (49 ;; SET #x31
+ (cons 'set (decode (rw:shorter-reader reader (len)))))
+ (80
+ (cons '???-key-identifier
+ (decode (rw:shorter-reader reader (len)))))
+ (160 ;; ??? crl_extensions signed certificate version #xa0
+ ;; (int inside) 2 = signed certificate v3
+ (cons '???-signed-certificate-version
+ (decode (rw:shorter-reader reader (len)))))
+ (163 ;; ??? signed certificate extensions #xa3
+ (cons '???-signed-certificate-extensions
+ (decode (rw:shorter-reader reader (len)))))
+ ;; ;;;;;;;;;;
+ #+nil
+ (128
+ (cons '???-128 (decode (rw:shorter-reader reader (len)))))
+ ))))
+
+(let ((tests
+ '((nil (5 0))
+ (0 (2 1 0))
+ (127 (2 1 #x7f))
+ (-128 (2 1 #x80))
+ (-129 (2 2 #xff #x7f))
+ (128 (2 2 0 #x80))
+ (256 (2 2 1 0))
+ ((utctime . "910506234540Z")
+ (#x17 #x0d #x39 #x31 #x30 #x35 #x30 #x36 #x32 #x33 #x34 #x35 #x34 #x30
+ #x5a))
+ ((utctime . "910506164540-0700")
+ (#x17 #x11 #x39 #x31 #x30 #x35 #x30 #x36 #x31 #x36 #x34 #x35 #x34 #x30
+ #x2D #x30 #x37 #x30 #x30))
+ ((ia5string . "test1@rsa.com")
+ (#x16 #x0d #x74 #x65 #x73 #x74 #x31 #x40 #x72 #x73 #x61 #x2e #x63 #x6f
+ #x6d))
+ (#(1 #x23 #x45 #x67 #x89 #xab #xcd #xef)
+ (4 8 1 #x23 #x45 #x67 #x89 #xab #xcd #xef))
+ ;;(#x1b977 . (3 4 6 #x6e #x5d #xc0))
+ ;; ("cl'es publiques"
+ ;; (#x14 #x0f #x63 #x6c #xc2 #x65 #x73 #x20 #x70 #x75 #x62 #x6c #x69 #x71
+ ;; #x75 #x65 #x73))
+ ((oid 1 3 6 1 4 1 311 21 20)
+ (6 9 #x2b 6 1 4 1 #x82 #x37 #x15 #x14))
+ ((oid 1 2 840 113549 1 1 1)
+ (6 9 #x2a #x86 #x48 #x86 #xf7 #x0d 1 1 1))
+ ((printable_string . "TestCN")
+ (#x13 6 #x54 #x65 #x73 #x74 #x43 #x4e))
+ ((utf8string . "certreq")
+ (#x0c 7 #x63 #x65 #x72 #x74 #x72 #x65 #x71))
+ ((-128 (oid 1 3 6 1 4 1 311 21 20))
+ (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))
+ )))
+ (dolist (test tests t)
+ (assert (equalp (car test) (decode (rw:reader (cadr test)))))))
+
+;;(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)
