blob: 5c0d6ad99477c865cd20a722b24797cc7bfd3d58 (
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
129
130
131
|
(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)
#:use-module (ice-9 i18n)
#:export (current-openssl-binary
generate-key
private-key->public-key
random-hex)
#:declarative? #t
#:duplicates (merge-generics))
(define (G_ msg) (gettext msg "email-key-rotation"))
(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
(G_ "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 (G_ "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
(G_ "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
(G_ "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 (G_ "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))))))))
|
