[shepherd] 01/01: shepherd: Delete the socket file upon exit.

[Ludovic Courtès]

civodul pushed a commit to branch master
in repository shepherd.

commit f260b2f90ed9ea9a1529e5a58db8df3a886d9c10
Author: 宋文武 <address@hidden>
Date:   Sun Feb 17 11:27:28 2019 +0800

    shepherd: Delete the socket file upon exit.
    
    Fixes <https://bugs.gnu.org/34407>.
    
    * modules/shepherd.scm (call-with-server-socket): New procedure.
    (main): Use it instead of 'open-server-socket'.
    
    Signed-off-by: Ludovic Courtès <address@hidden>
---
 modules/shepherd.scm | 65 +++++++++++++++++++++++++++++++---------------------
 1 file changed, 39 insertions(+), 26 deletions(-)

diff --git a/modules/shepherd.scm b/modules/shepherd.scm
index 37ae67d..8b05fb5 100644
--- a/modules/shepherd.scm
+++ b/modules/shepherd.scm
@@ -49,6 +49,17 @@
       (listen sock 10)
       sock)))
 
+(define (call-with-server-socket file-name proc)
+  "Call PROC, passing it a listening socket at FILE-NAME and deleting the
+socket file at FILE-NAME upon exit of PROC.  Return the values of PROC."
+  (let ((sock (open-server-socket file-name)))
+    (dynamic-wind
+      noop
+      (lambda () (proc sock))
+      (lambda ()
+        (close sock)
+        (delete-file file-name)))))
+
 
 ;; Main program.
 (define (main . args)
@@ -256,32 +267,34 @@
           ;; Get commands from the standard input port.
           (process-textual-commands (current-input-port))
           ;; Process the data arriving at a socket.
-          (let ((sock   (open-server-socket socket-file)))
-
-            ;; Possibly write out our PID, which means we're ready to accept
-            ;; connections.  XXX: What if we daemonized already?
-            (match pid-file
-              ((? string? file)
-               (with-atomic-file-output pid-file
-                 (cute display (getpid) <>)))
-              (#t (display (getpid)))
-              (_  #t))
-
-            (let next-command ()
-              (define (read-from sock)
-                (match (accept sock)
-                  ((command-source . client-address)
-                   (setvbuf command-source (buffering-mode block) 1024)
-                   (process-connection command-source))
-                  (_ #f)))
-              (match (select (list sock) (list) (list) (if poll-services? 0.5 
#f))
-                (((sock) _ _)
-                 (read-from sock))
-                (_
-                 #f))
-              (when poll-services?
-                (check-for-dead-services))
-              (next-command)))))))
+          (call-with-server-socket
+           socket-file
+           (lambda (sock)
+
+             ;; Possibly write out our PID, which means we're ready to accept
+             ;; connections.  XXX: What if we daemonized already?
+             (match pid-file
+               ((? string? file)
+                (with-atomic-file-output pid-file
+                  (cute display (getpid) <>)))
+               (#t (display (getpid)))
+               (_  #t))
+
+             (let next-command ()
+               (define (read-from sock)
+                 (match (accept sock)
+                   ((command-source . client-address)
+                    (setvbuf command-source (buffering-mode block) 1024)
+                    (process-connection command-source))
+                   (_ #f)))
+               (match (select (list sock) (list) (list) (if poll-services? 0.5 
#f))
+                 (((sock) _ _)
+                  (read-from sock))
+                 (_
+                  #f))
+               (when poll-services?
+                 (check-for-dead-services))
+               (next-command))))))))
 
 ;; Start all of SERVICES, which is a list of canonical names (FIXME?),
 ;; but in a order where all dependencies are fulfilled before we