From 3f5b5a031aedf46f8cfee6d09edb3beed9cf7672 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Hugo=20H=C3=B6rnquist?= <hugo@lysator.liu.se>
Date: Tue, 7 Apr 2020 23:53:32 +0200
Subject: Introduce --repl.

---
 module/main.scm | 10 ++++++++--
 module/repl.scm | 28 ++++++++++++++++++++++++++++
 2 files changed, 36 insertions(+), 2 deletions(-)
 create mode 100644 module/repl.scm

(limited to 'module')

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?")])))
-- 
cgit v1.2.3