blob: ba4da6fe95ad35ea7573c49c800af685d77acfb3 (
about) (
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
|
(define-module (tw services dns)
#:use-module (gnu)
#:use-module ((gnu packages guile) #:select (guile-json-4))
#:use-module ((gnu packages tls) #:select (guile-gnutls))
#:use-module (gnu services)
#:use-module (gnu services configuration)
#:use-module (gnu services mcron)
#:use-module (guix gexp)
#:use-module ((guix records) #:select (match-record))
#:export (mythic-dynamic-dns-configuration
mythic-dynamic-dns-service-type))
(define (string-or-gexp? thing)
(or (string? thing) (gexp? thing)))
(define-configuration/no-serialization mythic-dynamic-dns-configuration
(schedule (string-or-gexp "*/15 * * * *") "The mcron schedule on which to
update the machine's IP address.")
(credential-file (string "/etc/mythic-dns.scm") "The name of a file
containing authentication parameters as two Lisp strings, the first being a
username and the second being a password. This file will be parsed using two
Guile @code{read} calls.")
(host-name string "The host name to update with this device's public IP.")
(ipv4? (boolean #t) "Whether to update the specified host's A record.")
(ipv6? (boolean #t) "Whether to update the specified host's AAAA record."))
(define (mythic-dynamic-dns-cronjob config api-host)
(match-record config <mythic-dynamic-dns-configuration> (schedule host-name credential-file)
#~(job #$schedule
#$(program-file (string-append "dynamic-dns-" api-host "-command")
(with-extensions (list guile-json-4 guile-gnutls) ; guile-gnutls needed by (web client)
#~(begin
(use-modules (srfi srfi-11) ; `let*-values'
(ice-9 iconv)
(web client)
(web response)
(web uri)
(json))
(let*-values
(((update-url)
(format #f "https://~a/dns/v2/dynamic/~a" #$api-host #$host-name))
((auth-body)
(call-with-input-file #$credential-file
(lambda (port)
(string-append "username=" (uri-encode (read port))
"&password=" (uri-encode (read port))))))
((response body)
(http-post update-url #:body auth-body #:decode-body? #t
#:headers '((content-type application/x-www-form-urlencoded))))
;; For some reason, the body is not decoded, even with `#:decode-body? #t'.
((decoded-body)
(and body (bytevector->string body "utf-8"))))
(if (= 200 (response-code response))
(format (current-error-port) "Success: ~a\n"
(assoc-ref (json-string->scm decoded-body) "message"))
(format (current-error-port) "Got error response ~a: ~a\n"
response decoded-body)))))))))
(define (mythic-dynamic-dns-cronjobs config)
(match-record config <mythic-dynamic-dns-configuration> (ipv4? ipv6?)
(append (if ipv4? (list (mythic-dynamic-dns-cronjob config "ipv4.api.mythic-beasts.com")) '())
(if ipv6? (list (mythic-dynamic-dns-cronjob config "ipv6.api.mythic-beasts.com")) '()))))
(define mythic-dynamic-dns-service-type
(service-type
(name 'mythic-dynamic-dns)
(extensions
(list (service-extension mcron-service-type mythic-dynamic-dns-cronjobs)))
(description "Periodically update the host's DNS records with Mythic Beasts.")))
|
