unofficial mirror of guix-devel@gnu.org 
 help / color / mirror / code / Atom feed
* GSoC update
@ 2018-07-10 17:42 Ioannis Panagiotis Koutsidis
  2018-07-10 22:40 ` Ludovic Courtès
  0 siblings, 1 reply; 4+ messages in thread
From: Ioannis Panagiotis Koutsidis @ 2018-07-10 17:42 UTC (permalink / raw)
  To: Guix-devel

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

Hi Guix!

This patch adds initial support for .socket unit files. It does not currently 
work but is near completion. During the past month I also worked on a patch that 
adds signalfd and fiber support but these are currently way too unstable and for 
that reason I have not included them in this patch.

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

From cd260ae65056b53749e7c03f2498a28af2525934 Mon Sep 17 00:00:00 2001
From: Ioannis Panagiotis Koutsidis <ixk680@student.bham.ac.uk>
Date: Tue, 10 Jul 2018 20:03:21 +0300
Subject: [PATCH] .socket units

---
 modules/shepherd.scm         |  44 +++--
 modules/shepherd/service.scm | 170 ++++++++++-------
 modules/shepherd/systemd.scm | 354 ++++++++++++++++++++++++-----------
 3 files changed, 368 insertions(+), 200 deletions(-)

diff --git a/modules/shepherd.scm b/modules/shepherd.scm
index 5d97598..45fcb23 100644
--- a/modules/shepherd.scm
+++ b/modules/shepherd.scm
@@ -31,6 +31,7 @@
   #:use-module (shepherd config)
   #:use-module (shepherd support)
   #:use-module (shepherd service)
+  #:use-module (shepherd systemd)
   #:use-module (shepherd system)
   #:use-module (shepherd runlevel)
   #:use-module (shepherd args)
@@ -259,9 +260,18 @@
                    (setvbuf command-source _IOFBF 1024)
                    (process-connection command-source))
                   (_ #f)))
-              (match (select (list sock) (list) (list) (if poll-services? 0.5 #f))
-                (((sock) _ _)
-                 (read-from sock))
+
+              (match (select (cons* sock unit-sockets-list) (list) (list)
+                             (if poll-services? 0.5 #f))
+                (((rsock _ ...) _ _)
+                 (let* ((sockserv1 (find (lambda (x)
+                                           (eq? (slot-ref x 'running) rsock))
+                                         (service-list)))
+                        (sockserv (if sockserv1 (before sockserv1) #f))
+                        (res (if sockserv (car (lookup-services (string->symbol (car sockserv)))) #f)))
+                   (if res
+                       (start res (accept rsock))
+                       (read-from sock))))
                 (_
                  #f))
               (when poll-services?
diff --git a/modules/shepherd/service.scm b/modules/shepherd/service.scm
index 5b0d72d..ceba004 100644
--- a/modules/shepherd/service.scm
+++ b/modules/shepherd/service.scm
@@ -74,6 +74,7 @@
             make-forkexec-constructor
             make-kill-destructor
             exec-command
+            exec-command2
             fork+exec-command
             read-pid-file
             make-system-constructor
@@ -102,7 +103,10 @@
             action-runtime-error-key
             action-runtime-error-arguments

-            condition->sexp))
+            condition->sexp
+
+            before
+            service-list))

 ;; Keep track of lazy initialization of SIGCHLD handler
 (define %sigchld-handler-installed? #f)
@@ -161,16 +165,12 @@ respawned, shows that it has been respawned more than TIMES in SECONDS."
   (requires #:init-keyword #:requires
 	    #:init-value '()
 	    #:getter required-by)
-  ;; If `#t', then assume the `running' slot specifies a PID and
-  ;; respawn it if that process terminates.  Otherwise `#f'.
+  ;; If not #f, then assume the `running' slot specifies a PID and
+  ;; respawn it if that process terminates.  Otherwise it can be
+  ;; 'on-success, 'on-failure, 'on-abnormal, 'on-watchdog, 'on-abort, or 'always
   (respawn? #:init-keyword #:respawn?
-	    #:init-value #f
+	    #:init-value 'no
 	    #: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
@@ -211,7 +211,11 @@ respawned, shows that it has been respawned more than TIMES in SECONDS."
   (stop-delay? #:init-keyword #:stop-delay?
 	       #:init-value #f)
   ;; The times of the last respawns, most recent first.
-  (last-respawns #:init-form '()))
+  (last-respawns #:init-form '())
+  ;; if it is a socket unit file, it contains all services that depend on it
+  (before #:init-keyword #:before
+          #:init-value '()
+          #:getter before))

 (define (service? obj)
   "Return true if OBJ is a service."
@@ -331,7 +335,7 @@ wire."
                   ;; Start the service itself.  Asyncs are blocked so that if
                   ;; the newly-started process dies immediately, the SIGCHLD
                   ;; handler is invoked later, once we have set the 'running'
-                  ;; field.
+                  ;; field .
                   (slot-set! obj 'running (catch #t
                                             (lambda ()
                                               (apply (slot-ref obj 'start)
@@ -693,25 +697,17 @@ otherwise return the number that was read (a PID)."
                      (loop)))
               (apply throw args)))))))

-(define* (exec-command command
-                       #:key
-                       (user #f)
-                       (group #f)
-                       (log-file #f)
-                       (directory (default-service-directory))
-                       (environment-variables (default-environment-variables)))
-  "Run COMMAND as the current process from DIRECTORY, and with
-ENVIRONMENT-VARIABLES (a list of strings like \"PATH=/bin\".)  File
-descriptors 1 and 2 are kept as is or redirected to LOG-FILE if it's true,
-whereas file descriptor 0 (standard input) points to /dev/null; all other file
-descriptors are closed prior to yielding control to COMMAND.
-
-By default, COMMAND is run as the current user.  If the USER keyword
-argument is present and not false, change to USER immediately before
-invoking COMMAND.  USER may be a string, indicating a user name, or a
-number, indicating a user ID.  Likewise, COMMAND will be run under the
-current group, unless the GROUP keyword argument is present and not
-false."
+(define* (exec-command2 command
+                        #:key
+                        (user #f)
+                        (group #f)
+                        (stdin #f)
+                        (stderr #f)
+                        (stdout #f)
+                        (directory (default-service-directory))
+                        (rdir "/")
+                        (environment-variables (default-environment-variables)))
+  "Like exec-command but extended"
   (match command
     ((program args ...)
      ;; Become the leader of a new session and session group.
@@ -719,30 +715,23 @@ false."
      (setsid)

      (chdir directory)
+     (chroot rdir)
      (environ environment-variables)

-     ;; Close all the file descriptors except stdout and stderr.
-     (let ((max-fd (max-file-descriptors)))
-
+     (unless stdin
        ;; Redirect stdin to use /dev/null
        (catch-system-error (close-fdes 0))
        ;; Make sure file descriptor zero is used, so we don't end up reusing
        ;; it for something unrelated, which can confuse some packages.
-       (dup2 (open-fdes "/dev/null" O_RDONLY) 0)
-
-       (when log-file
-         (catch #t
-           (lambda ()
-             ;; Redirect stout and stderr to use LOG-FILE.
-             (catch-system-error (close-fdes 1))
-             (catch-system-error (close-fdes 2))
-             (dup2 (open-fdes log-file (logior O_CREAT O_WRONLY O_APPEND)) 1)
-             (dup2 1 2))
-           (lambda (key . args)
-             (format (current-error-port)
-                     "failed to open log-file ~s:~%" log-file)
-             (print-exception (current-error-port) #f key args)
-             (primitive-exit 1))))
+       (dup2 (open-fdes "/dev/null" O_RDONLY) 0))
+
+     (when stdin
+       (dup2 stdin 0))
+
+     (when stdout
+       (dup2 stdout 1))
+     (when stderr
+       (dup2 stderr 2))

      ;; setgid must be done *before* setuid, otherwise the user will
      ;; likely no longer have permissions to setgid.
@@ -784,14 +773,54 @@ false."
          (catch-system-error (close-fdes i))
          (loop (+ i 1)))))

-     (catch 'system-error
-       (lambda ()
-         (apply execlp program program args))
-       (lambda args
-         (format (current-error-port)
-                 "exec of ~s failed: ~a~%"
-                 program (strerror (system-error-errno args)))
-         (primitive-exit 1))))))
+    (catch 'system-error
+      (lambda ()
+        (apply execlp program program args))
+      (lambda args
+        (format (current-error-port)
+                "exec of ~s failed: ~a~%"
+                program (strerror (system-error-errno args)))
+        (primitive-exit 1)))))
+
+(define* (exec-command command
+                       #:key
+                       (user #f)
+                       (group #f)
+                       (log-file #f)
+                       (directory (default-service-directory))
+                       (environment-variables (default-environment-variables)))
+  "Run COMMAND as the current process from DIRECTORY, and with
+ENVIRONMENT-VARIABLES (a list of strings like \"PATH=/bin\".)  File
+descriptors 1 and 2 are kept as is or redirected to LOG-FILE if it's true,
+whereas file descriptor 0 (standard input) points to /dev/null; all other file
+descriptors are closed prior to yielding control to COMMAND.
+
+By default, COMMAND is run as the current user.  If the USER keyword
+argument is present and not false, change to USER immediately before
+invoking COMMAND.  USER may be a string, indicating a user name, or a
+number, indicating a user ID.  Likewise, COMMAND will be run under the
+current group, unless the GROUP keyword argument is present and not
+false."
+  (let ((fd (if log-file
+                (catch #t
+                  (lambda ()
+                    ;; Redirect stout and stderr to use LOG-FILE.
+                    (catch-system-error (close-fdes 1))
+                    (catch-system-error (close-fdes 2))
+                    (open-fdes log-file (logior O_CREAT O_WRONLY O_APPEND)))
+                  (lambda (key . args)
+                    (format (current-error-port)
+                            "failed to open log-file ~s:~%" log-file)
+                    (print-exception (current-error-port) #f key args)
+                    (primitive-exit 1)))
+                #f)))
+    (exec-command command
+                  #:user user
+                  #:group group
+                  #:stdout fd
+                  #:stderr fd
+                  #:directory directory
+                  #:environment-variables environment-variables)))

 (define* (fork+exec-command command
                             #:key
@@ -1031,20 +1060,20 @@ then disable it."
            (not (respawn-limit-hit? (slot-ref serv 'last-respawns)
                                     (car respawn-limit)
                                     (cdr respawn-limit))))
-      (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)))
+      (let* ((e (status:exit-val status))
+             (t (status:term-sig status))
+             (r (respawn? serv))
+             (clean (or (eq? e 0)
+                        (eq? t SIGHUP)
+                        (eq? t SIGINT)
+                        (eq? t SIGTERM)
+                        (eq? t SIGPIPE))))
+        (if (or (eq? r 'always)
+                (eq? r 'on-watchdog) ;; not implemented yet
+                (and (eq? r 'on-success)  clean)
+                (and (eq? r 'on-abnormal) (not clean) (equal? e #f))
+                (and (eq? r 'on-failure)  (not clean))
+                (and (eq? r 'on-abort)    (= t SIGABRT)))
             (if (not (slot-ref serv 'waiting-for-termination?))
                 (begin
                   ;; Everything is okay, start it.
@@ -1075,7 +1104,6 @@ then disable it."
     ;; Sanity-checks first.
     (assert (list-of-symbols? (provided-by new)))
     (assert (list-of-symbols? (required-by new)))
-    (assert (boolean? (respawn? new)))
     ;; Canonical name actually must be canonical.  (FIXME: This test
     ;; is incomplete, since we may add a service later that makes it
     ;; non-cannonical.)
diff --git a/modules/shepherd/systemd.scm b/modules/shepherd/systemd.scm
index 77679fa..1dee888 100644
--- a/modules/shepherd/systemd.scm
+++ b/modules/shepherd/systemd.scm
@@ -17,127 +17,257 @@
 ;; along with the GNU Shepherd.  If not, see <http://www.gnu.org/licenses/>.

 (define-module (shepherd systemd)
+  #:use-module (srfi srfi-1)
   #:use-module (ice-9 match)
   #:use-module (ice-9 textual-ports)
   #:use-module (oop goops)
   #:use-module (shepherd service)
-  #:export (make-systemd-service))
+  #:export (read-unit-file
+            unit-files->services
+            unit-sockets-list))

-;; Change this
-(define unitdir "/systemd/")
+(define unit-sockets-list '())

-;; 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 (read-unit-file file)
+  "Implements a state machine to parse the ini-like systemd unit files."
+  (define (unit-parse file state key value kv)
+    (define c (read-char file))
+    (match (list (if (eof-object? c) #f c) state)
+      (((or #f #\newline) 'keypart)
+       (error "Key " (list->string key) " is missing its value"))
+      ((#f (or 'valuepart 'firstchar 'ignoreline))
+       kv)
+      (((or #\; #\[) 'firstchar)
+       (unit-parse file
+                   'ignoreline
+                   '()
+                   '()
+                   kv))
+      ((#\newline (or 'firstchar 'ignoreline))
+       (unit-parse file
+                   'firstchar
+                   '()
+                   '()
+                   kv))
+      ((#\= 'keypart)
+       (unit-parse file
+                   'valuepart
+                   key
+                   '()
+                   kv))
+      ((#\newline 'valuepart)
+       (unit-parse file
+                   'firstchar
+                   '()
+                   '()
+                   `((,(list->string key)
+                      . ,(list->string value))
+                     . ,kv)))
+      ((_ 'ignoreline)
+       (unit-parse file
+                   'ignoreline
+                   '()
+                   '()
+                   kv))
+      ((c 'valuepart)
+       (unit-parse file
+                   'valuepart
+                   key
+                   (append value `(,c))
+                   kv))
+      ((c (or 'keypart 'firstchar))
+       (unit-parse file
+                   'keypart
+                   (append key `(,c))
+                   '()
+                   kv))))
+  (unit-parse file 'firstchar '() '() '()))

-(define (unit-parse-file path)
-  (let* ([in (open-input-file path)]
-         [out (unit-parse (get-string-all in))])
-    (close-port in)
-    out))
+(define (dassoc alst key default)
+  "assoc-ref with a default value"
+  (or (assoc-ref alst key) default))

-;; 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)))))
+(define (make-socket family addr port backlog)
+  (define sock (socket family SOCK_STREAM 0))
+  (fcntl sock F_SETFD FD_CLOEXEC)
+  (cond ((= family PF_UNIX)  (bind sock AF_UNIX  addr))
+        ((= family PF_INET)  (bind sock AF_INET  (inet-pton AF_INET addr) port))
+        ((= family PF_INET6) (bind sock AF_INET6 (inet-pton AF_INET6 addr) port))
+        (#t                  (error "Unknown protocol")))
+  (fcntl sock F_SETFL (logior O_NONBLOCK (fcntl sock F_GETFL)))
+  (listen sock backlog)
+  sock)

-;; 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 %sigchld-handler-installed? #f)

-(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])
+;; TODO: deduplicate
+(define* (fork+exec-command2 command
+                             #:key
+                             (user #f)
+                             (group #f)
+                             (stdin #f)
+                             (stdout #f)
+                             (stderr #f)
+                             (directory (default-service-directory))
+                             (rdir "/")
+                             (environment-variables (environ)))
+  "Spawn a process that executed COMMAND as per 'exec-command', and return
+its PID."
+  ;; Install the SIGCHLD handler if this is the first fork+exec-command call
+  (unless %sigchld-handler-installed?
+    (sigaction SIGCHLD handle-SIGCHLD SA_NOCLDSTOP)
+    (set! %sigchld-handler-installed? #t))
+  (let ((pid (primitive-fork)))
+    (if (zero? pid)
+        (exec-command2 command
+                       #:user user
+                       #:group group
+                       #:stdin stdin
+                       #:stdout stdout
+                       #:stderr stderr
+                       #:directory directory
+                       #:rdir rdir
+                       #:environment-variables environment-variables)
+        pid)))

-    (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))))
+;; TODO: deduplicate
+(define* (make-forkexec-constructor-sock command
+                                         #:key
+                                         (user #f)
+                                         (group #f)
+                                         (directory (default-service-directory))
+                                         (rdir "/")
+                                         (environment-variables (environ))
+                                         (pid-file #f)
+                                         (pid-file-timeout 5))
+  "See make-forkexec-constructor"
+  (lambda (sock)
+    (define (clean-up file)
+      (when file
+        (catch 'system-error
+          (lambda ()
+            (delete-file file))
+          (lambda args
+            (unless (= ENOENT (system-error-errno args))
+              (apply throw args))))))

-(register-services (make-systemd-service "test.service"))
+    (clean-up pid-file)
+
+    (let* ((pid (fork+exec-command2 command
+                                    #:user user
+                                    #:group group
+                                    #:stdin sock
+                                    #:stdout sock
+                                    #:directory directory
+                                    #:rdir rdir
+                                    #:environment-variables
+                                    environment-variables)))
+      (if pid-file
+          (match (read-pid-file pid-file
+                                #:max-delay pid-file-timeout)
+            (#f
+             (catch-system-error (kill pid SIGTERM))
+             #f)
+            ((? integer? pid)
+             pid))
+          pid))))
+
+;; O(n^2)
+(define (unit-files->services ufiles-orig)
+  (define (inner ufiles return)
+    (match ufiles
+      (() return)
+      (((fullname basename 'service alst) rest ...)
+       (let* ((dassoc        (lambda (name val) (dassoc alst name val)))
+              (busname       (dassoc "BusName"       #f))
+              (execstart     (dassoc "ExecStart"     #f))
+              (execstartpre  (dassoc "ExecStartPre"  #f)) ;; TODO
+              (execstartpost (dassoc "ExecStartPost" #f)) ;; TODO
+              (execstop      (dassoc "ExecStop"      #f))
+              (execstoppost  (dassoc "ExecStopPost"  #f)) ;; TODO
+              (execreload    (dassoc "ExecReload"    #f)) ;; TODO
+              (type          (dassoc "Type"          (if (equal? execstart #f)
+                                                         "oneshot"
+                                                         (if (equal? busname #f)
+                                                             "simple"
+                                                             "dbus"))))
+              (restart         (let ((res (dassoc "Restart" "no")))
+                                 (if (eq? res #f)
+                                     #f
+                                     (string->symbol res))))
+              (user            (dassoc "User"             #f))
+              (group           (dassoc "Group"            #f))
+              (rootdir         (dassoc "RootDirectory"    "/")) ;; TODO
+              (workdir         (dassoc "WorkingDirectory" rootdir))
+              (env             (dassoc "Environment"      #f))) ;; TODO
+
+         (let ((serv (make <service>
+                       #:docstring (dassoc "Description" "")
+                       #:provides  `(,(string->symbol fullname))
+                       #:requires  (let* ((req  (string-split (dassoc "Requires"
+                                                                      "")
+                                                              #\space))
+                                          (req2 (if (equal? req '(""))
+                                                    '()
+                                                    (map string->symbol req))))
+                                     (if (equal? type "dbus")
+                                         (append req2 'dbus.service)
+                                         req2))
+                       #:respawn?        restart
+                       #:start           (if (find (lambda (x)
+                                                     (match x
+                                                       ((_ basename2 'socket _)
+                                                        (eq? basename basename2))
+                                                       (_ #f))) ufiles-orig)
+                                             (make-forkexec-constructor-sock
+                                              (list "/bin/sh" "-c" execstart)
+                                              #:user      user
+                                              #:group     group
+                                              #:directory workdir
+                                              #:rdir      rootdir)
+                                             (cond [(and (equal? type "simple")
+                                                         (not (equal? execstart #f)))
+                                                    (make-forkexec-constructor
+                                                     (list "/bin/sh" "-c" execstart)
+                                                     #:user      user
+                                                     #:group     group
+                                                     #:directory workdir)]
+                                                   [#t '()])) ;; TODO: nonsimple
+                       #:stop            (make-kill-destructor #:timeout 60))))
+           (inner rest (cons serv return)))))
+      (((fullname basename 'socket alst) rest ...)
+       (let* ((dassoc  (lambda (name val) (dassoc alst name val)))
+              (backlog (dassoc "Backlog" 128))
+              (listens (string-split (dassoc "ListenStream" #f) #\:))
+              (port    (string->number (cadr listens)))
+              (addr    (car listens)))
+
+         (let ((serv (make <service>
+                       #:docstring (dassoc "Description" "")
+                       #:provides  `(,(string->symbol fullname))
+                       #:start     (lambda args
+                                     (let ((sock (make-socket PF_INET addr port backlog)))
+                                       (set! unit-sockets-list
+                                             (cons sock unit-sockets-list))
+                                       sock))
+                       #:stop      (lambda (running) (begin (delete running
+                                                                    unit-sockets-list)
+                                                            (close running)
+                                                            #f))
+                       #:before    (find (lambda (x)
+                                           (match x
+                                             ((_ basename2 'service _)
+                                              (eq? basename basename2))
+                                             (_ #f))) ufiles-orig))))
+           (inner rest (cons serv return)))))))
+  (inner ufiles-orig (list)))
--
2.18.0

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

* Re: GSoC update
  2018-07-10 17:42 GSoC update Ioannis Panagiotis Koutsidis
@ 2018-07-10 22:40 ` Ludovic Courtès
  2018-07-11 14:26   ` Jelle Licht
  2018-07-12 12:13   ` Ioannis Panagiotis Koutsidis
  0 siblings, 2 replies; 4+ messages in thread
From: Ludovic Courtès @ 2018-07-10 22:40 UTC (permalink / raw)
  To: Ioannis Panagiotis Koutsidis; +Cc: Guix-devel

Hi Ioannis,

Ioannis Panagiotis Koutsidis <gk.ppp7@gmail.com> skribis:

> This patch adds initial support for .socket unit files. It does not
> currently work but is near completion.

Could you expound a bit?  That’s a very short summary for all the sweat
you’ve put in it.  :-)

Also, what is the patch against?  It’s not against ‘master’; I suppose
it’s against the previous state of your own branch, do you have a copy
of your repo on-line?

> During the past month I also worked on a patch that adds signalfd and
> fiber support but these are currently way too unstable and for that
> reason I have not included them in this patch.

It’s OK that the thing doesn’t quite work—we knew it was not an easy
task.  What’s disappointing though is that you didn’t come to us to
discuss the issues until now.  GSoC is not about working in all
loneliness separately from the rest of the group; it’s about becoming
part of the group.

On IRC Jelle and I (and possibly others) offered help on the ‘signalfd’
issue; I also outlined reasonable milestones (first, only use
signalfd(2) instead of SIGCHLD, then discuss together what it would take
to Fiberize the whole thing.)  It’s sad that you remained stuck instead
of taking this opportunity to discuss it with us.

> From cd260ae65056b53749e7c03f2498a28af2525934 Mon Sep 17 00:00:00 2001
> From: Ioannis Panagiotis Koutsidis <ixk680@student.bham.ac.uk>
> Date: Tue, 10 Jul 2018 20:03:21 +0300
> Subject: [PATCH] .socket units
>
> ---
>  modules/shepherd.scm         |  44 +++--
>  modules/shepherd/service.scm | 170 ++++++++++-------
>  modules/shepherd/systemd.scm | 354 ++++++++++++++++++++++++-----------
>  3 files changed, 368 insertions(+), 200 deletions(-)

The patch changes lots of things and unfortunately, without
explanations, I do not understand what to do with it.  Like what’s the
new feature?  How is it used?  What implementation choices were made?
What’s left to be done?…

Thank you,
Ludo’.

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

* Re: GSoC update
  2018-07-10 22:40 ` Ludovic Courtès
@ 2018-07-11 14:26   ` Jelle Licht
  2018-07-12 12:13   ` Ioannis Panagiotis Koutsidis
  1 sibling, 0 replies; 4+ messages in thread
From: Jelle Licht @ 2018-07-11 14:26 UTC (permalink / raw)
  To: Ludovic Courtès; +Cc: Guix-devel, Ioannis Panagiotis Koutsidis

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

2018-07-11 0:40 GMT+02:00 Ludovic Courtès <ludo@gnu.org>:

> Hi Ioannis,
>
> Ioannis Panagiotis Koutsidis <gk.ppp7@gmail.com> skribis:
>
> > This patch adds initial support for .socket unit files. It does not
> > currently work but is near completion.
>
> Could you expound a bit?  That’s a very short summary for all the sweat
> you’ve put in it.  :-)
>
> Also, what is the patch against?  It’s not against ‘master’; I suppose
> it’s against the previous state of your own branch, do you have a copy
> of your repo on-line?
>
> > During the past month I also worked on a patch that adds signalfd and
> > fiber support but these are currently way too unstable and for that
> > reason I have not included them in this patch.
>
> It’s OK that the thing doesn’t quite work—we knew it was not an easy
> task.  What’s disappointing though is that you didn’t come to us to
> discuss the issues until now.  GSoC is not about working in all
> loneliness separately from the rest of the group; it’s about becoming
> part of the group.
>
> On IRC Jelle and I (and possibly others) offered help on the ‘signalfd’
> issue; I also outlined reasonable milestones (first, only use
> signalfd(2) instead of SIGCHLD, then discuss together what it would take
> to Fiberize the whole thing.)  It’s sad that you remained stuck instead
> of taking this opportunity to discuss it with us.
>

Ioannis, could you perhaps share some of your w.i.p. code regarding
signalfd-based signal handling in guile? Adding to what Ludo'
mentioned, I imagine you are running into some peculiarities regarding
guile's way of handling signals, so I would recommend to start
lurking on #guile if you did not do this before now, so you can interact
with the folks with the most expertise regarding the problems you
might be facing :-)

>
> > From cd260ae65056b53749e7c03f2498a28af2525934 Mon Sep 17 00:00:00 2001
> > From: Ioannis Panagiotis Koutsidis <ixk680@student.bham.ac.uk>
> > Date: Tue, 10 Jul 2018 20:03:21 +0300
> > Subject: [PATCH] .socket units
> >
> > ---
> >  modules/shepherd.scm         |  44 +++--
> >  modules/shepherd/service.scm | 170 ++++++++++-------
> >  modules/shepherd/systemd.scm | 354 ++++++++++++++++++++++++-----------
> >  3 files changed, 368 insertions(+), 200 deletions(-)
>
> The patch changes lots of things and unfortunately, without
> explanations, I do not understand what to do with it.  Like what’s the
> new feature?  How is it used?  What implementation choices were made?
> What’s left to be done?…
>
> Thank you,
> Ludo’.
>
>

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

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

* Re: GSoC update
  2018-07-10 22:40 ` Ludovic Courtès
  2018-07-11 14:26   ` Jelle Licht
@ 2018-07-12 12:13   ` Ioannis Panagiotis Koutsidis
  1 sibling, 0 replies; 4+ messages in thread
From: Ioannis Panagiotis Koutsidis @ 2018-07-12 12:13 UTC (permalink / raw)
  To: Ludovic Courtès; +Cc: Guix-devel

 > Could you expound a bit?  That’s a very short summary for all the sweat
 > you’ve put in it.  :-)
My apologies, at the time I sent the mail in a hurry.
Basically now instead of converting unit files to services individually it 
happens in bulk so that it can check if there is a corresponding .socket file 
per service file (and the reverse). If there is a corresponding .socket file 
then the input and output of the .service will be redirected to the result of 
(accept) on the socket corresponding to the .socket file.
It also makes the select that waits for the commands from herd to also wait for 
the sockets.

 > Also, what is the patch against?  It’s not against ‘master’; I suppose
 > it’s against the previous state of your own branch, do you have a copy
 > of your repo on-line?
It's against the previous patch that I sent, but I can put the branch online.

 > It’s OK that the thing doesn’t quite work—we knew it was not an easy
 > task.  What’s disappointing though is that you didn’t come to us to
 > discuss the issues until now.  GSoC is not about working in all
 > loneliness separately from the rest of the group; it’s about becoming
 > part of the group.
 >
 > On IRC Jelle and I (and possibly others) offered help on the ‘signalfd’
 > issue; I also outlined reasonable milestones (first, only use
 > signalfd(2) instead of SIGCHLD, then discuss together what it would take
 > to Fiberize the whole thing.)  It’s sad that you remained stuck instead
 > of taking this opportunity to discuss it with us.
Until now (in general, not only during the gsoc) I tried to solve any issues 
that had arisen when I was programming by myself, so it was a bit difficult to 
change that mindset - I will try to be more communicative after this however.

 > The patch changes lots of things and unfortunately, without
 > explanations, I do not understand what to do with it.  Like what’s the
 > new feature?  How is it used?  What implementation choices were made?
 > What’s left to be done?…
The new feature is initial support of .socket unit files. It is used like:
(let* ((port1 (open-input-file "/systemd/test.service"))
        (port2 (open-input-file "/systemd/test.socket")))
   (apply register-services (unit-files->services `(("/systemd/test.service" 
"test" service ,(read-unit-file port1))
                                                    ("/systemd/test.socket" 
"test" socket  ,(read-unit-file port2)))))
   (close-port port1)
   (close-port port2))

The things that are left are supporting more systemd options, and making it work 
properly.

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

end of thread, other threads:[~2018-07-12 12:13 UTC | newest]

Thread overview: 4+ messages (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2018-07-10 17:42 GSoC update Ioannis Panagiotis Koutsidis
2018-07-10 22:40 ` Ludovic Courtès
2018-07-11 14:26   ` Jelle Licht
2018-07-12 12:13   ` 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).