bug#27323: [PATCH shepherd] Make sure that shepherd does not serve already-served sockets.

[Danny Milosavljevic <dannym@scratchpost.org>]

* modules/shepherd.scm (server-present?): New variable.
(main): Adapt.
---
 modules/shepherd.scm | 19 +++++++++++++++++--
 1 file changed, 17 insertions(+), 2 deletions(-)

diff --git a/modules/shepherd.scm b/modules/shepherd.scm
index dd8a076..4998e09 100644
--- a/modules/shepherd.scm
+++ b/modules/shepherd.scm
@@ -32,10 +32,21 @@
   #:use-module (shepherd runlevel)
   #:use-module (shepherd args)
   #:use-module (shepherd comm)
+  #:use-module (rnrs io ports)
   #:export (main))
 
 \f
 
+(define (server-present? file-name)
+  "Open a socket at FILE-NAME, and connect to the server, if any.
+Return #t if that worked."
+  (with-fluids ((%default-port-encoding "UTF-8"))
+    (let ((sock (socket PF_UNIX SOCK_STREAM 0)))
+      (call-with-port sock
+        (lambda (sock)
+          (let ((address (make-socket-address AF_UNIX file-name)))
+            (false-if-exception (connect sock address))))))))
+
 (define (open-server-socket file-name)
   "Open a socket at FILE-NAME, and listen for connections there."
   (with-fluids ((%default-port-encoding "UTF-8"))
@@ -132,8 +143,12 @@
 					      ;; we use no socket.
 					      #f)))))))
     ;; We do this early so that we can abort early if necessary.
-    (and socket-file
-         (verify-dir (dirname socket-file) #:secure? secure))
+    (if socket-file
+      (begin
+         (verify-dir (dirname socket-file) #:secure? secure)
+         (if (server-present? socket-file)
+             (exit 0)))) ; There's already a shepherd instance running.
+
     ;; Enable logging as first action.
     (start-logging logfile)