diff options
| author | Hugo Hörnquist <hugo@lysator.liu.se> | 2020-05-04 13:03:41 +0200 |
|---|---|---|
| committer | Hugo Hörnquist <hugo@lysator.liu.se> | 2020-05-04 13:03:41 +0200 |
| commit | 918a56e896c3a96975301a7f1e0fda0c98de29d3 (patch) | |
| tree | 3bfd11391f2706882a69b23c63e764cd81e96f21 | |
| parent | Fix server --port flag. (diff) | |
| download | calp-918a56e896c3a96975301a7f1e0fda0c98de29d3.tar.gz calp-918a56e896c3a96975301a7f1e0fda0c98de29d3.tar.xz | |
Add shutdown-hook.
| -rwxr-xr-x | module/main.scm | 6 | ||||
| -rw-r--r-- | module/repl.scm | 9 | ||||
| -rw-r--r-- | module/util/hooks.scm | 6 |
3 files changed, 18 insertions, 3 deletions
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)) |