~ruther/guix-local

730ed6ec8b69a0f908a8aadbbe0555dd45de227c — Christopher Baines 8 years ago b5244fc
gnu: services: admin: Add tailon.

* gnu/services/admin.scm
  (<tailon-configuration>, <tailon-configuration-file>): New record types.
  (tailon-configuration-files-string, tailon-shepherd-service): New
  procedures.
  (%tailon-accounts, tailon-service-type: New variables.
* doc/guix.texi (Monitoring Services: Document the Tailon service.
* gnu/local.mk (GNU_SYSTEM_MODULES): Add gnu/tests/admin.scm.
* gnu/tests/admin.scm: New file.
4 files changed, 369 insertions(+), 1 deletions(-)

M doc/guix.texi
M gnu/local.mk
M gnu/services/admin.scm
A gnu/tests/admin.scm
M doc/guix.texi => doc/guix.texi +90 -0
@@ 219,6 219,7 @@ Services
* Database Services::           SQL databases.
* Mail Services::               IMAP, POP3, SMTP, and all that.
* Messaging Services::          Messaging services.
* Monitoring Services::         Monitoring services.
* Kerberos Services::           Kerberos services.
* Web Services::                Web servers.
* DNS Services::                DNS daemons.


@@ 9011,6 9012,7 @@ declaration.
* Database Services::           SQL databases.
* Mail Services::               IMAP, POP3, SMTP, and all that.
* Messaging Services::          Messaging services.
* Monitoring Services::         Monitoring services.
* Kerberos Services::           Kerberos services.
* Web Services::                Web servers.
* DNS Services::                DNS daemons.


@@ 13599,6 13601,94 @@ string, you could instantiate a prosody service like this:
          (prosody.cfg.lua "")))
@end example

@node Monitoring Services
@subsubsection Monitoring Services

@subsubheading Tailon Service

@uref{https://tailon.readthedocs.io/, Tailon} is a web application for
viewing and searching log files.

The following example will configure the service with default values.
By default, Tailon can be accessed on port 8080 (@code{http://localhost:8080}).

@example
(service tailon-service-type)
@end example

The following example customises more of the Tailon configuration,
adding @command{sed} to the list of allowed commands.

@example
(service tailon-service-type
         (tailon-configuration
           (config-file
             (tailon-configuration-file
               (allowed-commands '("tail" "grep" "awk" "sed"))))))
@end example


@deftp {Data Type} tailon-configuration
Data type representing the configuration of Tailon.
This type has the following parameters:

@table @asis
@item @code{config-file} (default: @code{(tailon-configuration-file)})
The configuration file to use for Tailon. This can be set to a
@dfn{tailon-configuration-file} record value, or any gexp
(@pxref{G-Expressions}).

For example, to instead use a local file, the @code{local-file} function
can be used:

@example
(service tailon-service-type
         (tailon-configuration
           (config-file (local-file "./my-tailon.conf"))))
@end example

@item @code{package} (default: @code{tailon})
The tailon package to use.

@end table
@end deftp

@deftp {Data Type} tailon-configuration-file
Data type representing the configuration options for Tailon.
This type has the following parameters:

@table @asis
@item @code{files} (default: @code{(list "/var/log")})
List of files to display. The list can include strings for a single file
or directory, or a list, where the first item is the name of a
subsection, and the remaining items are the files or directories in that
subsection.

@item @code{bind} (default: @code{"localhost:8080"})
Address and port to which Tailon should bind on.

@item @code{relative-root} (default: @code{#f})
URL path to use for Tailon, set to @code{#f} to not use a path.

@item @code{allow-transfers?} (default: @code{#t})
Allow downloading the log files in the web interface.

@item @code{follow-names?} (default: @code{#t})
Allow tailing of not-yet existent files.

@item @code{tail-lines} (default: @code{200})
Number of lines to read initially from each file.

@item @code{allowed-commands} (default: @code{(list "tail" "grep" "awk")})
Commands to allow running. By default, @code{sed} is disabled.

@item @code{debug?} (default: @code{#f})
Set @code{debug?} to @code{#t} to show debug messages.

@end table
@end deftp


@node Kerberos Services
@subsubsection Kerberos Services
@cindex Kerberos

M gnu/local.mk => gnu/local.mk +1 -0
@@ 478,6 478,7 @@ GNU_SYSTEM_MODULES =				\
  %D%/build/vm.scm				\
						\
  %D%/tests.scm					\
  %D%/tests/admin.scm				\
  %D%/tests/base.scm				\
  %D%/tests/dict.scm				\
  %D%/tests/nfs.scm				\

M gnu/services/admin.scm => gnu/services/admin.scm +150 -1
@@ 20,14 20,19 @@
(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



@@ 41,7 46,27 @@
            rottlog-configuration
            rottlog-configuration?
            rottlog-service
            rottlog-service-type))
            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>
            tailon-configuration
            tailon-configuration?
            tailon-configuration-config-file
            tailon-configuration-package

            tailon-service-type))

;;; Commentary:
;;;


@@ 172,4 197,128 @@ for ROTATION."
                                 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)))

(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?)
     (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 ", ")
                                        "]"))
          ,@(if debug? '(("debug" . "true")) '()))))))))

(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)
   (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

A gnu/tests/admin.scm => gnu/tests/admin.scm +128 -0
@@ 0,0 1,128 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2017 Christopher Baines <mail@cbaines.net>
;;;
;;; 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-eq "service running"
            'running!
            (marionette-eval
             '(begin
                (use-modules (gnu services herd))
                (start-service 'tailon)
                'running!)
             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))))