guix-glicid/glicid/services/cuirass.scm

(define-module (glicid services cuirass)
               #:use-module (guix channels)
               #:use-module (guix gexp)
               #:use-module (guix records)
               #:use-module (guix store)
               #:use-module (guix utils)
               #:use-module (gnu packages admin)
               #:use-module (gnu packages ci)
               #:use-module (gnu packages databases)
               #:use-module (gnu packages version-control)
               #:use-module (gnu services)
               #:use-module (gnu services base)
               #:use-module (gnu services databases)
               #:use-module (gnu services shepherd)
               #:use-module (gnu services admin)
               #:use-module (gnu system shadow)
               #:use-module (srfi srfi-1)
               #:use-module (ice-9 match)
               #:export (cuirass-remote-server-configuration
                          cuirass-remote-server-configuration?
                          cuirass-configuration
                          cuirass-configuration?
                          cuirass-service-type
                          cuirass-remote-worker-configuration
                          cuirass-remote-worker-configuration?
                          cuirass-remote-worker-service-type))


(define %cuirass-default-database "dbname=cuirass")

(define-record-type* <cuirass-remote-server-configuration> cuirass-remote-server-configuration make-cuirass-remote-server-configuration cuirass-remote-server-configuration?
                     (backend-port cuirass-remote-server-configuration-backend-port (default 5555))
                     (log-port cuirass-remote-server-configuration-log-port (default 5556))
                     (publish-port cuirass-remote-server-configuration-publish-port (default 5557))
                     (log-file cuirass-remote-server-log-file (default "/var/log/cuirass-remote-server.log"))
                     (cache cuirass-remote-server-configuration-cache (default "/var/cache/cuirass/remote/"))
                     (publish? cuirass-remote-server-configuration-publish? (default #t))
                     (trigger-url cuirass-remote-server-trigger-url (default #f))
                     (public-key cuirass-remote-server-configuration-public-key (default #f))
                     (private-key cuirass-remote-server-configuration-private-key (default #f)))

(define-record-type* <cuirass-configuration> cuirass-configuration make-cuirass-configuration cuirass-configuration?
                     (cuirass cuirass-configuration-cuirass (default cuirass))
                     (log-file cuirass-configuration-log-file (default "/var/log/cuirass.log"))
                     (web-log-file cuirass-configuration-web-log-file (default "/var/log/cuirass-web.log"))
                     (cache-directory cuirass-configuration-cache-directory (default "/var/cache/cuirass"))
                     (user cuirass-configuration-user (default "cuirass"))
                     (group cuirass-configuration-group (default "cuirass"))
                     (interval cuirass-configuration-interval (default 60))
                     (parameters cuirass-configuration-parameters (default #f))
                     (remote-server cuirass-configuration-remote-server (default #f))
                     (database cuirass-configuration-database (default %cuirass-default-database))
                     (port cuirass-configuration-port (default 8081))
                     (host cuirass-configuration-host (default "localhost"))
                     (specifications cuirass-configuration-specifications) 
                     (use-substitutes? cuirass-configuration-use-substitutes? (default #f))
                     (one-shot? cuirass-configuration-one-shot? (default #f))
                     (fallback? cuirass-configuration-fallback? (default #f))
                     (extra-options cuirass-configuration-extra-options (default '()))
                     (http-proxy cuirass-configuration-http-proxy (default ""))
                     (https-proxy cuirass-configuration-https-proxy (default "")))

(define (cuirass-shepherd-service config)
  "Return a <shepherd-service> for the Cuirass service with CONFIG."
  (let ((cuirass (cuirass-configuration-cuirass config))
        (cache-directory (cuirass-configuration-cache-directory config))
        (web-log-file (cuirass-configuration-web-log-file config))
        (main-log-file (cuirass-configuration-log-file config))
        (user (cuirass-configuration-user config))
        (group (cuirass-configuration-group config))
        (interval (cuirass-configuration-interval config))
        (parameters (cuirass-configuration-parameters config))
        (remote-server (cuirass-configuration-remote-server config))
        (database (cuirass-configuration-database config))
        (port (cuirass-configuration-port config))
        (host (cuirass-configuration-host config))
        (specs (cuirass-configuration-specifications config))
        (use-substitutes? (cuirass-configuration-use-substitutes? config))
        (one-shot? (cuirass-configuration-one-shot? config))
        (fallback? (cuirass-configuration-fallback? config))
        (extra-options (cuirass-configuration-extra-options config))
        (http-proxy (cuirass-configuration-http-proxy config))
        (https-proxy (cuirass-configuration-https-proxy config))
        )
    `(,(shepherd-service
         (documentation "Run Cuirass.")
         (provision '(cuirass))
         (requirement '(guix-daemon networking))
         ;(requirement '(guix-daemon postgres postgres-roles networking))
         (start #~(make-forkexec-constructor
                    (list (string-append #$cuirass "/bin/cuirass")
                          "register"
                          "--cache-directory" #$cache-directory
                          "--specifications"
                          #$(scheme-file "cuirass-specs.scm" specs)
                          "--database" #$database
                          "--interval" #$(number->string interval)
                          #$@(if parameters
                               (list (string-append "--parameters=" parameters))
                               '())
                          #$@(if remote-server '("--build-remote") '())
                          #$@(if use-substitutes? '("--use-substitutes") '())
                          #$@(if one-shot? '("--one-shot") '())
                          #$@(if fallback? '("--fallback") '())
                          #$@extra-options)
                    #:environment-variables (list "GIT_SSL_CAINFO=/etc/ssl/certs/ca-certificates.crt"
                                                  (string-append "GIT_EXEC_PATH=" #$git "/libexec/git-core")
                                                  (string-append "http_proxy=" #$http-proxy)
                                                  (string-append "https_proxy=" #$http-proxy))
                    #:user #$user
                    #:group #$group
                    #:log-file #$main-log-file))
         (stop #~(make-kill-destructor)))
       ,(shepherd-service
          (documentation "Run Cuirass web interface.")
          (provision '(cuirass-web))
          (requirement '(cuirass))
          (start #~(make-forkexec-constructor
                     (list (string-append #$cuirass "/bin/cuirass")
                           "web"
                           "--database" #$database
                           "--listen" #$host
                           "--port" #$(number->string port)
                           #$@(if parameters
                                (list (string-append "--parameters=" parameters))
                                '())
                           #$@extra-options)
                     #:user #$user
                     #:group #$group
                     #:log-file #$web-log-file))
          (stop #~(make-kill-destructor)))
       ,@(if remote-server
           (match-record remote-server <cuirass-remote-server-configuration> (backend-port publish-port log-file cache publish? trigger-url public-key private-key)
                         (list
                           (shepherd-service
                             (documentation "Run Cuirass remote build server.")
                             (provision '(cuirass-remote-server))
                             (requirement '(avahi-daemon cuirass))
                             (start #~(make-forkexec-constructor
                                        (list (string-append #$cuirass "/bin/cuirass")
                                              "remote-server"
                                              (string-append "--database=" #$database)
                                              (string-append "--cache=" #$cache)
                                              (string-append "--user=" #$user)
                                              #$@(if backend-port
                                                   (list (string-append "--backend-port=" (number->string backend-port)))
                                                   '())
                                              #$@(if publish-port
                                                   (list (string-append "--publish-port=" (number->string publish-port)))
                                                   '())
                                              #$@(if parameters
                                                   (list (string-append "--parameters=" parameters))
                                                   '())
                                              #$@(if trigger-url
                                                   (list (string-append "--trigger-substitute-url=" trigger-url))
                                                   '())
                                              #$@(if publish?
                                                   '()
                                                   (list "--no-publish"))
                                              #$@(if public-key
                                                   (list (string-append "--public-key=" public-key))
                                                   '())
                                              #$@(if private-key
                                                   (list (string-append "--private-key=" private-key))
                                                   '()))
                                        #:environment-variables (list "GIT_SSL_CAINFO=/etc/ssl/certs/ca-certificates.crt"
                                                                      (string-append "GIT_EXEC_PATH=" #$git "/libexec/git-core")
                                                                      (string-append "http_proxy=" #$http-proxy)
                                                                      (string-append "https_proxy=" #$http-proxy))
                                        #:log-file #$log-file))
                             (stop #~(make-kill-destructor)))))
           '()))))

(define (cuirass-account config)
  "Return the user accounts and user groups for CONFIG."
  (let ((cuirass-user (cuirass-configuration-user config))
        (cuirass-group (cuirass-configuration-group config)))
    (list (user-group
            (name cuirass-group)
            (system? #t))
          (user-account
            (name cuirass-user)
            (group cuirass-group)
            (system? #t)
            (comment "Cuirass privilege separation user")
            (home-directory (string-append "/var/lib/" cuirass-user))
            (shell (file-append shadow "/sbin/nologin"))))))

(define (cuirass-postgresql-role config)
  (let ((user (cuirass-configuration-user config)))
    (list (postgresql-role
            (name user)
            (create-database? #t)))))

(define (cuirass-activation config)
  "Return the activation code for CONFIG."
  (let* ((cache (cuirass-configuration-cache-directory config))
         (remote-server (cuirass-configuration-remote-server config))
         (remote-cache (and remote-server (cuirass-remote-server-configuration-cache remote-server)))
         (user (cuirass-configuration-user config))
         (log "/var/log/cuirass")
         (profile (string-append "/var/guix/profiles/per-user/" user))
         (roots (string-append profile "/cuirass"))
         (group (cuirass-configuration-group config)))
    (with-imported-modules '((guix build utils))
                           #~(begin
                               (use-modules (guix build utils))
                               (mkdir-p #$cache)
                               (mkdir-p #$log)
                               (mkdir-p #$roots)
                               (when #$remote-cache
                                 (mkdir-p #$remote-cache))
                               (let ((uid (passwd:uid (getpw #$user)))
                                     (gid (group:gid (getgr #$group))))
                                 (chown #$cache uid gid)
                                 (chown #$log uid gid)
                                 (chown #$roots uid gid)
                                 (chown #$profile uid gid)
                                 (when #$remote-cache
                                   (chown #$remote-cache uid gid)))))))

(define (cuirass-log-rotations config)
  "Return the list of log rotations that corresponds to CONFIG."
  (list (log-rotation
          (files (append (list (cuirass-configuration-log-file config)
                               (cuirass-configuration-web-log-file config))
                         (let ((server
                                 (cuirass-configuration-remote-server config)))
                           (if server
                             (list (cuirass-remote-server-log-file server))
                             '()))))
          (frequency 'weekly)
          (options `("rotate 40" ,@%default-log-rotation-options)))))

(define cuirass-service-type
  (service-type
    (name 'cuirass)
    (extensions
      (list
        (service-extension profile-service-type (compose list cuirass-configuration-cuirass))
        (service-extension rottlog-service-type cuirass-log-rotations)
        (service-extension activation-service-type cuirass-activation)
        (service-extension shepherd-root-service-type cuirass-shepherd-service)
        (service-extension account-service-type cuirass-account)
        ; we don't need the following as we use a remote database
        ;(service-extension postgresql-service-type (const #t))
        ;(service-extension postgresql-role-service-type cuirass-postgresql-role)
        ))
    (description "Run the Cuirass continuous integration service.")))


(define-record-type* <cuirass-remote-worker-configuration> cuirass-remote-worker-configuration make-cuirass-remote-worker-configuration cuirass-remote-worker-configuration?
                     (cuirass cuirass-remote-worker-configuration-cuirass (default cuirass))
                     (workers cuirass-remote-worker-workers (default 1))
                     (server cuirass-remote-worker-server (default #f))
                     (systems cuirass-remote-worker-systems (default (list (%current-system))))
                     (log-file cuirass-remote-worker-log-file (default "/var/log/cuirass-remote-worker.log"))
                     (publish-port cuirass-remote-worker-configuration-publish-port (default 5558))
                     (substitute-urls cuirass-remote-worker-configuration-substitute-urls (default %default-substitute-urls)) 
                     (public-key cuirass-remote-worker-configuration-public-key (default #f))
                     (private-key cuirass-remote-worker-configuration-private-key (default #f))
                     (http-proxy cuirass-configuration-http-proxy (default ""))
                     (https-proxy cuirass-configuration-https-proxy (default ""))
                     )

(define (cuirass-remote-worker-shepherd-service config)
  "Return a <shepherd-service> for the Cuirass remote worker service with CONFIG."
  (match-record config <cuirass-remote-worker-configuration> (cuirass workers server systems log-file publish-port substitute-urls public-key private-key http-proxy https-proxy)
                (list (shepherd-service
                        (documentation "Run Cuirass remote build worker.")
                        (provision '(cuirass-remote-worker))
                        (requirement '(avahi-daemon guix-daemon networking))
                        (start #~(make-forkexec-constructor
                                   (list (string-append #$cuirass "/bin/cuirass")
                                         "remote-worker"
                                         (string-append "--workers=" #$(number->string workers))
                                         #$@(if server
                                              (list (string-append "--server=" server))
                                              '())
                                         #$@(if systems
                                              (list (string-append "--systems=" (string-join systems ",")))
                                              '())
                                         #$@(if publish-port
                                              (list (string-append "--publish-port=" (number->string publish-port)))
                                              '())
                                         #$@(if substitute-urls
                                              (list (string-append "--substitute-urls=" (string-join substitute-urls)))
                                              '())
                                         #$@(if public-key
                                              (list (string-append "--public-key=" public-key))
                                              '())
                                         #$@(if private-key
                                              (list (string-append "--private-key=" private-key))
                                              '()))
                                   #:environment-variables (list "GIT_SSL_CAINFO=/etc/ssl/certs/ca-certificates.crt"
                                                                 (string-append "GIT_EXEC_PATH=" #$git "/libexec/git-core")
                                                                 (string-append "http_proxy=" #$http-proxy)
                                                                 (string-append "https_proxy=" #$http-proxy))
                                   #:log-file #$log-file))
                        (stop #~(make-kill-destructor))))))

(define (cuirass-remote-worker-log-rotations config)
  "Return the list of log rotations that corresponds to CONFIG."
  (list (log-rotation
          (files (list (cuirass-remote-worker-log-file config)))
          (frequency 'weekly)
          (options `("rotate 4" ,@%default-log-rotation-options)))))

(define cuirass-remote-worker-service-type
  (service-type
    (name 'cuirass-remote-worker)
    (extensions
      (list (service-extension shepherd-root-service-type cuirass-remote-worker-shepherd-service)
            (service-extension rottlog-service-type cuirass-remote-worker-log-rotations)))
    (description "Run the Cuirass remote build worker service.")))