Add pem encoding and decoding for rsa public keys
Makefile.am
9 | 9 | activitystreams/predicates.scm \ | |
10 | 10 | activitystreams/vocabulary.scm \ | |
11 | 11 | http-signature/asn1.scm \ | |
12 | + | http-signature/crypto.scm \ | |
12 | 13 | http-signature/vocabulary.scm \ | |
13 | 14 | webfinger/webfinger.scm | |
14 | 15 |
http-signature/asn1.scm
114 | 114 | (make-asn1-type | |
115 | 115 | "bitstring" 3 #t #t | |
116 | 116 | (lambda (bv pos len) | |
117 | - | (let ((ans (make-bytevector len))) | |
118 | - | (bytevector-copy! bv pos ans 0 len) | |
117 | + | (let ((ans (make-bytevector (- len 1)))) | |
118 | + | (bytevector-copy! bv (+ pos 1) ans 0 (- len 1)) | |
119 | 119 | ans)) | |
120 | 120 | (lambda (value) | |
121 | - | value) | |
121 | + | (let ((ans (make-bytevector (+ (bytevector-length value) 1)))) | |
122 | + | (bytevector-u8-set! ans 0 0) | |
123 | + | (bytevector-copy! value 0 ans 1 (bytevector-length value)) | |
124 | + | ans)) | |
122 | 125 | (lambda (value) | |
123 | 126 | (apply bv-append value)))) | |
124 | 127 |
http-signature/crypto.scm
19 | 19 | #:use-module (gcrypt base64) | |
20 | 20 | #:use-module (gcrypt pk-crypto) | |
21 | 21 | #:use-module (ice-9 match) | |
22 | - | #:use-module (srfi srfi-1) | |
23 | - | #:use-module (srfi srfi-9) | |
24 | - | #:use-module (rnrs bytevectors) | |
25 | - | #:export (;; this file provides some functions to deal with asn.1, der and pem. | |
26 | - | asn.1? | |
27 | - | make-asn.1 | |
28 | - | asn.1-type | |
29 | - | asn.1-len | |
30 | - | asn.1-val | |
31 | - | ||
32 | - | asn.1-compute-len | |
33 | - | asn.1->bv | |
34 | - | ;; this file also provides higher-level functions that produce | |
22 | + | #:use-module (http-signature asn1) | |
23 | + | #:export (;; this file also provides higher-level functions that produce | |
35 | 24 | ;; pem-encoded strings from gcrypt keys. | |
36 | - | pem-encode-public)) | |
37 | - | ||
38 | - | (define-record-type asn.1 | |
39 | - | (make-asn.1 type len val) | |
40 | - | asn.1? | |
41 | - | (type asn.1-type) | |
42 | - | (len asn.1-len) | |
43 | - | (val asn.1-val)) | |
44 | - | ||
45 | - | (define (asn.1-compute-len asn) | |
46 | - | "Computes the length of values in an asn.1 record. Return that record, where | |
47 | - | lengths are updated." | |
48 | - | (match asn | |
49 | - | (($ asn.1 type len val) | |
50 | - | (match type | |
51 | - | ('bool | |
52 | - | (match val | |
53 | - | ((? boolean? val) | |
54 | - | (make-asn.1 type 1 val)))) | |
55 | - | ('int | |
56 | - | (match val | |
57 | - | ((? bytevector? val) | |
58 | - | (make-asn.1 type (bytevector-length val) val)))) | |
59 | - | ('null | |
60 | - | (make-asn.1 type 0 val)) | |
61 | - | ('sequence | |
62 | - | (let ((nval (map asn.1-compute-len val))) | |
63 | - | (make-asn.1 type (fold + 0 (map asn.1-full-length nval)) nval))))))) | |
64 | - | ||
65 | - | (define (asn.1-full-length asn) | |
66 | - | "Compute the length of an asn.1 record, including the length of its length | |
67 | - | field." | |
68 | - | (match asn | |
69 | - | (($ asn.1 type len val) | |
70 | - | (+ len 1 1 (if (> len 127) (nbits len) 0))))) | |
25 | + | pem-encode-public | |
26 | + | pem-decode-public)) | |
71 | 27 | ||
72 | - | (define (nbits len) | |
73 | - | (if (< len 256) 1 (+ 1 (nbits (quotient len 256))))) | |
74 | - | ||
75 | - | (define (asn.1->bv asn) | |
76 | - | "Take an asn.1 where lengths are computed and returns a bytevector that | |
77 | - | corresponds to the DER encoding of that content." | |
78 | - | (let ((bv (make-bytevector (asn.1-full-length asn)))) | |
79 | - | (match asn | |
80 | - | (($ asn.1 type len val) | |
81 | - | (let ((val-pos (if (> len 127) (+ 2 (nbits len)) 2))) | |
82 | - | (bytevector-u8-set! bv 1 (if (> len 127) (+ 128 (nbits len)) len)) | |
83 | - | (when (> len 127) | |
84 | - | (let loop ((val len) (pos (- val-pos 1))) | |
85 | - | (when (> val 0) | |
86 | - | (bytevector-u8-set! bv pos (modulo val 256)) | |
87 | - | (loop (quotient val 256) (- pos 1))))) | |
88 | - | (match type | |
89 | - | ('bool | |
90 | - | (begin | |
91 | - | (bytevector-u8-set! bv 0 #x01) | |
92 | - | (bytevector-u8-set! bv val-pos (if val 255 0)))) | |
93 | - | ('int | |
94 | - | (begin | |
95 | - | (bytevector-u8-set! bv 0 #x02) | |
96 | - | (bytevector-copy! val 0 bv val-pos (bytevector-length val)))) | |
97 | - | ('null | |
98 | - | (bytevector-u8-set! bv 0 #x05)) | |
99 | - | ('sequence | |
100 | - | (begin | |
101 | - | (bytevector-u8-set! bv 0 #x30) | |
102 | - | (let loop ((val (map asn.1->bv val)) (pos val-pos)) | |
103 | - | (when (not (null? val)) | |
104 | - | (bytevector-copy! (car val) 0 bv pos (bytevector-length (car val))) | |
105 | - | (loop (cdr val) (+ pos (bytevector-length (car val)))))))))))) | |
106 | - | bv)) | |
28 | + | (define pkcs1-type (asn1:sequence asn1:int-bv asn1:int-bv)) | |
29 | + | (define pkcs8-type (asn1:sequence (asn1:sequence asn1:object-identifier asn1:null) | |
30 | + | asn1:bitstring)) | |
107 | 31 | ||
108 | 32 | (define (asn.1->string asn) | |
109 | 33 | "Return the PEM-encoded representation of the @var{asn} record." | |
110 | - | (base64-encode (asn.1->bv asn))) | |
34 | + | (base64-encode asn)) | |
111 | 35 | ||
112 | 36 | (define (public-key->pkcs1-asn.1 pk) | |
113 | 37 | "Return the ASN.1 representation of @var{pk}, an RSA public key, using the | |
114 | 38 | PKCS#1 representation." | |
115 | - | (asn.1-compute-len | |
116 | - | (match (canonical-sexp->sexp pk) | |
117 | - | (('public-key ('rsa ('n n) ('e e))) | |
118 | - | (make-asn.1 | |
119 | - | 'sequence #f | |
120 | - | (list | |
121 | - | (make-asn.1 'int #f n) | |
122 | - | (make-asn.1 'int #f e)))))))) | |
39 | + | (match (canonical-sexp->sexp pk) | |
40 | + | (('public-key ('rsa ('n n) ('e e))) | |
41 | + | (encode-asn1 pkcs1-type (list n e))))) | |
123 | 42 | ||
124 | 43 | (define (public-key->pkcs8-asn.1 pk) | |
125 | 44 | "Return the ASN.1 representation of @var{pk}, a public key, using the PKCS#8 | |
126 | 45 | representation. Currently only RSA keys can be transformed." | |
127 | - | (asn.1-compute-len | |
128 | - | (match (canonical-sexp->sexp pk) | |
129 | - | (('public-key ('rsa ('n n) ('e e))) | |
130 | - | (make-asn.1 | |
131 | - | 'sequence #f | |
132 | - | (list | |
133 | - | (make-asn.1) | |
134 | - | (make-asn.1)))))) | |
46 | + | (match (canonical-sexp->sexp pk) | |
47 | + | (('public-key ('rsa ('n n) ('e e))) | |
48 | + | (encode-asn1 pkcs8-type | |
49 | + | (list (list (list 1 2 840 113549 1 1 1) #f) | |
50 | + | (public-key->pkcs1-asn.1 pk)))))) | |
135 | 51 | ||
136 | 52 | (define (cut-str str n) | |
137 | 53 | "Cut a string @var{str} at @var{n} characters by placing a @code{\\n}, so that | |
… | |||
148 | 64 | "Return the PEM-encoded version of the public key in @var{keypair}, an RSA | |
149 | 65 | keypair." | |
150 | 66 | (let* ((public (find-sexp-token keypair 'public-key)) | |
151 | - | (asn (public-key->pkcs1-asn.1 public))) | |
67 | + | (asn (public-key->pkcs8-asn.1 public))) | |
152 | 68 | (string-append | |
153 | - | "-----BEGIN RSA PUBLIC KEY-----\n" | |
69 | + | "-----BEGIN PUBLIC KEY-----\n" | |
154 | 70 | (cut-str (asn.1->string asn) 64) | |
155 | - | "\n-----END RSA PUBLIC KEY-----"))) | |
71 | + | "\n-----END PUBLIC KEY-----"))) | |
72 | + | ||
73 | + | (define (decode-pkcs1 der) | |
74 | + | (let ((data (decode-asn1 der pkcs1-type))) | |
75 | + | (match data | |
76 | + | ((n e) (sexp->canonical-sexp `(public-key (rsa (n ,n) (e ,e)))))))) | |
77 | + | ||
78 | + | (define (decode-pkcs8 der) | |
79 | + | (let ((data (decode-asn1 der pkcs8-type))) | |
80 | + | (match data | |
81 | + | (((_ _) bs) (decode-pkcs1 bs))))) | |
82 | + | ||
83 | + | (define (pem-decode-public str) | |
84 | + | "Return a public-key from the PEM-encoded key in @var{str}." | |
85 | + | (let* ((lines (string-split str #\newline)) | |
86 | + | (first-line (car lines)) | |
87 | + | (lines (cdr (reverse (cdr (reverse lines)))))) | |
88 | + | (match first-line | |
89 | + | ("-----BEGIN PUBLIC KEY-----" | |
90 | + | (let loop ((content '()) (lines lines)) | |
91 | + | (match lines | |
92 | + | (() (throw 'invalid-key)) | |
93 | + | ((line lines ...) | |
94 | + | (if (equal? line "-----END PUBLIC KEY-----") | |
95 | + | (decode-pkcs8 (base64-decode (string-join (reverse content) ""))) | |
96 | + | (loop (cons line content) lines)))))) | |
97 | + | ("-----BEGIN RSA PUBLIC KEY-----" | |
98 | + | (let loop ((content '()) (lines lines)) | |
99 | + | (match lines | |
100 | + | (() (throw 'invalid-key)) | |
101 | + | ((line lines ...) | |
102 | + | (if (equal? line "-----END RSA PUBLIC KEY-----") | |
103 | + | (decode-pkcs1 (base64-decode (string-join (reverse content) ""))) | |
104 | + | (loop (cons line content) lines)))))) | |
105 | + | (_ (throw 'unrecognised-key-type))))) |