From 918a56e896c3a96975301a7f1e0fda0c98de29d3 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Hugo=20H=C3=B6rnquist?= <hugo@lysator.liu.se>
Date: Mon, 4 May 2020 13:03:41 +0200
Subject: Add shutdown-hook.

---
 module/main.scm       | 6 +++++-
 module/repl.scm       | 9 +++++++--
 module/util/hooks.scm | 6 ++++++
 3 files changed, 18 insertions(+), 3 deletions(-)
 create mode 100644 module/util/hooks.scm

diff --git a/module/main.scm b/module/main.scm
index 11b76d5b..82caf00d 100755
--- a/module/main.scm
+++ b/module/main.scm
@@ -15,6 +15,7 @@
              (util time)
              (util app)
              (util config)
+             ((util hooks) :select (shutdown-hook))
 
              ((entry-points html)      :prefix      html-)
              ((entry-points terminal)  :prefix  terminal-)
@@ -97,7 +98,10 @@
   (report-time! "Program start")
   ;; ((@ (util config) print-configuration-documentation))
   (with-throw-handler #t
-    (lambda () (wrapped-main args))
+    (lambda () (dynamic-wind (lambda () 'noop)
+                        (lambda () (wrapped-main args))
+                        (lambda () (run-hook shutdown-hook))
+                        ))
     (lambda (err . args)
       (define stack (make-stack #t))
       (format
diff --git a/module/repl.scm b/module/repl.scm
index a0133403..ae559251 100644
--- a/module/repl.scm
+++ b/module/repl.scm
@@ -1,6 +1,8 @@
 (define-module (repl)
   :use-module (system repl server)
-  :use-module (ice-9 regex))
+  :use-module (ice-9 regex)
+  :use-module ((util hooks) :select (shutdown-hook))
+  )
 
 (define-public (runtime-dir)
   (or (getenv "XDG_RUNTIME_DIR")
@@ -16,8 +18,11 @@
                ;; IPv6 is as of Gulie 2.2 not supported by make-tcp-server-socket.
                ;; This might be the same problem as I encountered in my html server.
                [else 'UNIX])
-     ;; TODO created unix sockets are newer cleaned up
      [(UNIX)
+      (add-hook! shutdown-hook (lambda () (catch 'system-error (lambda () (delete-file address))
+                                       (lambda (err proc fmt . args)
+                                         ;; TODO warn here
+                                         err))))
       (make-unix-domain-server-socket path: address)]
      [(IPv4) (apply (case-lambda
                       [() (error "Empty address?")]
diff --git a/module/util/hooks.scm b/module/util/hooks.scm
new file mode 100644
index 00000000..d4d44ec9
--- /dev/null
+++ b/module/util/hooks.scm
@@ -0,0 +1,6 @@
+(define-module (util hooks)
+  :export (shutdown-hook))
+
+;; Run before program terminates
+(define-once shutdown-hook
+  (make-hook 0))
-- 
cgit v1.2.3