summaryrefslogtreecommitdiff
path: root/guile/email-key-rotation/tests/fake-openssl.scm
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)))