cl-rw

commit efe868a939ca8d32e4eead237481d3b93a126320
parent cbf95e3f4a7622c66e4b4b95c19e66a0adc222ba
Author: Tomas Hlavaty <tom@logand.com>
Date:   Sun, 19 Oct 2014 17:06:38 +0200

decode certificate

Diffstat:
M
tls.lisp
 | 
58
++++++++++++++++++++++++++++++++++++++++++++++++----------

1 file changed, 48 insertions(+), 10 deletions(-)
diff --git a/tls.lisp b/tls.lisp
@@ -665,9 +665,8 @@
                                             215 197 143 219 71 194 44 136 240
                                             78 112 25))))))))
 
-(defun next-server-hello (reader client-hello-time) ;; TODO extensions
+(defun next-server-hello (reader client-hello-time)
   (let ((x (next-$Record reader)))
-    ;;(print x)
     (let ((x ($Record-data x)))
       (let ((x ($Handshake-data x)))
         (assert (eq 'TLS1.2 ($ServerHello-version x)))
@@ -675,24 +674,62 @@
                     ($ServerHello-cipher_suite x)))
         (let ((x ($ServerHello-random x)))
           (assert (<= 0 (- ($Random-gmt_unix_time x) client-hello-time) 1))
-          ($Random-random_bytes x))))))
+          ($Random-random_bytes x))
+        ;; TODO server hello extensions
+        ))))
 
 (defun next-server-certificate (reader)
   (let ((x (next-$Record reader)))
-    ;;(print x)
     (let ((x ($Record-data x)))
       (let ((x ($Handshake-data x)))
         (loop
            for x in ($Certificate-list x)
            collect (%$Certificate-der x))))))
-
-(defun next-server-key-exchange (reader) ;; TODO
+(defun der-decode-bit-string (x)
+  (destructuring-bind (tag m n) x
+    (assert (eq 'rw.der::bit-string tag))
+    (assert (zerop m))
+    (let* ((x (ash n m))
+           (nbytes (ceiling (log x 256)))
+           (b (make-octet-buffer nbytes))
+           (w (rw:writer b)))
+      (loop
+         for i from (1- nbytes) downto 0
+         do (rw:write-u8 w (ldb (byte 8 (* 8 i)) x)))
+      (rw.der:decode (rw:reader b)))))
+
+(defun certificate-r-s (x)
+  (labels ((rec (x)
+             (when (consp x)
+               (when (equal (car x)
+                            '((rw.der::oid 1 2 840 113549 1 1 1) nil))
+                 (assert (not (cddr x)))
+                 (destructuring-bind (r s) (der-decode-bit-string (cadr x))
+                   ;;(print (list :@@@ r s))
+                   (return-from certificate-r-s (values r s))))
+               (mapc #'rec x))))
+    (rec x)))
+
+(defun next-server-key-exchange (reader client-random server-random server-certificates)
+  (certificate-r-s (car server-certificates)) ;; TODO r s
   (let ((x (next-$Record reader)))
-    ;;(print x)
     (let ((x ($Record-data x)))
       (let ((x ($Handshake-data x)))
-        (etypecase x
-          ($ServerKeyExchange (print x)))))))
+        (assert (eq 'ec_diffie_hellman ($ServerKeyExchange-type x)))
+        (let ((x ($ServerKeyExchange-data x)))
+          (let ((x (%$serverecdhparams-params x)))
+            (let ((b (make-octet-buffer 42)))
+              (write-$ServerECDHParams (rw:writer b) x)
+              #+nil(print (list :@@@ :params b)))
+            (let ((x ($serverecdhparams-public x)))
+              ))
+          (let ((x (%$serverecdhparams-signed_params x)))
+            (assert (eq 'ecdsa ($signature-algorithm x)))
+            (let ((x ($signature-data x)))
+              (let ((hash (%$ecsasignature-sha_hash x)))
+                #+nil(print (list :@@@ :hash hash)))))
+          ;; TODO check signed params
+          (print x))))))
 
 (defun next-server-hello-done (reader)
   (let ((x (next-$Record reader)))
@@ -735,7 +772,8 @@
     (flush writer)
     (let ((server-random (next-server-hello reader client-hello-time))
           (server-certificates (next-server-certificate reader)))
-      (next-server-key-exchange reader)
+      (next-server-key-exchange reader client-random server-random
+                                server-certificates)
       ;; TODO certificate request
       (next-server-hello-done reader)
       ;; TODO certificate