bug#34407: [PATCH] shepherd: Delete the socket file upon exit.

[iyzsong@member.fsf.org (宋文武)]

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

Yes, I have the 'rm /run/user/1000/shepherd/socket' workaround in my session
script too...

According to 'man 2 bind', the socket pathname should be deleted when no
longer required, so a patch to fix this bug:


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-shepherd-Delete-the-socket-file-upon-exit.patch --]
[-- Type: text/x-patch, Size: 3675 bytes --]

From f171f6adb2fc6ee3bf4d25378c2e7bba109b43d8 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?=E5=AE=8B=E6=96=87=E6=AD=A6?= <iyzsong@member.fsf.org>
Date: Sun, 17 Feb 2019 11:27:28 +0800
Subject: [PATCH] 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'.
---
 modules/shepherd.scm | 65 ++++++++++++++++++++++++++------------------
 1 file changed, 39 insertions(+), 26 deletions(-)

diff --git a/modules/shepherd.scm b/modules/shepherd.scm
index e241e7a..314b989 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)))))
+
 \f
 ;; 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
-- 
2.19.2