1;;; -*- mode:scheme; coding:utf-8; -*-
2;;;
3;;; security/signature.scm - Cryptographic Signature
4;;;
5;;;   Copyright (c) 2021  Takashi Kato  <ktakashi@ymail.com>
6;;;
7;;;   Redistribution and use in source and binary forms, with or without
8;;;   modification, are permitted provided that the following conditions
9;;;   are met:
10;;;
11;;;   1. Redistributions of source code must retain the above copyright
12;;;      notice, this list of conditions and the following disclaimer.
13;;;
14;;;   2. Redistributions in binary form must reproduce the above copyright
15;;;      notice, this list of conditions and the following disclaimer in the
16;;;      documentation and/or other materials provided with the distribution.
17;;;
18;;;   THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
19;;;   "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
20;;;   LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
21;;;   A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
22;;;   OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
23;;;   SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED
24;;;   TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
25;;;   PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
26;;;   LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
27;;;   NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
28;;;   SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
29;;;
30
31#!nounbound
32(library (security signature)
33    (export algorithm-identifier->signature-verifier-provider
34	    algorithm-identifier->signature-signer-provider
35
36	    ;; named verifiers
37	    *rsa/sha1-verifier-provider*
38	    *rsa/sha256-verifier-provider*
39	    *rsa/sha384-verifier-provider*
40	    *rsa/sha512-verifier-provider*
41	    *rsa/sha224-verifier-provider*
42	    *rsa/sha512/224-verifier-provider*
43	    *rsa/sha512/256-verifier-provider*
44
45	    *rsassa-pss-verifier-provider*
46
47	    *ecdsa/sha1-verifier-provider*
48	    *ecdsa/sha224-verifier-provider*
49	    *ecdsa/sha256-verifier-provider*
50	    *ecdsa/sha384-verifier-provider*
51	    *ecdsa/sha512-verifier-provider*
52
53	    ;; named signers
54	    *rsa/sha1-signer-provider*
55	    *rsa/sha256-signer-provider*
56	    *rsa/sha384-signer-provider*
57	    *rsa/sha512-signer-provider*
58	    *rsa/sha224-signer-provider*
59	    *rsa/sha512/224-signer-provider*
60	    *rsa/sha512/256-signer-provider*
61
62	    *rsassa-pss-signer-provider*
63
64	    *ecdsa/sha1-signer-provider*
65	    *ecdsa/sha224-signer-provider*
66	    *ecdsa/sha256-signer-provider*
67	    *ecdsa/sha384-signer-provider*
68	    *ecdsa/sha512-signer-provider*
69	    )
70    (import (rnrs)
71	    (clos core)
72	    (crypto)
73	    (math)
74	    (asn.1)
75	    (rsa pkcs :10))
76
77(define *rsassa-pss-oid* "1.2.840.113549.1.1.10")
78(define (algorithm-identifier->signature-verifier-provider aid)
79  (define oid (algorithm-identifier-id aid))
80  (cond ((string=? oid *rsassa-pss-oid*)
81	 (let-values (((algo mgf salt-len) (parse-rsassa-pss-parameter aid)))
82	   ;; wrap it
83	   (lambda (public-key . parameters)
84	     (apply *rsassa-pss-verifier-provider* public-key
85		    :digest algo
86		    :mgf mgf
87		    :salt-length salt-len
88		    parameters))))
89	((assp (lambda (known-oid) (string=? oid known-oid))
90	       *provider-oid-map*) => cadr)
91	(else
92	 (assertion-violation 'algorithm-identifier->signature-verifier-provider
93			      "Not supported OID" oid))))
94
95(define (algorithm-identifier->signature-signer-provider aid)
96  (define oid (algorithm-identifier-id aid))
97  (cond ((string=? oid *rsassa-pss-oid*)
98	 (let-values (((algo mgf salt-len) (parse-rsassa-pss-parameter aid)))
99	   ;; wrap it
100	   (lambda (private-key . parameters)
101	     (apply *rsassa-pss-signer-provider* private-key
102		    :digest algo
103		    :mgf mgf
104		    :salt-length salt-len
105		    parameters))))
106	((assp (lambda (known-oid) (string=? oid known-oid))
107	       *provider-oid-map*) => caddr)
108	(else
109	 (assertion-violation 'algorithm-identifier->signature-signer-provider
110			      "Not supported OID" oid))))
111
112#|
113      RSASSA-PSS-params  ::=  SEQUENCE  {
114         hashAlgorithm      [0] HashAlgorithm DEFAULT
115                                   sha1Identifier,
116         maskGenAlgorithm   [1] MaskGenAlgorithm DEFAULT
117                                   mgf1SHA1Identifier,
118         saltLength         [2] INTEGER DEFAULT 20,
119         trailerField       [3] INTEGER DEFAULT 1  }
120|#
121
122(define (parse-rsassa-pss-parameter aid)
123  (define param (algorithm-identifier-parameters aid))
124  (define (find-tag param tag)
125    (define (check-tag o)
126      (and (is-a? o <asn.1-tagged-object>)
127	   (equal? tag (slot-ref o 'tag-no))))
128    (do ((len (asn.1-sequence-size param))
129	 (i 0 (+ i 1)))
130	((or (= i len) (check-tag (asn.1-sequence-get param i)))
131	 (and (not (= i len))
132	      (slot-ref (asn.1-sequence-get param i) 'obj)))))
133  (unless (is-a? param <asn.1-sequence>)
134    (assertion-violation 'parse-rsassa-pss-parameter
135			 "Invalid rsassa-pss parameter" aid))
136  (let ((hash-func-aid (make-algorithm-identifier (find-tag param 0)))
137	(mask-gen-func-aid (make-algorithm-identifier (find-tag param 1)))
138	(salt-len (find-tag param 2)))
139    (unless (string=? (algorithm-identifier-id mask-gen-func-aid)
140		      "1.2.840.113549.1.1.8")
141      (assertion-violation 'parse-rsassa-pss-parameter
142			   "Unknown MGF OID" mask-gen-func-aid))
143    (values (oid->hash-algorithm (algorithm-identifier-id hash-func-aid))
144	    mgf-1
145	    (der-integer->integer salt-len))))
146
147;;; verifier providers
148(define (make-rsa-verifier-provider digest verify)
149  (lambda (public-key . parameter)
150    (define cipher (make-cipher RSA public-key))
151    (define algo (hash-algorithm digest))
152    (lambda (message signnature)
153      (apply cipher-verify cipher message signnature
154	     :hash algo :verify verify parameter))))
155
156(define *rsa/sha1-verifier-provider*
157  (make-rsa-verifier-provider SHA-1 pkcs1-emsa-v1.5-verify))
158(define *rsa/sha256-verifier-provider*
159  (make-rsa-verifier-provider SHA-256 pkcs1-emsa-v1.5-verify))
160(define *rsa/sha384-verifier-provider*
161  (make-rsa-verifier-provider SHA-384 pkcs1-emsa-v1.5-verify))
162(define *rsa/sha512-verifier-provider*
163  (make-rsa-verifier-provider SHA-512 pkcs1-emsa-v1.5-verify))
164(define *rsa/sha224-verifier-provider*
165  (make-rsa-verifier-provider SHA-224 pkcs1-emsa-v1.5-verify))
166(define *rsa/sha512/224-verifier-provider*
167  (make-rsa-verifier-provider SHA-512/224 pkcs1-emsa-v1.5-verify))
168(define *rsa/sha512/256-verifier-provider*
169  (make-rsa-verifier-provider SHA-512/256 pkcs1-emsa-v1.5-verify))
170
171(define (*rsassa-pss-verifier-provider* public-key
172					:key (digest SHA-1)
173					:allow-other-keys opts)
174    (define cipher (make-cipher RSA public-key))
175    (define algo (hash-algorithm digest))
176    (lambda (message signnature)
177      (apply cipher-verify cipher message signnature
178	     :hash algo :verify pkcs1-emsa-pss-verify opts)))
179
180(define (make-ecdsa-verifier-provider digest)
181  (lambda (public-key . opts)
182    (define cipher (make-cipher ECDSA public-key))
183    (lambda (message signature)
184      (apply cipher-verify cipher message signature :hash digest opts))))
185
186(define *ecdsa/sha1-verifier-provider* (make-ecdsa-verifier-provider SHA-1))
187(define *ecdsa/sha224-verifier-provider* (make-ecdsa-verifier-provider SHA-224))
188(define *ecdsa/sha256-verifier-provider* (make-ecdsa-verifier-provider SHA-256))
189(define *ecdsa/sha384-verifier-provider* (make-ecdsa-verifier-provider SHA-384))
190(define *ecdsa/sha512-verifier-provider* (make-ecdsa-verifier-provider SHA-512))
191
192;; signer providers
193(define (make-rsa-signer-provider digest encode)
194  (lambda (private-key . parameter)
195    (define cipher (make-cipher RSA private-key))
196    (define algo (hash-algorithm digest))
197    (lambda (message)
198      (apply cipher-signature cipher message
199	     :hash algo :encode encode parameter))))
200(define *rsa/sha1-signer-provider*
201  (make-rsa-signer-provider SHA-1 pkcs1-emsa-v1.5-encode))
202(define *rsa/sha256-signer-provider*
203  (make-rsa-signer-provider SHA-256 pkcs1-emsa-v1.5-encode))
204(define *rsa/sha384-signer-provider*
205  (make-rsa-signer-provider SHA-384 pkcs1-emsa-v1.5-encode))
206(define *rsa/sha512-signer-provider*
207  (make-rsa-signer-provider SHA-512 pkcs1-emsa-v1.5-encode))
208(define *rsa/sha224-signer-provider*
209  (make-rsa-signer-provider SHA-224 pkcs1-emsa-v1.5-encode))
210(define *rsa/sha512/224-signer-provider*
211  (make-rsa-signer-provider SHA-512/224 pkcs1-emsa-v1.5-encode))
212(define *rsa/sha512/256-signer-provider*
213  (make-rsa-signer-provider SHA-512/256 pkcs1-emsa-v1.5-encode))
214
215(define (*rsassa-pss-signer-provider* private-key
216				      :key (digest SHA-1)
217				      :allow-other-keys opts)
218    (define cipher (make-cipher RSA private-key))
219    (define algo (hash-algorithm digest))
220    (lambda (message)
221      (apply cipher-signature cipher message
222	     :hash algo :encode pkcs1-emsa-pss-encode opts)))
223
224(define (make-ecdsa-signer-provider digest)
225  (lambda (private-key . opts)
226    (define cipher (make-cipher ECDSA private-key))
227    (lambda (message)
228      (apply cipher-signature cipher message :hash digest opts))))
229
230(define *ecdsa/sha1-signer-provider* (make-ecdsa-signer-provider SHA-1))
231(define *ecdsa/sha224-signer-provider* (make-ecdsa-signer-provider SHA-224))
232(define *ecdsa/sha256-signer-provider* (make-ecdsa-signer-provider SHA-256))
233(define *ecdsa/sha384-signer-provider* (make-ecdsa-signer-provider SHA-384))
234(define *ecdsa/sha512-signer-provider* (make-ecdsa-signer-provider SHA-512))
235
236(define *provider-oid-map*
237  `(;; RSA PKCS v1.5
238    ("1.2.840.113549.1.1.5"  ,*rsa/sha1-verifier-provider*
239			     ,*rsa/sha1-signer-provider*)
240    ("1.2.840.113549.1.1.11" ,*rsa/sha256-verifier-provider*
241			     ,*rsa/sha256-signer-provider*)
242    ("1.2.840.113549.1.1.12" ,*rsa/sha384-verifier-provider*
243			     ,*rsa/sha384-signer-provider*)
244    ("1.2.840.113549.1.1.13" ,*rsa/sha512-verifier-provider*
245			     ,*rsa/sha512-signer-provider*)
246    ("1.2.840.113549.1.1.14" ,*rsa/sha224-verifier-provider*
247			     ,*rsa/sha224-signer-provider*)
248    ("1.2.840.113549.1.1.15" ,*rsa/sha512/224-verifier-provider*
249			     ,*rsa/sha512/224-signer-provider*)
250    ("1.2.840.113549.1.1.16" ,*rsa/sha512/256-verifier-provider*
251			     ,*rsa/sha512/256-signer-provider*)
252    ;; RSA PSSSSA-PSS
253    (,*rsassa-pss-oid*       ,*rsassa-pss-verifier-provider*
254			     ,*rsassa-pss-signer-provider*)
255    ;; DSA
256    ;; ECDSA
257    ("1.2.840.10045.4.1"     ,*ecdsa/sha1-verifier-provider*
258			     ,*ecdsa/sha1-signer-provider*)
259    ("1.2.840.10045.4.3.1"   ,*ecdsa/sha224-verifier-provider*
260			     ,*ecdsa/sha224-signer-provider*)
261    ("1.2.840.10045.4.3.2"   ,*ecdsa/sha256-verifier-provider*
262			     ,*ecdsa/sha256-signer-provider*)
263    ("1.2.840.10045.4.3.3"   ,*ecdsa/sha384-verifier-provider*
264			     ,*ecdsa/sha384-signer-provider*)
265    ("1.2.840.10045.4.3.4"   ,*ecdsa/sha512-verifier-provider*
266			     ,*ecdsa/sha512-signer-provider*)
267    ))
268
269)
270