unofficial mirror of guix-devel@gnu.org 
 help / color / mirror / code / Atom feed
* GSoC 2018 Syntax and semantics of systemd units in the Shepherd - 1st update
@ 2018-06-11  3:02 Ioannis Panagiotis Koutsidis
  2018-06-11 11:47 ` Ludovic Courtès
  2018-06-25 10:47 ` Gábor Boskovits
  0 siblings, 2 replies; 6+ messages in thread
From: Ioannis Panagiotis Koutsidis @ 2018-06-11  3:02 UTC (permalink / raw)
  To: guix-devel

[-- Attachment #1: Type: text/plain, Size: 591 bytes --]

Hi Guix!

As the 1st phase is coming to an end I decided to post my progress. I have
implemented the unit file parsing as well as some of the basic entries supported
by it, such as ExecStart, User, Group, Restart, etc. In addition, support for
the systemd Restart values (on-success, on-failure, on-abnormal, and on-abort)
was added to the Shepherd via the restart-systemd field in the <service> class,
letting services written in guile to also use that feature.

During the next phases I will focus on other common .service entries, .socket
support, as well as thoroughly testing the code.

[-- Attachment #2: patch --]
[-- Type: text/plain, Size: 14731 bytes --]

From a0a46ead5e43cd2672a08adb4c16919c377514c2 Mon Sep 17 00:00:00 2001
From: Ioannis Panagiotis Koutsidis <ixk680@student.bham.ac.uk>
Date: Sat, 9 Jun 2018 16:17:27 +0300
Subject: [PATCH] Initial systemd unit support

---
 modules/shepherd/service.scm |  78 ++++++++++++-------
 modules/shepherd/systemd.scm | 143 +++++++++++++++++++++++++++++++++++
 2 files changed, 194 insertions(+), 27 deletions(-)
 create mode 100644 modules/shepherd/systemd.scm

diff --git a/modules/shepherd/service.scm b/modules/shepherd/service.scm
index 93d3779..5b0d72d 100644
--- a/modules/shepherd/service.scm
+++ b/modules/shepherd/service.scm
@@ -4,6 +4,7 @@
 ;; Copyright (C) 2014 Alex Sassmannshausen <alex.sassmannshausen@gmail.com>
 ;; Copyright (C) 2016 Alex Kost <alezost@gmail.com>
 ;; Copyright (C) 2018 Carlo Zancanaro <carlo@zancanaro.id.au>
+;; Copyright (C) 2018 Ioannis Panagiotis Koutsidis <gk.ppp7@gmail.com>
 ;;
 ;; This file is part of the GNU Shepherd.
 ;;
@@ -165,6 +166,11 @@ respawned, shows that it has been respawned more than TIMES in SECONDS."
   (respawn? #:init-keyword #:respawn?
 	    #:init-value #f
 	    #:getter respawn?)
+  ;; For the systemd restart values.  Can be 'no (when respawn? is #f),
+  ;; 'on-success, 'on-failure, 'on-abnormal, 'on-watchdog, 'on-abort, or 'always
+  (respawn-systemd #:init-keyword #:respawn-systemd
+                   #:init-value 'always
+                   #:getter respawn-systemd)
   ;; The action to perform to start the service.  This must be a
   ;; procedure and may take an arbitrary amount of arguments, but it
   ;; must be possible to call it without any argument.  If the
@@ -270,7 +276,7 @@ wire."
 (define-method (running? (obj <service>))
   (and (slot-ref obj 'running) #t))
 
-;; Return a list of all actions implemented by OBJ. 
+;; Return a list of all actions implemented by OBJ.
 (define-method (action-list (obj <service>))
   (map action-name (slot-ref obj 'actions)))
 
@@ -886,9 +892,12 @@ start."
 ;; Produce a destructor that sends SIGNAL to the process with the pid
 ;; given as argument, where SIGNAL defaults to `SIGTERM'.
 (define make-kill-destructor
-  (lambda* (#:optional (signal SIGTERM))
+  (lambda* (#:optional (signal SIGTERM)
+                       (timeout #f))
     (lambda (pid . args)
       (kill pid signal)
+      ;; TODO: Make sure that the process has actually stopped by timeout.
+      ;; If it has not, send a SIGKILL
       #f)))
 
 ;; Produce a constructor that executes a command.
@@ -996,7 +1005,7 @@ otherwise by updating its state."
       ((0 . _)
        ;; Nothing left to wait for.
        #t)
-      ((pid . _)
+      ((pid . status)
        (let ((serv (find-service (lambda (serv)
                                    (and (enabled? serv)
                                         (match (slot-ref serv 'running)
@@ -1007,13 +1016,13 @@ otherwise by updating its state."
          ;; SERV can be #f for instance when this code runs just after a
          ;; service's 'stop' method killed its process and completed.
          (when serv
-           (respawn-service serv))
+           (respawn-service serv status))
 
          ;; As noted in libc's manual (info "(libc) Process Completion"),
          ;; loop so we don't miss any terminated child process.
          (loop))))))
 
-(define (respawn-service serv)
+(define (respawn-service serv status)
   "Respawn a service that has stopped running unexpectedly. If we have
 attempted to respawn the service a number of times already and it keeps dying,
 then disable it."
@@ -1022,22 +1031,37 @@ then disable it."
            (not (respawn-limit-hit? (slot-ref serv 'last-respawns)
                                     (car respawn-limit)
                                     (cdr respawn-limit))))
-      (if (not (slot-ref serv 'waiting-for-termination?))
-          (begin
-            ;; Everything is okay, start it.
-            (local-output "Respawning ~a."
-                          (canonical-name serv))
-            (slot-set! serv 'last-respawns
-                       (cons (current-time)
-                             (slot-ref serv 'last-respawns)))
-            (start serv))
-          ;; We have just been waiting for the
-          ;; termination.  The `running' slot has already
-          ;; been set to `#f' by `stop'.
-          (begin
-            (local-output "Service ~a terminated."
-                          (canonical-name serv))
-            (slot-set! serv 'waiting-for-termination? #f)))
+      (let* ([e (status:exit-val status)]
+             [t (status:term-sig status)]
+             [r (respawn-systemd serv)]
+             [clean (or (zero?  e)
+                        (equal? t SIGHUP)
+                        (equal? t SIGINT)
+                        (equal? t SIGTERM)
+                        (equal? t SIGPIPE))])
+        (if (or (equal? r 'always)
+                (equal? r 'on-watchdog) ;; not implemented yet
+                (and (equal? r 'on-success) clean)
+                (and (equal? r 'on-abnormal) (not clean) (equal? e #f))
+                (and (equal? r 'on-failure)  (not clean))
+                (and (equal? r 'on-abort)    (equal? t SIGABRT)))
+            (if (not (slot-ref serv 'waiting-for-termination?))
+                (begin
+                  ;; Everything is okay, start it.
+                  (local-output "Respawning ~a."
+                                (canonical-name serv))
+                  (slot-set! serv 'last-respawns
+                             (cons (current-time)
+                                   (slot-ref serv 'last-respawns)))
+                  (start serv))
+                ;; We have just been waiting for the
+                ;; termination.  The `running' slot has already
+                ;; been set to `#f' by `stop'.
+                (begin
+                  (local-output "Service ~a terminated."
+                                (canonical-name serv))
+                  (slot-set! serv 'waiting-for-termination? #f)))
+            #f))
       (begin
         (local-output "Service ~a has been disabled."
                       (canonical-name serv))
@@ -1062,10 +1086,10 @@ then disable it."
 
     ;; Insert into the hash table.
     (for-each (lambda (name)
-		(let ((old (lookup-services name)))
-		  ;; Actually add the new service now.
-		  (hashq-set! %services name (cons new old))))
-	      (provided-by new)))
+                (let ((old (lookup-services name)))
+                  ;; Actually add the new service now.
+                  (hashq-set! %services name (cons new old))))
+              (provided-by new)))
 
   (for-each register-single-service new-services))
 
@@ -1186,8 +1210,8 @@ where prctl/PR_SET_CHILD_SUBREAPER is unsupported."
                       (let ((running (slot-ref service 'running)))
                         (when (and (integer? running)
                                    (not (process-exists? running)))
-                            (local-output "PID ~a (~a) is dead!" running (canonical-name service))
-                            (respawn-service service))))))
+                          (local-output "PID ~a (~a) is dead!" running (canonical-name service))
+                          (respawn-service service #f)))))) ;; TODO; get the status
 
 (define root-service
   (make <service>
diff --git a/modules/shepherd/systemd.scm b/modules/shepherd/systemd.scm
new file mode 100644
index 0000000..77679fa
--- /dev/null
+++ b/modules/shepherd/systemd.scm
@@ -0,0 +1,143 @@
+;; systemd.scm -- Systemd support
+;; Copyright (C) 2018 Ioannis Panagiotis Koutsidis <gk.ppp7@gmail.com>
+;;
+;; This file is part of the GNU Shepherd.
+;;
+;; The GNU Shepherd 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.
+;;
+;; The GNU Shepherd 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 the GNU Shepherd.  If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (shepherd systemd)
+  #:use-module (ice-9 match)
+  #:use-module (ice-9 textual-ports)
+  #:use-module (oop goops)
+  #:use-module (shepherd service)
+  #:export (make-systemd-service))
+
+;; Change this
+(define unitdir "/systemd/")
+
+;; Implements a state machine to parse the ini-like systemd unit files
+(define (unit-parse s)
+  (letrec ([unit-parse (lambda (s state key value kv)
+                         (match (list s state)
+                           [((or (#\newline _ ...)
+                                 ()) 'keypart)
+                            (error "Key " (list->string key) " is missing its value")]
+                           [(() (or 'valuepart 'firstchar 'ignoreline))
+                            kv]
+                           [lst (let ([rest (cdar lst)])
+                                  (match (list (caar lst) state)
+                                    [((or #\;
+                                          #\[) 'firstchar)
+                                     (unit-parse rest
+                                                 'ignoreline
+                                                 '()
+                                                 '()
+                                                 kv)]
+                                    [(#\newline (or 'firstchar
+                                                    'ignoreline))
+                                     (unit-parse rest
+                                                 'firstchar
+                                                 '()
+                                                 '()
+                                                 kv)]
+                                    [(#\= 'keypart)
+                                     (unit-parse rest
+                                                 'valuepart
+                                                 key
+                                                 '()
+                                                 kv)]
+                                    [(#\newline 'valuepart)
+                                     (unit-parse rest
+                                                 'firstchar
+                                                 '()
+                                                 '()
+                                                 `((,(list->string key)
+                                                    . ,(list->string value))
+                                                   . ,kv))]
+                                    [(_ 'ignoreline)
+                                     (unit-parse rest
+                                                 'ignoreline
+                                                 '()
+                                                 '()
+                                                 kv)]
+                                    [(c 'valuepart)
+                                     (unit-parse rest
+                                                 'valuepart
+                                                 key
+                                                 (append value `(,c))
+                                                 kv)]
+                                    [(c (or 'keypart 'firstchar))
+                                     (unit-parse rest
+                                                 'keypart
+                                                 (append key `(,c))
+                                                 '()
+                                                 kv)]))]))])
+    (unit-parse (string->list s) 'firstchar '() '() '())))
+
+(define (unit-parse-file path)
+  (let* ([in (open-input-file path)]
+         [out (unit-parse (get-string-all in))])
+    (close-port in)
+    out))
+
+;; like assoc but uses a coninuation for failure and success
+(define (kassoc key alst failure success)
+  (let ((res (assoc key alst)))
+    (if (equal? res #f)
+        failure
+        (success (cdr res)))))
+
+;; like assoc but 1: allows the use of a default value on failure
+;; and 2: returns just the value instead of (cons key value)
+(define (dassoc key alst default)
+  (kassoc key alst default (lambda (x) x)))
+
+(define (make-systemd-service name)
+  (let* ([alst      (unit-parse-file (string-append unitdir name))]
+         [busname   (dassoc "BusName"   alst #f)]
+         [execstart (dassoc "ExecStart" alst #f)]
+         [type      (dassoc "Type"      alst (if (equal? execstart #f)
+                                                 "oneshot"
+                                                 (if (equal? busname #f)
+                                                     "simple"
+                                                     "dbus")))]
+         [restart         (string->symbol (dassoc "Restart" alst "no"))]
+         [user            (dassoc "User"             alst #f)]
+         [group           (dassoc "Group"            alst #f)]
+         [rootdir         (dassoc "RootDirectory"    alst "/")] ;; not currently used
+         [workdir         (dassoc "WorkingDirectory" alst rootdir)]
+         [command         execstart])
+
+    (make <service>
+      #:docstring (dassoc "Description" alst "")
+      #:provides  `(,(string->symbol name))
+      #:requires  (let* ([req  (string-split (dassoc "Requires" alst "") #\space)]
+                         [req2 (if (equal? req '(""))
+                                   '()
+                                   (map string->symbol req))])
+                    (if (equal? type "dbus")
+                        (append req2 'dbus.service)
+                        req2))
+      #:respawn-systemd restart
+      #:respawn?        #t
+      #:start           (cond [(and (equal? type "simple") (not (equal? command #f)))
+                               (make-forkexec-constructor (list "/bin/sh" "-c" command)
+                                                          #:user      user
+                                                          #:group     group
+                                                          #:directory workdir)]
+                              [#t '()]) ; TODO: non-simple services (which exit)
+                                        ;       should not use make-forkexec-constructor
+      #:stop            (make-kill-destructor #:timeout 60))))
+
+(register-services (make-systemd-service "test.service"))
-- 
2.17.1


^ permalink raw reply related	[flat|nested] 6+ messages in thread

* Re: GSoC 2018 Syntax and semantics of systemd units in the Shepherd - 1st update
  2018-06-11  3:02 GSoC 2018 Syntax and semantics of systemd units in the Shepherd - 1st update Ioannis Panagiotis Koutsidis
@ 2018-06-11 11:47 ` Ludovic Courtès
  2018-06-11 12:07   ` Ioannis Panagiotis Koutsidis
  2018-06-25 10:47 ` Gábor Boskovits
  1 sibling, 1 reply; 6+ messages in thread
From: Ludovic Courtès @ 2018-06-11 11:47 UTC (permalink / raw)
  To: Ioannis Panagiotis Koutsidis; +Cc: guix-devel

Hello Ioannis!

Thanks for the update!

Ioannis Panagiotis Koutsidis <IXK680@student.bham.ac.uk> skribis:

> As the 1st phase is coming to an end I decided to post my progress. I have
> implemented the unit file parsing as well as some of the basic entries supported
> by it, such as ExecStart, User, Group, Restart, etc. In addition, support for
> the systemd Restart values (on-success, on-failure, on-abnormal, and on-abort)
> was added to the Shepherd via the restart-systemd field in the <service> class,
> letting services written in guile to also use that feature.

Very nice!  

> During the next phases I will focus on other common .service entries, .socket
> support, as well as thoroughly testing the code.

Cool.  Adding unit tests like those currently under tests/ is definitely
something you should do—you probably already run tests manually anyway,
so it’s mostly a matter of putting them in a file.

For things like the unit file parser, you may find it more convenient to
write the test in Scheme (currently all the tests are shell scripts.)
That can easily be done by using the .scm file name extension for your
test and then defining ‘SCM_LOG_COMPILER’ in Makefile.am.  If unsure,
you can look at how Guix itself does it, or just stop by on #guix or ask
on the list for details.

Some comments about the code:

> From a0a46ead5e43cd2672a08adb4c16919c377514c2 Mon Sep 17 00:00:00 2001
> From: Ioannis Panagiotis Koutsidis <ixk680@student.bham.ac.uk>
> Date: Sat, 9 Jun 2018 16:17:27 +0300
> Subject: [PATCH] Initial systemd unit support

Could you try to split it in several patches, where each patch
represents a single “logical” change?

By that I mean that you could have a first patch that modifies ‘restart’
and all in (shepherd service), possibly with extended tests to exercise
the new functionality if appropriate.

A second patch would add the unit file parser in (shepherd systemd)
along with its unit test.

For commit logs, please try to follow the ChangeLog convention:
<https://www.gnu.org/prep/standards/html_node/Change-Logs.html>.  You
can look at ‘git log’ and basically try to mimic what’s been done
before.  Don’t lose your hair over commit logs though; it’s good to try
to follow the conventions, but if you’re unsure or if you make mistakes,
it’s not the end of the world.

> @@ -165,6 +166,11 @@ respawned, shows that it has been respawned more than TIMES in SECONDS."
>    (respawn? #:init-keyword #:respawn?
>  	    #:init-value #f
>  	    #:getter respawn?)
> +  ;; For the systemd restart values.  Can be 'no (when respawn? is #f),
> +  ;; 'on-success, 'on-failure, 'on-abnormal, 'on-watchdog, 'on-abort, or 'always
> +  (respawn-systemd #:init-keyword #:respawn-systemd
> +                   #:init-value 'always
> +                   #:getter respawn-systemd)

As briefly discussed on IRC, I think we should keep a single field for
this.  So perhaps ‘respawn?’ must simply be renamed to ‘respawn’ (no
question mark), with a comment like above explaining what the possible
values are.

> +      (let* ([e (status:exit-val status)]
> +             [t (status:term-sig status)]
> +             [r (respawn-systemd serv)]

Please avoid square brackets to remain consistent with the rest of the
code.  :-)

> +             [clean (or (zero?  e)
> +                        (equal? t SIGHUP)
> +                        (equal? t SIGINT)
> +                        (equal? t SIGTERM)
> +                        (equal? t SIGPIPE))])

Use ‘=’ rather than ‘equal?’ when we know we’re dealing with numbers.

> +        (if (or (equal? r 'always)
> +                (equal? r 'on-watchdog) ;; not implemented yet
> +                (and (equal? r 'on-success) clean)
> +                (and (equal? r 'on-abnormal) (not clean) (equal? e #f))
> +                (and (equal? r 'on-failure)  (not clean))
> +                (and (equal? r 'on-abort)    (equal? t SIGABRT)))

Likewise, use ‘eq?’ for symbols.

> +++ b/modules/shepherd/systemd.scm
> @@ -0,0 +1,143 @@
> +;; systemd.scm -- Systemd support
> +;; Copyright (C) 2018 Ioannis Panagiotis Koutsidis <gk.ppp7@gmail.com>
> +;;
> +;; This file is part of the GNU Shepherd.
> +;;
> +;; The GNU Shepherd 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.
> +;;
> +;; The GNU Shepherd 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 the GNU Shepherd.  If not, see <http://www.gnu.org/licenses/>.
> +
> +(define-module (shepherd systemd)
> +  #:use-module (ice-9 match)
> +  #:use-module (ice-9 textual-ports)
> +  #:use-module (oop goops)
> +  #:use-module (shepherd service)
> +  #:export (make-systemd-service))
> +
> +;; Change this
> +(define unitdir "/systemd/")

I think we can remove it altogether.  :-)

> +;; Implements a state machine to parse the ini-like systemd unit files
> +(define (unit-parse s)

Please turn the comment into a docstring.

Also, it may be more idiomatic to take an input port instead of a string
as input.  As a result, you’ll have to call ‘read-char’ instead of
traversing the list of characters, but otherwise the code should be
pretty much the same.

How does that sound?

Also, I’d use the name ‘read-unit-file’ for this procedure, which is
more inline with some naming conventions.

> +  (letrec ([unit-parse (lambda (s state key value kv)
> +                         (match (list s state)
> +                           [((or (#\newline _ ...)
> +                                 ()) 'keypart)
> +                            (error "Key " (list->string key) " is missing its value")]
> +                           [(() (or 'valuepart 'firstchar 'ignoreline))
> +                            kv]
> +                           [lst (let ([rest (cdar lst)])
> +                                  (match (list (caar lst) state)
> +                                    [((or #\;
> +                                          #\[) 'firstchar)
> +                                     (unit-parse rest
> +                                                 'ignoreline
> +                                                 '()
> +                                                 '()
> +                                                 kv)]
> +                                    [(#\newline (or 'firstchar
> +                                                    'ignoreline))
> +                                     (unit-parse rest
> +                                                 'firstchar
> +                                                 '()
> +                                                 '()
> +                                                 kv)]
> +                                    [(#\= 'keypart)
> +                                     (unit-parse rest
> +                                                 'valuepart
> +                                                 key
> +                                                 '()
> +                                                 kv)]
> +                                    [(#\newline 'valuepart)
> +                                     (unit-parse rest
> +                                                 'firstchar
> +                                                 '()
> +                                                 '()
> +                                                 `((,(list->string key)
> +                                                    . ,(list->string value))
> +                                                   . ,kv))]
> +                                    [(_ 'ignoreline)
> +                                     (unit-parse rest
> +                                                 'ignoreline
> +                                                 '()
> +                                                 '()
> +                                                 kv)]
> +                                    [(c 'valuepart)
> +                                     (unit-parse rest
> +                                                 'valuepart
> +                                                 key
> +                                                 (append value `(,c))
> +                                                 kv)]
> +                                    [(c (or 'keypart 'firstchar))
> +                                     (unit-parse rest
> +                                                 'keypart
> +                                                 (append key `(,c))
> +                                                 '()
> +                                                 kv)]))]))])

Instead of ‘letrec’, which leads to code that goes far to the right, you
can use ‘define’ like this (it’s equivalent):

  (define (read-unit-file port)
    (define (parse s state key value kv)
      …)
    (parse …))

Please always use ‘match’ instead of ‘car’, ‘cdr’, etc., and avoid
abbreviations.  See
<https://www.gnu.org/software/guix/manual/html_node/Coding-Style.html>,
which mostly applies to the Shepherd as well.

> +(define (unit-parse-file path)
> +  (let* ([in (open-input-file path)]
> +         [out (unit-parse (get-string-all in))])
> +    (close-port in)
> +    out))

This will probably not be needed anymore (just like Scheme itself
provides a ‘read’ procedure and no ‘read-file’ procedure.)

> +;; like assoc but uses a coninuation for failure and success
> +(define (kassoc key alst failure success)
> +  (let ((res (assoc key alst)))
> +    (if (equal? res #f)
> +        failure
> +        (success (cdr res)))))
> +
> +;; like assoc but 1: allows the use of a default value on failure
> +;; and 2: returns just the value instead of (cons key value)
> +(define (dassoc key alst default)
> +  (kassoc key alst default (lambda (x) x)))

Most likely these are not needed.  :-)

> +(define (make-systemd-service name)

Rather:

  (unit-file->service port)

?

> +  (let* ([alst      (unit-parse-file (string-append unitdir name))]
> +         [busname   (dassoc "BusName"   alst #f)]
> +         [execstart (dassoc "ExecStart" alst #f)]
> +         [type      (dassoc "Type"      alst (if (equal? execstart #f)
> +                                                 "oneshot"
> +                                                 (if (equal? busname #f)
> +                                                     "simple"
> +                                                     "dbus")))]
> +         [restart         (string->symbol (dassoc "Restart" alst "no"))]
> +         [user            (dassoc "User"             alst #f)]
> +         [group           (dassoc "Group"            alst #f)]
> +         [rootdir         (dassoc "RootDirectory"    alst "/")] ;; not currently used
> +         [workdir         (dassoc "WorkingDirectory" alst rootdir)]
> +         [command         execstart])

The (dassoc …) above can be replaced by:

  (assoc-ref alist "Thing")

or:

  (or (assoc-ref alist "Thing") 'default-thing)

> +(register-services (make-systemd-service "test.service"))

This should go to the unit test.

The unit parser looks “good enough”, so once you have a unit test for
it, I’d suggest moving to implementing the semantics of unit files
(which you’ve started a bit.)  You may find that some things, such as
socket activation, are hard to implement in the current code.  At that
point we can start discussing how to do that, which will probably mean
moving using Fibers to handle events.

Thank you,
Ludo’.

^ permalink raw reply	[flat|nested] 6+ messages in thread

* Re: GSoC 2018 Syntax and semantics of systemd units in the Shepherd - 1st update
  2018-06-11 11:47 ` Ludovic Courtès
@ 2018-06-11 12:07   ` Ioannis Panagiotis Koutsidis
  2018-06-12 13:11     ` Ludovic Courtès
  0 siblings, 1 reply; 6+ messages in thread
From: Ioannis Panagiotis Koutsidis @ 2018-06-11 12:07 UTC (permalink / raw)
  To: Ludovic Courtès; +Cc: guix-devel

Thank you a lot for your comments! I will make sure to make the changes that you
suggested.

As for match and things like car/cdr, I had issues with match and signal handling
in the service file, which was why I changed it with a cond. As for the unit parser
I also take the rest of the list via cdar because match in something like
(x y rest ...) does not bind rest - I will probably have to use (x . (y . rest)) in
the replacement.

On 06/11/18 14:47, Ludovic Courtès wrote:
> Hello Ioannis!
> 
> Thanks for the update!
> 
> Ioannis Panagiotis Koutsidis <IXK680@student.bham.ac.uk> skribis:
> 
>> As the 1st phase is coming to an end I decided to post my progress. I have
>> implemented the unit file parsing as well as some of the basic entries supported
>> by it, such as ExecStart, User, Group, Restart, etc. In addition, support for
>> the systemd Restart values (on-success, on-failure, on-abnormal, and on-abort)
>> was added to the Shepherd via the restart-systemd field in the <service> class,
>> letting services written in guile to also use that feature.
> 
> Very nice!
> 
>> During the next phases I will focus on other common .service entries, .socket
>> support, as well as thoroughly testing the code.
> 
> Cool.  Adding unit tests like those currently under tests/ is definitely
> something you should do—you probably already run tests manually anyway,
> so it’s mostly a matter of putting them in a file.
> 
> For things like the unit file parser, you may find it more convenient to
> write the test in Scheme (currently all the tests are shell scripts.)
> That can easily be done by using the .scm file name extension for your
> test and then defining ‘SCM_LOG_COMPILER’ in Makefile.am.  If unsure,
> you can look at how Guix itself does it, or just stop by on #guix or ask
> on the list for details.
> 
> Some comments about the code:
> 
>>  From a0a46ead5e43cd2672a08adb4c16919c377514c2 Mon Sep 17 00:00:00 2001
>> From: Ioannis Panagiotis Koutsidis <ixk680@student.bham.ac.uk>
>> Date: Sat, 9 Jun 2018 16:17:27 +0300
>> Subject: [PATCH] Initial systemd unit support
> 
> Could you try to split it in several patches, where each patch
> represents a single “logical” change?
> 
> By that I mean that you could have a first patch that modifies ‘restart’
> and all in (shepherd service), possibly with extended tests to exercise
> the new functionality if appropriate.
> 
> A second patch would add the unit file parser in (shepherd systemd)
> along with its unit test.
> 
> For commit logs, please try to follow the ChangeLog convention:
> <https://www.gnu.org/prep/standards/html_node/Change-Logs.html>.  You
> can look at ‘git log’ and basically try to mimic what’s been done
> before.  Don’t lose your hair over commit logs though; it’s good to try
> to follow the conventions, but if you’re unsure or if you make mistakes,
> it’s not the end of the world.
> 
>> @@ -165,6 +166,11 @@ respawned, shows that it has been respawned more than TIMES in SECONDS."
>>     (respawn? #:init-keyword #:respawn?
>>   	    #:init-value #f
>>   	    #:getter respawn?)
>> +  ;; For the systemd restart values.  Can be 'no (when respawn? is #f),
>> +  ;; 'on-success, 'on-failure, 'on-abnormal, 'on-watchdog, 'on-abort, or 'always
>> +  (respawn-systemd #:init-keyword #:respawn-systemd
>> +                   #:init-value 'always
>> +                   #:getter respawn-systemd)
> 
> As briefly discussed on IRC, I think we should keep a single field for
> this.  So perhaps ‘respawn?’ must simply be renamed to ‘respawn’ (no
> question mark), with a comment like above explaining what the possible
> values are.
> 
>> +      (let* ([e (status:exit-val status)]
>> +             [t (status:term-sig status)]
>> +             [r (respawn-systemd serv)]
> 
> Please avoid square brackets to remain consistent with the rest of the
> code.  :-)
> 
>> +             [clean (or (zero?  e)
>> +                        (equal? t SIGHUP)
>> +                        (equal? t SIGINT)
>> +                        (equal? t SIGTERM)
>> +                        (equal? t SIGPIPE))])
> 
> Use ‘=’ rather than ‘equal?’ when we know we’re dealing with numbers.
> 
>> +        (if (or (equal? r 'always)
>> +                (equal? r 'on-watchdog) ;; not implemented yet
>> +                (and (equal? r 'on-success) clean)
>> +                (and (equal? r 'on-abnormal) (not clean) (equal? e #f))
>> +                (and (equal? r 'on-failure)  (not clean))
>> +                (and (equal? r 'on-abort)    (equal? t SIGABRT)))
> 
> Likewise, use ‘eq?’ for symbols.
> 
>> +++ b/modules/shepherd/systemd.scm
>> @@ -0,0 +1,143 @@
>> +;; systemd.scm -- Systemd support
>> +;; Copyright (C) 2018 Ioannis Panagiotis Koutsidis <gk.ppp7@gmail.com>
>> +;;
>> +;; This file is part of the GNU Shepherd.
>> +;;
>> +;; The GNU Shepherd 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.
>> +;;
>> +;; The GNU Shepherd 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 the GNU Shepherd.  If not, see <http://www.gnu.org/licenses/>.
>> +
>> +(define-module (shepherd systemd)
>> +  #:use-module (ice-9 match)
>> +  #:use-module (ice-9 textual-ports)
>> +  #:use-module (oop goops)
>> +  #:use-module (shepherd service)
>> +  #:export (make-systemd-service))
>> +
>> +;; Change this
>> +(define unitdir "/systemd/")
> 
> I think we can remove it altogether.  :-)
> 
>> +;; Implements a state machine to parse the ini-like systemd unit files
>> +(define (unit-parse s)
> 
> Please turn the comment into a docstring.
> 
> Also, it may be more idiomatic to take an input port instead of a string
> as input.  As a result, you’ll have to call ‘read-char’ instead of
> traversing the list of characters, but otherwise the code should be
> pretty much the same.
> 
> How does that sound?
> 
> Also, I’d use the name ‘read-unit-file’ for this procedure, which is
> more inline with some naming conventions.
> 
>> +  (letrec ([unit-parse (lambda (s state key value kv)
>> +                         (match (list s state)
>> +                           [((or (#\newline _ ...)
>> +                                 ()) 'keypart)
>> +                            (error "Key " (list->string key) " is missing its value")]
>> +                           [(() (or 'valuepart 'firstchar 'ignoreline))
>> +                            kv]
>> +                           [lst (let ([rest (cdar lst)])
>> +                                  (match (list (caar lst) state)
>> +                                    [((or #\;
>> +                                          #\[) 'firstchar)
>> +                                     (unit-parse rest
>> +                                                 'ignoreline
>> +                                                 '()
>> +                                                 '()
>> +                                                 kv)]
>> +                                    [(#\newline (or 'firstchar
>> +                                                    'ignoreline))
>> +                                     (unit-parse rest
>> +                                                 'firstchar
>> +                                                 '()
>> +                                                 '()
>> +                                                 kv)]
>> +                                    [(#\= 'keypart)
>> +                                     (unit-parse rest
>> +                                                 'valuepart
>> +                                                 key
>> +                                                 '()
>> +                                                 kv)]
>> +                                    [(#\newline 'valuepart)
>> +                                     (unit-parse rest
>> +                                                 'firstchar
>> +                                                 '()
>> +                                                 '()
>> +                                                 `((,(list->string key)
>> +                                                    . ,(list->string value))
>> +                                                   . ,kv))]
>> +                                    [(_ 'ignoreline)
>> +                                     (unit-parse rest
>> +                                                 'ignoreline
>> +                                                 '()
>> +                                                 '()
>> +                                                 kv)]
>> +                                    [(c 'valuepart)
>> +                                     (unit-parse rest
>> +                                                 'valuepart
>> +                                                 key
>> +                                                 (append value `(,c))
>> +                                                 kv)]
>> +                                    [(c (or 'keypart 'firstchar))
>> +                                     (unit-parse rest
>> +                                                 'keypart
>> +                                                 (append key `(,c))
>> +                                                 '()
>> +                                                 kv)]))]))])
> 
> Instead of ‘letrec’, which leads to code that goes far to the right, you
> can use ‘define’ like this (it’s equivalent):
> 
>    (define (read-unit-file port)
>      (define (parse s state key value kv)
>        …)
>      (parse …))
> 
> Please always use ‘match’ instead of ‘car’, ‘cdr’, etc., and avoid
> abbreviations.  See
> <https://www.gnu.org/software/guix/manual/html_node/Coding-Style.html>,
> which mostly applies to the Shepherd as well.
> 
>> +(define (unit-parse-file path)
>> +  (let* ([in (open-input-file path)]
>> +         [out (unit-parse (get-string-all in))])
>> +    (close-port in)
>> +    out))
> 
> This will probably not be needed anymore (just like Scheme itself
> provides a ‘read’ procedure and no ‘read-file’ procedure.)
> 
>> +;; like assoc but uses a coninuation for failure and success
>> +(define (kassoc key alst failure success)
>> +  (let ((res (assoc key alst)))
>> +    (if (equal? res #f)
>> +        failure
>> +        (success (cdr res)))))
>> +
>> +;; like assoc but 1: allows the use of a default value on failure
>> +;; and 2: returns just the value instead of (cons key value)
>> +(define (dassoc key alst default)
>> +  (kassoc key alst default (lambda (x) x)))
> 
> Most likely these are not needed.  :-)
> 
>> +(define (make-systemd-service name)
> 
> Rather:
> 
>    (unit-file->service port)
> 
> ?
> 
>> +  (let* ([alst      (unit-parse-file (string-append unitdir name))]
>> +         [busname   (dassoc "BusName"   alst #f)]
>> +         [execstart (dassoc "ExecStart" alst #f)]
>> +         [type      (dassoc "Type"      alst (if (equal? execstart #f)
>> +                                                 "oneshot"
>> +                                                 (if (equal? busname #f)
>> +                                                     "simple"
>> +                                                     "dbus")))]
>> +         [restart         (string->symbol (dassoc "Restart" alst "no"))]
>> +         [user            (dassoc "User"             alst #f)]
>> +         [group           (dassoc "Group"            alst #f)]
>> +         [rootdir         (dassoc "RootDirectory"    alst "/")] ;; not currently used
>> +         [workdir         (dassoc "WorkingDirectory" alst rootdir)]
>> +         [command         execstart])
> 
> The (dassoc …) above can be replaced by:
> 
>    (assoc-ref alist "Thing")
> 
> or:
> 
>    (or (assoc-ref alist "Thing") 'default-thing)
> 
>> +(register-services (make-systemd-service "test.service"))
> 
> This should go to the unit test.
> 
> The unit parser looks “good enough”, so once you have a unit test for
> it, I’d suggest moving to implementing the semantics of unit files
> (which you’ve started a bit.)  You may find that some things, such as
> socket activation, are hard to implement in the current code.  At that
> point we can start discussing how to do that, which will probably mean
> moving using Fibers to handle events.
> 
> Thank you,
> Ludo’.
> 

^ permalink raw reply	[flat|nested] 6+ messages in thread

* Re: GSoC 2018 Syntax and semantics of systemd units in the Shepherd - 1st update
  2018-06-11 12:07   ` Ioannis Panagiotis Koutsidis
@ 2018-06-12 13:11     ` Ludovic Courtès
  0 siblings, 0 replies; 6+ messages in thread
From: Ludovic Courtès @ 2018-06-12 13:11 UTC (permalink / raw)
  To: Ioannis Panagiotis Koutsidis; +Cc: guix-devel

Heya,

Ioannis Panagiotis Koutsidis <IXK680@student.bham.ac.uk> skribis:

> Thank you a lot for your comments! I will make sure to make the changes that you
> suggested.

Awesome.

> As for match and things like car/cdr, I had issues with match and signal handling
> in the service file, which was why I changed it with a cond. As for the unit parser
> I also take the rest of the list via cdar because match in something like
> (x y rest ...) does not bind rest - I will probably have to use (x . (y . rest)) in
> the replacement.

If you have a specific example, we can look at it.  Rest elements in
‘match’ patterns should definitely get bound.  Here’s an example at the
Guile REPL:

--8<---------------cut here---------------start------------->8---
scheme@(guile-user)> ,use(ice-9 match)
scheme@(guile-user)> (match '(hello brave gnu world!)
		       ((x rest ...)
			rest))
$2 = (brave gnu world!)
--8<---------------cut here---------------end--------------->8---

Here ‘rest’ is bound to the cdr of the list.

If you want let’s get in touch on IRC to discuss the issue that you had.

Cheers,
Ludo’.

^ permalink raw reply	[flat|nested] 6+ messages in thread

* Re: GSoC 2018 Syntax and semantics of systemd units in the Shepherd - 1st update
  2018-06-11  3:02 GSoC 2018 Syntax and semantics of systemd units in the Shepherd - 1st update Ioannis Panagiotis Koutsidis
  2018-06-11 11:47 ` Ludovic Courtès
@ 2018-06-25 10:47 ` Gábor Boskovits
  2018-06-29 19:15   ` Ioannis Panagiotis Koutsidis
  1 sibling, 1 reply; 6+ messages in thread
From: Gábor Boskovits @ 2018-06-25 10:47 UTC (permalink / raw)
  To: IXK680; +Cc: Guix-devel

[-- Attachment #1: Type: text/plain, Size: 59 bytes --]

Hello, could you please send us an update on your project?

[-- Attachment #2: Type: text/html, Size: 80 bytes --]

^ permalink raw reply	[flat|nested] 6+ messages in thread

* Re: GSoC 2018 Syntax and semantics of systemd units in the Shepherd - 1st update
  2018-06-25 10:47 ` Gábor Boskovits
@ 2018-06-29 19:15   ` Ioannis Panagiotis Koutsidis
  0 siblings, 0 replies; 6+ messages in thread
From: Ioannis Panagiotis Koutsidis @ 2018-06-29 19:15 UTC (permalink / raw)
  To: boskovits; +Cc: Guix-devel

I am currently working on the implementation of .socket unit files, signalfd for 
signal handling, and fibers. It is mostly done, I just have to fix some issues 
that are left.

On 06/25/18 13:47, boskovits@gmail.com wrote:
> Hello, could you please send us an update on your project?

^ permalink raw reply	[flat|nested] 6+ messages in thread

end of thread, other threads:[~2018-06-29 19:15 UTC | newest]

Thread overview: 6+ messages (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2018-06-11  3:02 GSoC 2018 Syntax and semantics of systemd units in the Shepherd - 1st update Ioannis Panagiotis Koutsidis
2018-06-11 11:47 ` Ludovic Courtès
2018-06-11 12:07   ` Ioannis Panagiotis Koutsidis
2018-06-12 13:11     ` Ludovic Courtès
2018-06-25 10:47 ` Gábor Boskovits
2018-06-29 19:15   ` Ioannis Panagiotis Koutsidis

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