Add pem encoding and decoding for rsa public keys

Julien LepillerSat May 02 23:54:19+0200 2020

3d589f0

Add pem encoding and decoding for rsa public keys

Makefile.am

99 
  activitystreams/predicates.scm \
1010 
  activitystreams/vocabulary.scm \
1111 
  http-signature/asn1.scm \
12+
  http-signature/crypto.scm \
1213 
  http-signature/vocabulary.scm \
1314 
  webfinger/webfinger.scm
1415 
http-signature/asn1.scm
114114 
  (make-asn1-type
115115 
    "bitstring" 3 #t #t
116116 
    (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))
119119 
        ans))
120120 
    (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))
122125 
    (lambda (value)
123126 
      (apply bv-append value))))
124127 
http-signature/crypto.scm
1919 
  #:use-module (gcrypt base64)
2020 
  #:use-module (gcrypt pk-crypto)
2121 
  #: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
3524 
            ;; 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))
7127 
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))
10731 
10832 
(define (asn.1->string asn)
10933 
  "Return the PEM-encoded representation of the @var{asn} record."
110-
  (base64-encode (asn.1->bv asn)))
34+
  (base64-encode asn))
11135 
11236 
(define (public-key->pkcs1-asn.1 pk)
11337 
  "Return the ASN.1 representation of @var{pk}, an RSA public key, using the
11438 
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)))))
12342 
12443 
(define (public-key->pkcs8-asn.1 pk)
12544 
  "Return the ASN.1 representation of @var{pk}, a public key, using the PKCS#8
12645 
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))))))
13551 
13652 
(define (cut-str str n)
13753 
  "Cut a string @var{str} at @var{n} characters by placing a @code{\\n}, so that
…
14864 
  "Return the PEM-encoded version of the public key in @var{keypair}, an RSA
14965 
keypair."
15066 
  (let* ((public (find-sexp-token keypair 'public-key))
151-
         (asn (public-key->pkcs1-asn.1 public)))
67+
         (asn (public-key->pkcs8-asn.1 public)))
15268 
    (string-append
153-
      "-----BEGIN RSA PUBLIC KEY-----\n"
69+
      "-----BEGIN PUBLIC KEY-----\n"
15470 
      (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)))))