Hi,

this is the latest version of trytond service and tests.

It does postgres setup automatically as well.
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2018 Adriano Peluso <caton...@gmail.com>
;;;
;;; 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 services trytond)
  #:use-module (gnu services)
  #:use-module (gnu services shepherd)
  #:use-module (gnu system shadow)
  #:use-module (gnu packages admin)
  #:use-module (gnu packages databases)
  #:use-module (gnu packages tryton)
  #:use-module (guix modules)
  #:use-module (guix records)
  #:use-module (guix build utils)
  #:use-module (guix gexp)
  #:use-module (ice-9 match)
  #:export (trytond-service-type
            <trytond-configuration>

            trytond-configuration
            trytond-configuration?

            trytond-configuration-trytond
            trytond-configuration-postgresql
            trytond-configuration-config-file
            trytond-configuration-data-directory
            trytond-configuration-postgres-role
            trytond-configuration-database-name))

;;; Commentary:
;;;
;;; Trytond based services. Mainly Trytond and GNUHealth for now
;;;
;;; Code:

(define %default-trytond-path
  "/var/lib/trytond")

(define %default-postgres-role
  "tryton")

(define %default-database-name
  "tryton")

(define %default-trytond-config
  (mixed-text-file "trytond.conf"
                   "[database]\n"
                   ;; XXX which postgres user shold we use here ?
                   (string-append "uri = postgresql://"
                                  %default-postgres-role
                                  "@127.0.0.1\n")
                   "path = " %default-trytond-path))

(define %default-passfile
  (mixed-text-file "passfile"
                   "tryton"))

(define-record-type* <trytond-configuration>
  trytond-configuration make-trytond-configuration
  trytond-configuration?
  (trytond     trytond-configuration-trytond ;<package>
               (default python-trytond))
  (postgresql  trytond-configuration-postgresql
               (default postgresql))
  (locale         trytond-configuration-locale
                  (default "en_US.utf8"))
  (config-file    trytond-configuration-file
                  (default %default-trytond-config))
  (passfile      trytond-passfile
                 (default %default-passfile))
  ;; Default: The db folder under the user home directory running trytond.
  (data-directory trytond-configuration-data-directory
                  (default %default-trytond-path))
  (postgres-role trytond-configuration-postgres-role
                 (default %default-postgres-role))
  (database-name trytond-configuration-database-name
                 (default %default-database-name)))

(define %trytond-accounts
  (list (user-group (name "trytond") (system? #t))
        (user-account
         (name "trytond")
         (group "trytond")
         (system? #t)
         (comment "Trytond server user")
         (home-directory "/var/empty")
         (shell (file-append shadow "/sbin/nologin")))))

(define (setup-role.sql role)
  (plain-file "setup-role.sql" (format #f "
DO
$body$
BEGIN
   IF NOT EXISTS (
      SELECT *
      FROM   pg_catalog.pg_user
      WHERE  usename = '~A') THEN
      CREATE ROLE \"~A\" LOGIN;
   END IF;
END
$body$;
" role role)))

(define (setup-database.sql database role)
  (plain-file "setup-database.sql"
   (format #f "CREATE DATABASE \"~A\" WITH OWNER = \"~A\";" database role)))

(define (trytond-activation config)
  (let* ((postgresql (trytond-configuration-postgresql config))
         (role (trytond-configuration-postgres-role config))
         (database (trytond-configuration-database-name config))
         (data-directory (trytond-configuration-data-directory config)))
    #~(begin
        (let ((trytond-user (getpwnam "trytond")))
           (mkdir-p #$data-directory)
           (chown #$data-directory
                  (passwd:uid trytond-user)
                  (passwd:gid trytond-user))))))

(define trytond-shepherd-service
  (match-lambda
   (($ <trytond-configuration> trytond
                               postgresql
                               locale
                               config-file
                               passfile
                               data-directory
                               postgres-role
                               database-name)
    (let* ((setup-role.sql (setup-role.sql postgres-role))
           (setup-database.sql (setup-database.sql database-name postgres-role))
           (start-script
            (program-file "start-trytond"
                          (with-imported-modules '((guix build utils))
                            #~(begin
                                (use-modules (guix build utils))
                                ;; Set up postgres database.
                                (let ((psql (string-append #$postgresql
                                                           "/bin/psql")))
                                  (invoke psql "-U" "postgres"
                                               "-f" #$setup-role.sql)
                                  (system* psql "-U" "postgres"
                                                "-f" #$setup-database.sql))
                                ;; Set up tables.
                                (let ((trytond-admin (string-append #$trytond
                                                                    "/bin/trytond-admin"))
                                      (args (append (list "-c" #$config-file
                                                          "-d" #$database-name
                                                          "--all")
                                                    (if #$locale
                                                        (list "-l" #$locale)
                                                        '()))))
                                  (setenv "TRYTONPASSFILE" #$passfile)
                                  (apply invoke trytond-admin args))
                                ;; Start daemon.
                                (execl (string-append #$trytond
                                                      "/bin/trytond")
                                       (string-append #$trytond
                                                      "/bin/trytond")
                                       "-c" #$config-file)
                                (primitive-exit 1))))))
      (list (shepherd-service
                (provision '(trytond))
                (documentation "Trytond daemon.")
                (requirement '(user-processes loopback postgres))
                ; TODO #:pid-file
                (start #~(make-forkexec-constructor #$start-script
                                                    ; #:log-file "/tmp/QQ"
                                                    #:user "trytond"
                                                    #:group "trytond"))
                (stop #~(make-kill-destructor))))))))

(define trytond-service-type
  (service-type (name 'trytond)
                (extensions
                 (list (service-extension shepherd-root-service-type
                                          trytond-shepherd-service)
                       (service-extension activation-service-type
                                          trytond-activation)
                       (service-extension account-service-type
                                          (const %trytond-accounts))))
                (default-value (trytond-configuration))))
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2017 Adriano Peluso <caton...@gmail.com>
;;;
;;; 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 trytond)
  #: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 packages databases)
  #:use-module (gnu services databases)
  #:use-module (gnu services networking)
  #:use-module (gnu services networking)
  #:use-module (gnu services trytond)
  #:use-module (guix gexp)
  #:use-module (guix store)
  #:export (%test-trytond))

(define %trytond-os
  (simple-operating-system
   (postgresql-service #:locale "it_IT.UTF-8")
   (service trytond-service-type)))

(define* (run-trytond-test)
  "Run tests in %TRYTOND-OS."
  (define os
    (marionette-operating-system
     %trytond-os
     #:imported-modules '((gnu services herd)
                          (guix combinators))))

  (define vm
    (virtual-machine
     (operating-system os)
     (memory-size 512)))

  (define test
    (with-imported-modules '((gnu build marionette))
      #~(begin
          (use-modules (srfi srfi-11) (srfi srfi-64)
                       (gnu build marionette))

          (define marionette
            (make-marionette (list #$vm)))

          (mkdir #$output)
          (chdir #$output)

          (test-begin "trytond")
                    (marionette-eval '(current-output-port
                                                 (open-file "/dev/console" "w0"))
                                                                            marionette)
                    (marionette-eval '(current-error-port
                                                 (open-file "/dev/console" "w0"))
                                                                            marionette)
          (test-assert "service running"
            (marionette-eval
             '(begin
                (use-modules (gnu services herd))
                (match (start-service 'trytond)
                  (#f #f)
                  (('service response-parts ...)
                   (match (assq-ref response-parts 'running)
                     ((pid) (number? pid))))))
             marionette))
;          (test-assert "tryton postgres role exists"
;            (marionette-eval
;             '(begin
;                (use-modules (gnu services herd))
;                (match (start-service 'trytond)
;                  (#f #f)
          ;(('service response-parts ...)
          ; chiamare psql con open-pipe* ?
          ; no, restituisce stringe
          ; ci vorrebbe squee
;                   (match (assq-ref response-parts 'running)
;                     ((pid) (number? pid))))))
;             marionette))))
          (test-end)
          (exit (= (test-runner-fail-count (test-runner-current)) 0)))))

  (gexp->derivation "trytond-test" test))

(define %test-trytond
  (system-test
   (name "trytond")
   (description "Test the Trytond service.")
   (value (run-trytond-test))))

Reply via email to