diff options
author | Hugo Hörnquist <hugo@lysator.liu.se> | 2020-04-07 23:53:32 +0200 |
---|---|---|
committer | Hugo Hörnquist <hugo@lysator.liu.se> | 2020-04-07 23:53:32 +0200 |
commit | 3f5b5a031aedf46f8cfee6d09edb3beed9cf7672 (patch) | |
tree | 51dc73fd8b26288dbe808319de6ddc80c0d0c1d8 /module | |
parent | Add location to blocks, rrules and last-modified to text in html. (diff) | |
download | calp-3f5b5a031aedf46f8cfee6d09edb3beed9cf7672.tar.gz calp-3f5b5a031aedf46f8cfee6d09edb3beed9cf7672.tar.xz |
Introduce --repl.
Diffstat (limited to 'module')
-rwxr-xr-x | module/main.scm | 10 | ||||
-rw-r--r-- | module/repl.scm | 28 |
2 files changed, 36 insertions, 2 deletions
diff --git a/module/main.scm b/module/main.scm index 4b47025a..246e729c 100755 --- a/module/main.scm +++ b/module/main.scm @@ -28,23 +28,29 @@ exec guile -e main -s $0 "$@" (ice-9 getopt-long) (statprof) + (repl) ) (define options '((statprof (value optional)) + (repl (value optional)) (help (single-char #\h)))) (define (ornull a b) (if (null? a) b a)) + (define (wrapped-main args) (define opts (getopt-long args options #:stop-at-first-non-option #t)) (define stprof (option-ref opts 'statprof #f)) + (define repl (option-ref opts 'repl #f)) - (when stprof - (statprof-start)) + (when stprof (statprof-start)) + + (cond [(eqv? #t repl) (repl-start (format #f "~a/calp-~a" (runtime-dir) (getpid)))] + [repl => repl-start]) (let ((config-file (format #f "~a/.config/calp/config.scm" (getenv "HOME")))) diff --git a/module/repl.scm b/module/repl.scm new file mode 100644 index 00000000..f73f3da6 --- /dev/null +++ b/module/repl.scm @@ -0,0 +1,28 @@ +(define-module (repl) + :use-module (system repl server) + ) + +(define-public (runtime-dir) + (or (getenv "XDG_RUNTIME_DIR") + "/tmp")) + +(define-public (repl-start address) + (define lst (string->list address)) + (format (current-error-port) + "Starting REPL server at ~a~%" address) + (spawn-server + (case (cond [(memv (car lst) '(#\. #\/)) 'UNIX] + [(string-match "(\\d{1,3}\\.){3}\\d{1,3}(:\\d+)?" address) 'IPv4] + ;; 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) + (make-unix-domain-server-socket path: address)] + [(IPv4) (apply (case-lambda + [() (error "Empty address?")] + [(address) (make-tcp-server-socket host: address)] + [(address port) (make-tcp-server-socket host: address port: port)]) + (string-split address #\:))] + ;; currently impossible + [(IPv6) (error "How did you get here?")]))) |