blob: e23e148175e996094e2ec150ee23128a367cae8b (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
|
(define-module (email-key-rotation tests fake-openssl)
#:use-module (email-key-rotation openssl)
#:use-module (ice-9 exceptions)
#:use-module (ice-9 rdelim)
#:use-module (ice-9 textual-ports)
#:use-module (ice-9 match)
#:export (call-with-fake-openssl)
#:declarative? #t
#:duplicates (merge-generics))
(define (call-with-fake-openssl seed thunk)
(parameterize
((current-openssl-binary
(match-lambda
(("genrsa" "-out" output-file "2048")
(call-with-output-file output-file
(lambda (port)
(write `(begin-fake-private-key ,seed)
port))))
(("rsa" "-in" private-key-file "-out" public-key-file "-pubout")
(let ((private-key
(call-with-input-file private-key-file
read)))
(match private-key
(('begin-fake-private-key seed)
(call-with-output-file public-key-file
(lambda (port)
(format port "BEGIN FAKE PUBLIC KEY
blah blah public key
blah blah blah with seed ~a
END OF FAKE PUBLIC KEY"
seed))))
(otherwise
(raise-exception
(make-exception
(make-error)
(make-exception-with-origin 'call-with-fake-openssl)
(make-exception-with-irritants (list otherwise))
(make-exception-with-message
"the private key has not been generated by the fake openssl.")))))))
(("rand" "-out" file "-hex" (= string->number n-bytes))
(call-with-output-file file
(lambda (port)
(format port "hexdatawithseed~a" seed))))
(otherwise
(raise-exception
(make-exception
(make-error)
(make-exception-with-origin 'call-with-fake-openssl)
(make-exception-with-irritants (list otherwise))
(make-exception-with-message
"invalid use of openssl.")))))))
(thunk)))
|