GNU bug report logs - #32660
[PATCH 0/2] Move taylon service to web.scm; add log file for hpcguix-web

Previous Next

Package: guix-patches;

Reported by: Ludovic Courtès <ludo <at> gnu.org>

Date: Fri, 7 Sep 2018 21:06:01 UTC

Severity: normal

Tags: patch

Done: ludo <at> gnu.org (Ludovic Courtès)

Bug is archived. No further changes may be made.

To add a comment to this bug, you must first unarchive it, by sending
a message to control AT debbugs.gnu.org, with unarchive 32660 in the body.
You can then email your comments to 32660 AT debbugs.gnu.org in the normal way.

Toggle the display of automated, internal messages from the tracker.

View this report as an mbox folder, status mbox, maintainer mbox


Report forwarded to guix-patches <at> gnu.org:
bug#32660; Package guix-patches. (Fri, 07 Sep 2018 21:06:02 GMT) Full text and rfc822 format available.

Acknowledgement sent to Ludovic Courtès <ludo <at> gnu.org>:
New bug report received and forwarded. Copy sent to guix-patches <at> gnu.org. (Fri, 07 Sep 2018 21:06:02 GMT) Full text and rfc822 format available.

Message #5 received at submit <at> debbugs.gnu.org (full text, mbox):

From: Ludovic Courtès <ludo <at> gnu.org>
To: guix-patches <at> gnu.org
Cc: Ludovic Courtès <ludo <at> gnu.org>
Subject: [PATCH 0/2] Move taylon service to web.scm;
 add log file for hpcguix-web
Date: Fri,  7 Sep 2018 23:05:21 +0200
Hello,

This moves taylon-service-type to web.scm, mostly so we can use admin.scm
from there (and potentially in other places as well.)

Thoughts?

Ludo’.

Ludovic Courtès (2):
  services: tailon: Move to (gnu services web).
  services: hpcguix-web: Produce a log file and rotate it.

 gnu/local.mk           |   1 -
 gnu/services/admin.scm | 174 +-------------------------------------
 gnu/services/web.scm   | 188 ++++++++++++++++++++++++++++++++++++++++-
 gnu/tests/admin.scm    | 127 ----------------------------
 gnu/tests/web.scm      |  99 +++++++++++++++++++++-
 5 files changed, 284 insertions(+), 305 deletions(-)
 delete mode 100644 gnu/tests/admin.scm

-- 
2.18.0





Information forwarded to guix-patches <at> gnu.org:
bug#32660; Package guix-patches. (Fri, 07 Sep 2018 21:16:02 GMT) Full text and rfc822 format available.

Message #8 received at 32660 <at> debbugs.gnu.org (full text, mbox):

From: Ludovic Courtès <ludo <at> gnu.org>
To: 32660 <at> debbugs.gnu.org
Cc: Ludovic Courtès <ludo <at> gnu.org>
Subject: [PATCH 1/2] services: tailon: Move to (gnu services web).
Date: Fri,  7 Sep 2018 23:14:58 +0200
This allows (gnu services admin) to remain deeper in the module graph
and to be used by (gnu services web).

* gnu/services/admin.scm (<tailon-configuration-file>)
(tailon-configuration-files-string)
(tailon-configuration-file-compiler, <tailon-configuration>)
(tailon-shepherd-service, %tailon-accounts)
(tailon-service-type): Move to...
* gnu/services/web.scm: ... here.
* gnu/tests/admin.scm: Remove.  Move test to...
* gnu/tests/web.scm (%tailon-os)
(run-tailon-test, %test-tailon): ... here.
---
 gnu/local.mk           |   1 -
 gnu/services/admin.scm | 174 +----------------------------------------
 gnu/services/web.scm   | 172 +++++++++++++++++++++++++++++++++++++++-
 gnu/tests/admin.scm    | 127 ------------------------------
 gnu/tests/web.scm      |  99 ++++++++++++++++++++++-
 5 files changed, 270 insertions(+), 303 deletions(-)
 delete mode 100644 gnu/tests/admin.scm

diff --git a/gnu/local.mk b/gnu/local.mk
index 1924ae946..9239a989e 100644
--- a/gnu/local.mk
+++ b/gnu/local.mk
@@ -529,7 +529,6 @@ GNU_SYSTEM_MODULES =				\
   %D%/build/vm.scm				\
 						\
   %D%/tests.scm					\
-  %D%/tests/admin.scm				\
   %D%/tests/audio.scm				\
   %D%/tests/base.scm				\
   %D%/tests/databases.scm			\
diff --git a/gnu/services/admin.scm b/gnu/services/admin.scm
index aaf0b904f..f08c89633 100644
--- a/gnu/services/admin.scm
+++ b/gnu/services/admin.scm
@@ -20,19 +20,14 @@
 (define-module (gnu services admin)
   #:use-module (gnu packages admin)
   #:use-module (gnu packages base)
-  #:use-module (gnu packages logging)
   #:use-module (gnu services)
   #:use-module (gnu services mcron)
   #:use-module (gnu services shepherd)
-  #:use-module (gnu services web)
-  #:use-module (gnu system shadow)
   #:use-module (guix gexp)
-  #:use-module (guix store)
   #:use-module (guix packages)
   #:use-module (guix records)
   #:use-module (srfi srfi-1)
   #:use-module (ice-9 vlist)
-  #:use-module (ice-9 match)
   #:export (%default-rotations
             %rotated-files
 
@@ -46,29 +41,7 @@
             rottlog-configuration
             rottlog-configuration?
             rottlog-service
-            rottlog-service-type
-
-            <tailon-configuration-file>
-            tailon-configuration-file
-            tailon-configuration-file?
-            tailon-configuration-file-files
-            tailon-configuration-file-bind
-            tailon-configuration-file-relative-root
-            tailon-configuration-file-allow-transfers?
-            tailon-configuration-file-follow-names?
-            tailon-configuration-file-tail-lines
-            tailon-configuration-file-allowed-commands
-            tailon-configuration-file-debug?
-            tailon-configuration-file-http-auth
-            tailon-configuration-file-users
-
-            <tailon-configuration>
-            tailon-configuration
-            tailon-configuration?
-            tailon-configuration-config-file
-            tailon-configuration-package
-
-            tailon-service-type))
+            rottlog-service-type))
 
 ;;; Commentary:
 ;;;
@@ -203,149 +176,4 @@ Old log files are removed or compressed according to the configuration.")
                                  rotations)))))
    (default-value (rottlog-configuration))))
 
-
-;;;
-;;; Tailon
-;;;
-
-(define-record-type* <tailon-configuration-file>
-  tailon-configuration-file make-tailon-configuration-file
-  tailon-configuration-file?
-  (files                   tailon-configuration-file-files
-                           (default '("/var/log")))
-  (bind                    tailon-configuration-file-bind
-                           (default "localhost:8080"))
-  (relative-root           tailon-configuration-file-relative-root
-                           (default #f))
-  (allow-transfers?        tailon-configuration-file-allow-transfers?
-                           (default #t))
-  (follow-names?           tailon-configuration-file-follow-names?
-                           (default #t))
-  (tail-lines              tailon-configuration-file-tail-lines
-                           (default 200))
-  (allowed-commands        tailon-configuration-file-allowed-commands
-                           (default '("tail" "grep" "awk")))
-  (debug?                  tailon-configuration-file-debug?
-                           (default #f))
-  (wrap-lines              tailon-configuration-file-wrap-lines
-                           (default #t))
-  (http-auth               tailon-configuration-file-http-auth
-                           (default #f))
-  (users                   tailon-configuration-file-users
-                           (default #f)))
-
-(define (tailon-configuration-files-string files)
-  (string-append
-   "\n"
-   (string-join
-    (map
-     (lambda (x)
-       (string-append
-        "  - "
-        (cond
-         ((string? x)
-          (simple-format #f "'~A'" x))
-         ((list? x)
-          (string-join
-           (cons (simple-format #f "'~A':" (car x))
-                 (map
-                  (lambda (x) (simple-format #f "      - '~A'" x))
-                  (cdr x)))
-           "\n"))
-         (else (error x)))))
-     files)
-    "\n")))
-
-(define-gexp-compiler (tailon-configuration-file-compiler
-                       (file <tailon-configuration-file>) system target)
-  (match file
-    (($ <tailon-configuration-file> files bind relative-root
-                                    allow-transfers? follow-names?
-                                    tail-lines allowed-commands debug?
-                                    wrap-lines http-auth users)
-     (text-file
-      "tailon-config.yaml"
-      (string-concatenate
-       (filter-map
-        (match-lambda
-         ((key . #f) #f)
-         ((key . value) (string-append key ": " value "\n")))
-
-        `(("files" . ,(tailon-configuration-files-string files))
-          ("bind" . ,bind)
-          ("relative-root" . ,relative-root)
-          ("allow-transfers" . ,(if allow-transfers? "true" "false"))
-          ("follow-names" . ,(if follow-names? "true" "false"))
-          ("tail-lines" . ,(number->string tail-lines))
-          ("commands" . ,(string-append "["
-                                        (string-join allowed-commands ", ")
-                                        "]"))
-          ("debug" . ,(if debug? "true" #f))
-          ("wrap-lines" . ,(if wrap-lines "true" "false"))
-          ("http-auth" . ,http-auth)
-          ("users" . ,(if users
-                          (string-concatenate
-                           (cons "\n"
-                                 (map (match-lambda
-                                       ((user . pass)
-                                        (string-append
-                                         "  " user ":" pass)))
-                                      users)))
-                          #f)))))))))
-
-(define-record-type* <tailon-configuration>
-  tailon-configuration make-tailon-configuration
-  tailon-configuration?
-  (config-file tailon-configuration-config-file
-               (default (tailon-configuration-file)))
-  (package tailon-configuration-package
-           (default tailon)))
-
-(define tailon-shepherd-service
-  (match-lambda
-    (($ <tailon-configuration> config-file package)
-     (list (shepherd-service
-            (provision '(tailon))
-            (documentation "Run the tailon daemon.")
-            (start #~(make-forkexec-constructor
-                      `(,(string-append #$package "/bin/tailon")
-                        "-c" ,#$config-file)
-                      #:user "tailon"
-                      #:group "tailon"))
-            (stop #~(make-kill-destructor)))))))
-
-(define %tailon-accounts
-  (list (user-group (name "tailon") (system? #t))
-        (user-account
-         (name "tailon")
-         (group "tailon")
-         (system? #t)
-         (comment "tailon")
-         (home-directory "/var/empty")
-         (shell (file-append shadow "/sbin/nologin")))))
-
-(define tailon-service-type
-  (service-type
-   (name 'tailon)
-   (description
-    "Run Tailon, a Web application for monitoring, viewing, and searching log
-files.")
-   (extensions
-    (list (service-extension shepherd-root-service-type
-                             tailon-shepherd-service)
-          (service-extension account-service-type
-                             (const %tailon-accounts))))
-   (compose concatenate)
-   (extend (lambda (parameter files)
-             (tailon-configuration
-              (inherit parameter)
-              (config-file
-               (let ((old-config-file
-                      (tailon-configuration-config-file parameter)))
-                 (tailon-configuration-file
-                  (inherit old-config-file)
-                  (files (append (tailon-configuration-file-files old-config-file)
-                                 files))))))))
-   (default-value (tailon-configuration))))
-
 ;;; admin.scm ends here
diff --git a/gnu/services/web.scm b/gnu/services/web.scm
index 3778efd04..1c613ac8a 100644
--- a/gnu/services/web.scm
+++ b/gnu/services/web.scm
@@ -7,6 +7,7 @@
 ;;; Copyright © 2017 nee <nee-git <at> hidamari.blue>
 ;;; Copyright © 2017, 2018 Clément Lassieur <clement <at> lassieur.org>
 ;;; Copyright © 2018 Pierre-Antoine Rouby <pierre-antoine.rouby <at> inria.fr>
+;;; Copyright © 2017 Christopher Baines <mail <at> cbaines.net>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -32,9 +33,11 @@
   #:use-module (gnu packages web)
   #:use-module (gnu packages php)
   #:use-module (gnu packages guile)
+  #:use-module (gnu packages logging)
   #:use-module (guix records)
   #:use-module (guix modules)
   #:use-module (guix gexp)
+  #:use-module ((guix store) #:select (text-file))
   #:use-module ((guix utils) #:select (version-major))
   #:use-module ((guix packages) #:select (package-version))
   #:use-module (srfi srfi-1)
@@ -164,7 +167,29 @@
 
             hpcguix-web-configuration
             hpcguix-web-configuration?
-            hpcguix-web-service-type))
+            hpcguix-web-service-type
+
+            <tailon-configuration-file>
+            tailon-configuration-file
+            tailon-configuration-file?
+            tailon-configuration-file-files
+            tailon-configuration-file-bind
+            tailon-configuration-file-relative-root
+            tailon-configuration-file-allow-transfers?
+            tailon-configuration-file-follow-names?
+            tailon-configuration-file-tail-lines
+            tailon-configuration-file-allowed-commands
+            tailon-configuration-file-debug?
+            tailon-configuration-file-http-auth
+            tailon-configuration-file-users
+
+            <tailon-configuration>
+            tailon-configuration
+            tailon-configuration?
+            tailon-configuration-config-file
+            tailon-configuration-package
+
+            tailon-service-type))
 
 ;;; Commentary:
 ;;;
@@ -982,3 +1007,148 @@ a webserver.")
                              (const %hpcguix-web-activation))
           (service-extension shepherd-root-service-type
                              (compose list hpcguix-web-shepherd-service))))))
+
+
+;;;
+;;; Tailon
+;;;
+
+(define-record-type* <tailon-configuration-file>
+  tailon-configuration-file make-tailon-configuration-file
+  tailon-configuration-file?
+  (files                   tailon-configuration-file-files
+                           (default '("/var/log")))
+  (bind                    tailon-configuration-file-bind
+                           (default "localhost:8080"))
+  (relative-root           tailon-configuration-file-relative-root
+                           (default #f))
+  (allow-transfers?        tailon-configuration-file-allow-transfers?
+                           (default #t))
+  (follow-names?           tailon-configuration-file-follow-names?
+                           (default #t))
+  (tail-lines              tailon-configuration-file-tail-lines
+                           (default 200))
+  (allowed-commands        tailon-configuration-file-allowed-commands
+                           (default '("tail" "grep" "awk")))
+  (debug?                  tailon-configuration-file-debug?
+                           (default #f))
+  (wrap-lines              tailon-configuration-file-wrap-lines
+                           (default #t))
+  (http-auth               tailon-configuration-file-http-auth
+                           (default #f))
+  (users                   tailon-configuration-file-users
+                           (default #f)))
+
+(define (tailon-configuration-files-string files)
+  (string-append
+   "\n"
+   (string-join
+    (map
+     (lambda (x)
+       (string-append
+        "  - "
+        (cond
+         ((string? x)
+          (simple-format #f "'~A'" x))
+         ((list? x)
+          (string-join
+           (cons (simple-format #f "'~A':" (car x))
+                 (map
+                  (lambda (x) (simple-format #f "      - '~A'" x))
+                  (cdr x)))
+           "\n"))
+         (else (error x)))))
+     files)
+    "\n")))
+
+(define-gexp-compiler (tailon-configuration-file-compiler
+                       (file <tailon-configuration-file>) system target)
+  (match file
+    (($ <tailon-configuration-file> files bind relative-root
+                                    allow-transfers? follow-names?
+                                    tail-lines allowed-commands debug?
+                                    wrap-lines http-auth users)
+     (text-file
+      "tailon-config.yaml"
+      (string-concatenate
+       (filter-map
+        (match-lambda
+         ((key . #f) #f)
+         ((key . value) (string-append key ": " value "\n")))
+
+        `(("files" . ,(tailon-configuration-files-string files))
+          ("bind" . ,bind)
+          ("relative-root" . ,relative-root)
+          ("allow-transfers" . ,(if allow-transfers? "true" "false"))
+          ("follow-names" . ,(if follow-names? "true" "false"))
+          ("tail-lines" . ,(number->string tail-lines))
+          ("commands" . ,(string-append "["
+                                        (string-join allowed-commands ", ")
+                                        "]"))
+          ("debug" . ,(if debug? "true" #f))
+          ("wrap-lines" . ,(if wrap-lines "true" "false"))
+          ("http-auth" . ,http-auth)
+          ("users" . ,(if users
+                          (string-concatenate
+                           (cons "\n"
+                                 (map (match-lambda
+                                       ((user . pass)
+                                        (string-append
+                                         "  " user ":" pass)))
+                                      users)))
+                          #f)))))))))
+
+(define-record-type* <tailon-configuration>
+  tailon-configuration make-tailon-configuration
+  tailon-configuration?
+  (config-file tailon-configuration-config-file
+               (default (tailon-configuration-file)))
+  (package tailon-configuration-package
+           (default tailon)))
+
+(define tailon-shepherd-service
+  (match-lambda
+    (($ <tailon-configuration> config-file package)
+     (list (shepherd-service
+            (provision '(tailon))
+            (documentation "Run the tailon daemon.")
+            (start #~(make-forkexec-constructor
+                      `(,(string-append #$package "/bin/tailon")
+                        "-c" ,#$config-file)
+                      #:user "tailon"
+                      #:group "tailon"))
+            (stop #~(make-kill-destructor)))))))
+
+(define %tailon-accounts
+  (list (user-group (name "tailon") (system? #t))
+        (user-account
+         (name "tailon")
+         (group "tailon")
+         (system? #t)
+         (comment "tailon")
+         (home-directory "/var/empty")
+         (shell (file-append shadow "/sbin/nologin")))))
+
+(define tailon-service-type
+  (service-type
+   (name 'tailon)
+   (description
+    "Run Tailon, a Web application for monitoring, viewing, and searching log
+files.")
+   (extensions
+    (list (service-extension shepherd-root-service-type
+                             tailon-shepherd-service)
+          (service-extension account-service-type
+                             (const %tailon-accounts))))
+   (compose concatenate)
+   (extend (lambda (parameter files)
+             (tailon-configuration
+              (inherit parameter)
+              (config-file
+               (let ((old-config-file
+                      (tailon-configuration-config-file parameter)))
+                 (tailon-configuration-file
+                  (inherit old-config-file)
+                  (files (append (tailon-configuration-file-files old-config-file)
+                                 files))))))))
+   (default-value (tailon-configuration))))
diff --git a/gnu/tests/admin.scm b/gnu/tests/admin.scm
deleted file mode 100644
index a5abbe9ad..000000000
--- a/gnu/tests/admin.scm
+++ /dev/null
@@ -1,127 +0,0 @@
-;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2017 Christopher Baines <mail <at> cbaines.net>
-;;; Copyright © 2018 Clément Lassieur <clement <at> lassieur.org>
-;;;
-;;; This file is part of GNU Guix.
-;;;
-;;; GNU Guix is free software; you can redistribute it and/or modify it
-;;; under the terms of the GNU General Public License as published by
-;;; the Free Software Foundation; either version 3 of the License, or (at
-;;; your option) any later version.
-;;;
-;;; GNU Guix is distributed in the hope that it will be useful, but
-;;; WITHOUT ANY WARRANTY; without even the implied warranty of
-;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-;;; GNU General Public License for more details.
-;;;
-;;; You should have received a copy of the GNU General Public License
-;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
-
-(define-module (gnu tests admin)
-  #:use-module (gnu tests)
-  #:use-module (gnu system)
-  #:use-module (gnu system file-systems)
-  #:use-module (gnu system shadow)
-  #:use-module (gnu system vm)
-  #:use-module (gnu services)
-  #:use-module (gnu services admin)
-  #:use-module (gnu services networking)
-  #:use-module (guix gexp)
-  #:use-module (guix store)
-  #:use-module (guix monads)
-  #:export (%test-tailon))
-
-(define %tailon-os
-  ;; Operating system under test.
-  (simple-operating-system
-   (dhcp-client-service)
-   (service tailon-service-type
-            (tailon-configuration
-             (config-file
-              (tailon-configuration-file
-               (bind "0.0.0.0:8080")))))))
-
-(define* (run-tailon-test #:optional (http-port 8081))
-  "Run tests in %TAILON-OS, which has tailon running and listening on
-HTTP-PORT."
-  (define os
-    (marionette-operating-system
-     %tailon-os
-     #:imported-modules '((gnu services herd)
-                          (guix combinators))))
-
-  (define vm
-    (virtual-machine
-     (operating-system os)
-     (port-forwardings `((,http-port . 8080)))))
-
-  (define test
-    (with-imported-modules '((gnu build marionette))
-      #~(begin
-          (use-modules (srfi srfi-11) (srfi srfi-64)
-                       (ice-9 match)
-                       (gnu build marionette)
-                       (web uri)
-                       (web client)
-                       (web response))
-
-          (define marionette
-            ;; Forward the guest's HTTP-PORT, where tailon is listening, to
-            ;; port 8080 in the host.
-            (make-marionette (list #$vm)))
-
-          (mkdir #$output)
-          (chdir #$output)
-
-          (test-begin "tailon")
-
-          (test-assert "service running"
-            (marionette-eval
-             '(begin
-                (use-modules (gnu services herd))
-                (start-service 'tailon))
-             marionette))
-
-          (define* (retry-on-error f #:key times delay)
-            (let loop ((attempt 1))
-              (match (catch
-                      #t
-                      (lambda ()
-                        (cons #t
-                              (f)))
-                      (lambda args
-                        (cons #f
-                              args)))
-                ((#t . return-value)
-                 return-value)
-                ((#f . error-args)
-                 (if (>= attempt times)
-                     error-args
-                     (begin
-                       (sleep delay)
-                       (loop (+ 1 attempt))))))))
-
-          (test-equal "http-get"
-            200
-            (retry-on-error
-             (lambda ()
-               (let-values (((response text)
-                             (http-get #$(format
-                                          #f
-                                          "http://localhost:~A/"
-                                          http-port)
-                                       #:decode-body? #t)))
-                 (response-code response)))
-             #:times 10
-             #:delay 5))
-
-          (test-end)
-          (exit (= (test-runner-fail-count (test-runner-current)) 0)))))
-
-  (gexp->derivation "tailon-test" test))
-
-(define %test-tailon
-  (system-test
-   (name "tailon")
-   (description "Connect to a running Tailon server.")
-   (value (run-tailon-test))))
diff --git a/gnu/tests/web.scm b/gnu/tests/web.scm
index 73d502dd0..45fcb668f 100644
--- a/gnu/tests/web.scm
+++ b/gnu/tests/web.scm
@@ -33,7 +33,8 @@
   #:export (%test-httpd
             %test-nginx
             %test-php-fpm
-            %test-hpcguix-web))
+            %test-hpcguix-web
+            %test-tailon))
 
 (define %index.html-contents
   ;; Contents of the /index.html file.
@@ -359,3 +360,99 @@ HTTP-PORT, along with php-fpm."
    (name "hpcguix-web")
    (description "Connect to a running hpcguix-web server.")
    (value (run-hpcguix-web-server-test name %hpcguix-web-os))))
+
+
+(define %tailon-os
+  ;; Operating system under test.
+  (simple-operating-system
+   (dhcp-client-service)
+   (service tailon-service-type
+            (tailon-configuration
+             (config-file
+              (tailon-configuration-file
+               (bind "0.0.0.0:8080")))))))
+
+(define* (run-tailon-test #:optional (http-port 8081))
+  "Run tests in %TAILON-OS, which has tailon running and listening on
+HTTP-PORT."
+  (define os
+    (marionette-operating-system
+     %tailon-os
+     #:imported-modules '((gnu services herd)
+                          (guix combinators))))
+
+  (define vm
+    (virtual-machine
+     (operating-system os)
+     (port-forwardings `((,http-port . 8080)))))
+
+  (define test
+    (with-imported-modules '((gnu build marionette))
+      #~(begin
+          (use-modules (srfi srfi-11) (srfi srfi-64)
+                       (ice-9 match)
+                       (gnu build marionette)
+                       (web uri)
+                       (web client)
+                       (web response))
+
+          (define marionette
+            ;; Forward the guest's HTTP-PORT, where tailon is listening, to
+            ;; port 8080 in the host.
+            (make-marionette (list #$vm)))
+
+          (mkdir #$output)
+          (chdir #$output)
+
+          (test-begin "tailon")
+
+          (test-assert "service running"
+            (marionette-eval
+             '(begin
+                (use-modules (gnu services herd))
+                (start-service 'tailon))
+             marionette))
+
+          (define* (retry-on-error f #:key times delay)
+            (let loop ((attempt 1))
+              (match (catch
+                      #t
+                      (lambda ()
+                        (cons #t
+                              (f)))
+                      (lambda args
+                        (cons #f
+                              args)))
+                ((#t . return-value)
+                 return-value)
+                ((#f . error-args)
+                 (if (>= attempt times)
+                     error-args
+                     (begin
+                       (sleep delay)
+                       (loop (+ 1 attempt))))))))
+
+          (test-equal "http-get"
+            200
+            (retry-on-error
+             (lambda ()
+               (let-values (((response text)
+                             (http-get #$(format
+                                          #f
+                                          "http://localhost:~A/"
+                                          http-port)
+                                       #:decode-body? #t)))
+                 (response-code response)))
+             #:times 10
+             #:delay 5))
+
+          (test-end)
+          (exit (= (test-runner-fail-count (test-runner-current)) 0)))))
+
+  (gexp->derivation "tailon-test" test))
+
+(define %test-tailon
+  (system-test
+   (name "tailon")
+   (description "Connect to a running Tailon server.")
+   (value (run-tailon-test))))
-- 
2.18.0





Information forwarded to guix-patches <at> gnu.org:
bug#32660; Package guix-patches. (Fri, 07 Sep 2018 21:16:03 GMT) Full text and rfc822 format available.

Message #11 received at 32660 <at> debbugs.gnu.org (full text, mbox):

From: Ludovic Courtès <ludo <at> gnu.org>
To: 32660 <at> debbugs.gnu.org
Cc: Ludovic Courtès <ludo <at> gnu.org>
Subject: [PATCH 2/2] services: hpcguix-web: Produce a log file and rotate it.
Date: Fri,  7 Sep 2018 23:14:59 +0200
* gnu/services/web.scm (%hpcguix-web-log-file)
(%hpcguix-web-log-rotations): New variables.
(hpcguix-web-shepherd-service): Pass #:log-file.
(hpcguix-web-service-type): Extend ROTTLOG-SERVICE-TYPE.
---
 gnu/services/web.scm | 16 ++++++++++++++--
 1 file changed, 14 insertions(+), 2 deletions(-)

diff --git a/gnu/services/web.scm b/gnu/services/web.scm
index 1c613ac8a..0a5b5f425 100644
--- a/gnu/services/web.scm
+++ b/gnu/services/web.scm
@@ -1,6 +1,6 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2015 David Thompson <davet <at> gnu.org>
-;;; Copyright © 2015, 2016, 2017 Ludovic Courtès <ludo <at> gnu.org>
+;;; Copyright © 2015, 2016, 2017, 2018 Ludovic Courtès <ludo <at> gnu.org>
 ;;; Copyright © 2016 Nils Gillmann <ng0 <at> n0.is>
 ;;; Copyright © 2016, 2017, 2018 Julien Lepiller <julien <at> lepiller.eu>
 ;;; Copyright © 2017 Christopher Baines <mail <at> cbaines.net>
@@ -27,6 +27,7 @@
 (define-module (gnu services web)
   #:use-module (gnu services)
   #:use-module (gnu services shepherd)
+  #:use-module (gnu services admin)
   #:use-module (gnu system pam)
   #:use-module (gnu system shadow)
   #:use-module (gnu packages admin)
@@ -976,6 +977,14 @@ a webserver.")
         (chown home-dir (passwd:uid user) (passwd:gid user))
         (chmod home-dir #o755))))
 
+(define %hpcguix-web-log-file
+  "/var/log/hpcguix-web.log")
+
+(define %hpcguix-web-log-rotations
+  (list (log-rotation
+         (files (list %hpcguix-web-log-file))
+         (frequency 'weekly))))
+
 (define (hpcguix-web-shepherd-service config)
   (let ((specs       (hpcguix-web-configuration-specs config))
         (hpcguix-web (hpcguix-web-package config)))
@@ -993,7 +1002,8 @@ a webserver.")
                  #:group "hpcguix-web"
                  #:environment-variables
                  (list "XDG_CACHE_HOME=/var/cache"
-                       "SSL_CERT_DIR=/etc/ssl/certs")))
+                       "SSL_CERT_DIR=/etc/ssl/certs")
+                 #:log-file #$%hpcguix-web-log-file))
        (stop #~(make-kill-destructor))))))
 
 (define hpcguix-web-service-type
@@ -1005,6 +1015,8 @@ a webserver.")
                              (const %hpcguix-web-accounts))
           (service-extension activation-service-type
                              (const %hpcguix-web-activation))
+          (service-extension rottlog-service-type
+                             (const %hpcguix-web-log-rotations))
           (service-extension shepherd-root-service-type
                              (compose list hpcguix-web-shepherd-service))))))
 
-- 
2.18.0





Reply sent to ludo <at> gnu.org (Ludovic Courtès):
You have taken responsibility. (Mon, 10 Sep 2018 10:20:02 GMT) Full text and rfc822 format available.

Notification sent to Ludovic Courtès <ludo <at> gnu.org>:
bug acknowledged by developer. (Mon, 10 Sep 2018 10:20:02 GMT) Full text and rfc822 format available.

Message #16 received at 32660-done <at> debbugs.gnu.org (full text, mbox):

From: ludo <at> gnu.org (Ludovic Courtès)
To: 32660-done <at> debbugs.gnu.org
Subject: Re: [bug#32660] [PATCH 0/2] Move taylon service to web.scm;
 add log file for hpcguix-web
Date: Mon, 10 Sep 2018 12:18:50 +0200
Ludovic Courtès <ludo <at> gnu.org> skribis:

>   services: tailon: Move to (gnu services web).
>   services: hpcguix-web: Produce a log file and rotate it.

Pushed!




bug archived. Request was from Debbugs Internal Request <help-debbugs <at> gnu.org> to internal_control <at> debbugs.gnu.org. (Mon, 08 Oct 2018 11:24:05 GMT) Full text and rfc822 format available.

This bug report was last modified 6 years and 249 days ago.

Previous Next


GNU bug tracking system
Copyright (C) 1999 Darren O. Benham, 1997,2003 nCipher Corporation Ltd, 1994-97 Ian Jackson.