blob: 4a183ce80c679b69b4a0584e8688cb15e9df0b83 (
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
|
(define-module (email-key-rotation tests fake-gandi-livedns)
#:use-module ((email-key-rotation) #:prefix ekr:)
#: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 optargs)
#:use-module (json)
#:use-module (rnrs bytevectors)
#:use-module (web uri)
#:use-module (web request)
#:use-module (web response)
#:export (call-with-fake-gandi-livedns)
#:declarative? #t
#:duplicates (merge-generics))
(define (fake-http-request expected-domain expected-api-key log-port)
(lambda* (uri #:key method headers body)
(unless (or (equal? method 'POST)
(equal? method 'PUT))
(raise-exception
(make-exception
(make-error)
(make-exception-with-irritants (list method))
(make-exception-with-message
"Gandi method is neither POST nor PUT"))))
(unless (equal? (uri-scheme uri) 'https)
(raise-exception
(make-exception
(make-error)
(make-exception-with-irritants (list uri))
(make-exception-with-message
"Gandi URI is not HTTPS."))))
(unless (equal? (uri-host uri) "api.gandi.net")
(raise-exception
(make-exception
(make-error)
(make-exception-with-irritants (list uri))
(make-exception-with-message
"Wrong Gandi URI host."))))
(when (uri-port uri)
(raise-exception
(make-exception
(make-error)
(make-exception-with-irritants (list uri))
(make-exception-with-message
"Custom Gandi URI port."))))
(when (uri-userinfo uri)
(raise-exception
(make-exception
(make-error)
(make-exception-with-irritants (list uri))
(make-exception-with-message
"Custom Gandi URI userinfo."))))
(unless (string-prefix? "/" (uri-path uri))
(raise-exception
(make-exception
(make-error)
(make-exception-with-irritants (list uri))
(make-exception-with-message
"Gandi URI path not absolute."))))
(let ((path-components
(split-and-decode-uri-path (uri-path uri))))
(match path-components
(("v5" "livedns" "domains" domain
"records" name "TXT")
(begin
(unless (equal? domain expected-domain)
(raise-exception
(make-exception
(make-error)
(make-exception-with-irritants (list domain))
(make-exception-with-message
"wrong domain in Gandi URI path."))))
(unless (equal? (assoc-ref headers 'content-type)
'(application/json))
(raise-exception
(make-exception
(make-error)
(make-exception-with-irritants (list headers))
(make-exception-with-message
"wrong content-type header."))))
(unless (equal? (assoc-ref headers 'Authorization)
(string-append
"ApiKey " expected-api-key))
(raise-exception
(make-exception
(make-error)
(make-exception-with-irritants (list headers))
(make-exception-with-message
"wrong Authorization header."))))
(when (bytevector? body)
(set! body (utf8->string body)))
(match (json-string->scm body)
((("rrset_values"
. (? vector?
(= vector->list
(value)))))
(begin
(format log-port "Change ~s TXT record to value ~s.\n"
name value)
(values (build-response) ""))))))))))
(define (call-with-fake-gandi-livedns expected-domain expected-api-key f)
(with-exception-handler
(lambda (exn)
(raise-exception
(make-exception
(make-exception-with-origin 'call-with-fake-gandi-livedns)
(make-exception-with-message "with fake gandi livedns:")
exn)))
(lambda ()
(call-with-output-string
(lambda (log-port)
(let ((http-request
(fake-http-request expected-domain
expected-api-key
log-port)))
(let ((materialize
(lambda (configuration-object output-port)
(ekr:materialize configuration-object output-port
#:http-request http-request))))
(f materialize))))))))
|
