aboutsummaryrefslogtreecommitdiff
path: root/tw/services/dns.scm
diff options
context:
space:
mode:
Diffstat (limited to 'tw/services/dns.scm')
-rw-r--r--tw/services/dns.scm54
1 files changed, 26 insertions, 28 deletions
diff --git a/tw/services/dns.scm b/tw/services/dns.scm
index ba4da6fe..675984e7 100644
--- a/tw/services/dns.scm
+++ b/tw/services/dns.scm
@@ -27,34 +27,32 @@ Guile @code{read} calls.")
(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)))))))))
+ (with-mail-out
+ #$(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"))))
+ (unless (= 200 (response-code response))
+ (error "Got error response:" response decoded-body))))))))))
(define (mythic-dynamic-dns-cronjobs config)
(match-record config <mythic-dynamic-dns-configuration> (ipv4? ipv6?)