blob: 65dd75aaf05f811e0fb3a5ff61dbfd73e36ce33a (
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
|
(define-module (email-key-rotation dns)
#:use-module ((email-key-rotation gandi) #:prefix gandi:)
#:use-module (ice-9 exceptions)
#:use-module (ice-9 rdelim)
#:use-module (ice-9 match)
#:use-module (ice-9 optargs)
#:use-module (ice-9 receive)
#:use-module (srfi srfi-26)
#:use-module (srfi srfi-9 gnu)
#:use-module (rnrs bytevectors)
#:use-module (web uri)
#:use-module (web request)
#:use-module (web response)
#:use-module (web client)
#:use-module (json)
#:export (<dns-record>
make-dns-record
dns-record?
name set-name
type set-type
value set-value
publish-gandi-livedns)
#:declarative? #t)
(define-immutable-record-type <dns-record>
(make-dns-record name type value)
dns-record?
(name name set-name)
(type type set-type)
(value value set-value))
(define* (publish-gandi-livedns gandi-configuration
record
#:key
(http-request http-request))
(with-exception-handler
(lambda (exn)
(raise-exception
(make-exception
(make-exception-with-origin 'publish-gandi-livedns)
(make-exception-with-irritants (list gandi-configuration record))
(make-exception-with-message
"cannot update the Gandi livedns.")
exn)))
(lambda ()
(match record
(($ <dns-record> name type value)
(format (current-error-port) "Publishing record on Gandi LiveDNS: ~s ~s ~s...\n"
name type value)
(let ((path-under-domain `("records" ,name ,type))
(headers `((content-type . (application/json))))
(body
(string->utf8
(scm->json-string
`((rrset_values
. ,(list->vector (list value))))))))
(receive (response response-body)
(gandi:gandi-livedns-request
gandi-configuration
(gandi:domain gandi-configuration)
path-under-domain
#:headers headers
#:body body
#:http-request http-request)
(when (eqv? (response-code response) 409)
;; Retry with put
(receive (put-response put-body)
(gandi:gandi-livedns-request
gandi-configuration
(gandi:domain gandi-configuration)
path-under-domain
#:headers headers
#:body body
#:http-request http-request)
(set! response put-response)
(set! response-body put-body)))
(unless (or (eqv? (response-code response) 200)
(eqv? (response-code response) 201))
(raise-exception
(make-exception
(make-exception-with-irritants (list response))
(make-exception-with-message
(format #f "the request failed with ~a ~a."
(response-code response)
(response-reason-phrase response))))))
(format (current-error-port) "Publishing record on Gandi LiveDNS: ~s ~s ~s: ~s ~s\n"
name type value
(response-code response)
(response-reason-phrase response)))))))))
|
