From e862b7a5b28de96c426b2c105718519caf204039 Mon Sep 17 00:00:00 2001
From: Timo Wilken
Date: Sun, 25 Aug 2024 19:11:54 +0200
Subject: Send mail output for some mcron jobs

For mcron jobs that only output text when they fail, mail that output.
---
 tw/services/dns.scm | 54 ++++++++++++++++++++++++++---------------------------
 1 file changed, 26 insertions(+), 28 deletions(-)

(limited to 'tw/services/dns.scm')

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?)
-- 
cgit v1.2.3