blob: 418056bf40796f99d29ada8f87f9004af5d83e17 (
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
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
|
(define-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 (current-openssl-binary
generate-key
private-key->public-key
random-hex)
#:declarative? #t
#:duplicates (merge-generics))
(define current-openssl-binary
(make-parameter
"/usr/bin/openssl"
(match-lambda
((? string? interpreter)
(lambda (arguments)
(with-exception-handler
(lambda (exn)
(raise-exception
(make-exception
(make-exception-with-irritants (list interpreter arguments))
(make-exception-with-message
"cannot run openssl:")
exn)))
(lambda ()
(let ((ret (apply system* interpreter arguments)))
(unless (eqv? 0 (status:exit-val ret))
(raise-exception
(make-exception
(make-error)
(make-exception-with-irritants (list (status:exit-val ret)))
(make-exception-with-message
(format #f "openssl failed with exit code ~s."
(status:exit-val ret)))))))))))
((? procedure? p)
p))))
(define (call-openssl . args)
((current-openssl-binary) args))
(define (generate-key rsa-strength)
(with-exception-handler
(lambda (exn)
(raise-exception
(make-exception
(make-exception-with-origin 'generate-key)
(make-exception-with-irritants (list rsa-strength))
(make-exception-with-message
"cannot generate a private key.")
exn)))
(lambda ()
(let ((port (mkstemp "/tmp/generate-openssl-key-XXXXXX"))
(openssl (current-openssl-binary)))
(dynamic-wind
(lambda () #t)
(lambda ()
(chmod port #o600)
(call-openssl
"genrsa"
"-out" (port-filename port)
(number->string rsa-strength))
(call-with-input-file (port-filename port)
get-string-all))
(lambda ()
(delete-file (port-filename port))))))))
(define (private-key->public-key key)
(with-exception-handler
(lambda (exn)
(raise-exception
(make-exception
(make-exception-with-origin 'private-key->public-key)
(make-exception-with-irritants (list key))
(make-exception-with-message
"cannot convert the private key to public key.")
exn)))
(lambda ()
(let ((input-port (mkstemp "/tmp/openssl-private-key-XXXXXX"))
(output-port (mkstemp "/tmp/openssl-public-key-XXXXXX"))
(openssl (current-openssl-binary)))
(dynamic-wind
(lambda () #t)
(lambda ()
(chmod input-port #o600)
(chmod output-port #o600)
(call-with-output-file (port-filename input-port)
(lambda (init-port)
(display key init-port)))
(call-openssl
"rsa"
"-in" (port-filename input-port)
"-out" (port-filename output-port)
"-pubout")
(call-with-input-file (port-filename output-port)
get-string-all))
(lambda ()
(delete-file (port-filename input-port))
(delete-file (port-filename output-port))))))))
(define (random-hex nbytes)
(with-exception-handler
(lambda (exn)
(raise-exception
(make-exception
(make-exception-with-origin 'random-hex)
(make-exception-with-irritants (list nbytes))
(make-exception-with-message
(format #f "cannot generate ~a random bytes."
nbytes))
exn)))
(lambda ()
(let ((output-port (mkstemp "/tmp/openssl-public-key-XXXXXX"))
(openssl (current-openssl-binary)))
(dynamic-wind
(lambda () #t)
(lambda ()
(chmod output-port #o600)
(call-openssl
"rand"
"-out" (port-filename output-port)
"-hex"
(number->string nbytes))
(call-with-input-file (port-filename output-port)
get-string-all))
(lambda ()
(delete-file (port-filename output-port))))))))
|
