vps.scm: Remove (restore-logfiles) and serve them from cgit directly

1 files changed, 26 insertions, 34 deletions

diff --git a/sync/vps.scm b/sync/vps.scm
index aa23987..2110757 100644
--- a/sync/vps.scm
+++ b/sync/vps.scm
@@ -129,6 +129,18 @@
 
 
 
+;; DNS constants
+
+(define tld (slurp "tld.txt"))
+
+(define mail-domain-prefix "mail")
+(define mail-domain (string-append mail-domain-prefix "." tld))
+
+(define git-domain-prefix "git")
+(define git-domain (string-append git-domain-prefix "." tld))
+
+
+
 ;; CI HTML generation from Git notes
 
 (define ci-html-beginning #"
@@ -156,7 +168,7 @@
 (define git-data-path "/srv/git")
 (define ci-data-path  "/srv/ci")
 
-(define (ci-data-in-repo-notes path)
+(define (ci-data-in-repo-notes name path)
   (utils:with-directory-excursion path
     (let* ((out-list (-> (cmd "git" "notes" "list")
                          (string-fun:string-replace-substring "\n" " ")
@@ -167,10 +179,16 @@
       (map (lambda (commit)
              (let ((data (-> (cmd "git" "notes" "--ref=refs/notes/ci-data" "show" commit)
                              (string-split #\space)))
-                   (logs (cmd "git" "notes" "--ref=refs/notes/ci-logs" "show" commit)))
+                   (logs (cmd "git" "notes" "--ref=refs/notes/ci-logs" "show" commit))
+                   (href (format #f
+                                 "https://~a/~a/blob?id=~a"
+                                 git-domain
+                                 name
+                                 (cmd "git" "notes" "--ref=refs/notes/ci-logs" "list" commit))))
                (list (cons #:status (srfi-1:first data))
                      (cons #:filename (srfi-1:second data))
-                     (cons #:logs logs))))
+                     (cons #:logs logs)
+                     (cons #:href href))))
            relevant-commits))))
 
 (define (generate-html-for-project name)
@@ -185,15 +203,16 @@
     string-append
     (map (lambda (data)
            (let ((status (if (equal? "0" (assoc-ref data #:status)) "✅" "❌"))
-                 (file (string-append name "/" (assoc-ref data #:filename))))
+                 (file (string-append name "/" (assoc-ref data #:filename)))
+                 (href (assoc-ref data #:href)))
              (string-append
               "<li>
-                 <a href=\"" file "\">
+                 <a href=\"" href "\">
                    " status "
                    <pre>" file "</pre>
                  </a>
                </li>")))
-         (ci-data-in-repo-notes (string-append git-data-path "/" name))))
+         (ci-data-in-repo-notes name (string-append git-data-path "/" name))))
    "</ul>"))
 
 (define (generate-ci-index-html)
@@ -205,17 +224,6 @@
                                         (list-directory git-data-path)))
                             ci-html-ending))))
 
-(define (restore-logfiles)
-  (for-each (lambda (name)
-              (map (lambda (data)
-                     (let* ((directory (string-append ci-data-path "/" name))
-                            (filename (string-append directory "/" (assoc-ref data #:filename))))
-                       (utils:mkdir-p directory)
-                       (call-with-output-file filename
-                         (partial display (assoc-ref data #:logs)))))
-                   (ci-data-in-repo-notes (string-append git-data-path "/" name))))
-            (list-directory git-data-path)))
-
 
 
 ;; OS configuration
@@ -230,17 +238,6 @@
 root ALL=(ALL) ALL
 %wheel ALL=NOPASSWD: ALL\n")
 
-(define tld
-  (slurp "tld.txt"))
-
-(define mail-domain-prefix "mail")
-(define mail-domain
-  (string-append mail-domain-prefix "." tld))
-
-(define git-domain-prefix "git")
-(define git-domain
-  (string-append git-domain-prefix "." tld))
-
 (define certbot-alias
   "certbot")
 
@@ -289,10 +286,6 @@ pki " mail-domain " key  \"" (tls-priv-for mail-domain) "\"")))
                   (use-modules (guix build utils))
                   (display 'generate-ci-index-html))))))
 
-(define restore-logfiles-job
-  #~(job "1 * * * *"
-         restore-logfiles))
-
 (operating-system
   (locale "fr_FR.UTF-8")
   (timezone "America/Sao_Paulo")
@@ -321,8 +314,7 @@ pki " mail-domain " key  \"" (tls-priv-for mail-domain) "\"")))
                      `((,user ,(plain-file "id_rsa.pub" ssh-public-key))))))
           (service mcron-service-type
                    (mcron-configuration
-                    (jobs (list generate-ci-index-html-job
-                                restore-logfiles-job))))
+                    (jobs (list generate-ci-index-html-job))))
           (simple-service 'automatic-certbot-renewal
                           activation-service-type
                           (with-imported-modules '((gnu services herd))