* gnu/services/trytond.scm, gnu/tests/trytond.scm
@ 2018-02-02 16:50 Danny Milosavljevic
2018-02-05 13:16 ` Ludovic Courtès
0 siblings, 1 reply; 2+ messages in thread
From: Danny Milosavljevic @ 2018-02-02 16:50 UTC (permalink / raw)
To: guix-devel
[-- Attachment #1: Type: text/plain, Size: 109 bytes --]
Hi,
this is the latest version of trytond service and tests.
It does postgres setup automatically as well.
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: trytond.scm --]
[-- Type: text/x-scheme, Size: 8327 bytes --]
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2018 Adriano Peluso <catonano@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))))
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #3: trytond.scm --]
[-- Type: text/x-scheme, Size: 3849 bytes --]
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2017 Adriano Peluso <catonano@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))))
^ permalink raw reply [flat|nested] 2+ messages in thread
* Re: gnu/services/trytond.scm, gnu/tests/trytond.scm
2018-02-02 16:50 gnu/services/trytond.scm, gnu/tests/trytond.scm Danny Milosavljevic
@ 2018-02-05 13:16 ` Ludovic Courtès
0 siblings, 0 replies; 2+ messages in thread
From: Ludovic Courtès @ 2018-02-05 13:16 UTC (permalink / raw)
To: Danny Milosavljevic; +Cc: guix-devel
Hey Danny,
Danny Milosavljevic <dannym@scratchpost.org> skribis:
> this is the latest version of trytond service and tests.
Neat, looks like it’s pretty much ready for submission?
Ludo’.
^ permalink raw reply [flat|nested] 2+ messages in thread
end of thread, other threads:[~2018-02-05 13:16 UTC | newest]
Thread overview: 2+ messages (download: mbox.gz follow: Atom feed
-- links below jump to the message on this page --
2018-02-02 16:50 gnu/services/trytond.scm, gnu/tests/trytond.scm Danny Milosavljevic
2018-02-05 13:16 ` Ludovic Courtès
Code repositories for project(s) associated with this public inbox
https://git.savannah.gnu.org/cgit/guix.git
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).