aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorHugo Hörnquist <hugo@lysator.liu.se>2020-04-07 23:53:32 +0200
committerHugo Hörnquist <hugo@lysator.liu.se>2020-04-07 23:53:32 +0200
commit3f5b5a031aedf46f8cfee6d09edb3beed9cf7672 (patch)
tree51dc73fd8b26288dbe808319de6ddc80c0d0c1d8
parentAdd location to blocks, rrules and last-modified to text in html. (diff)
downloadcalp-3f5b5a031aedf46f8cfee6d09edb3beed9cf7672.tar.gz
calp-3f5b5a031aedf46f8cfee6d09edb3beed9cf7672.tar.xz
Introduce --repl.
-rwxr-xr-xmodule/main.scm10
-rw-r--r--module/repl.scm28
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?")])))