From 6f2bab1cbd3434ba7057aad0dfa33bbf39368826 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Hugo=20H=C3=B6rnquist?= <hugo@lysator.liu.se>
Date: Wed, 12 Aug 2020 13:07:10 +0200
Subject: Move run-server to (server server).

---
 module/entry-points/server.scm | 37 +++++--------------------------------
 module/server/routes.scm       |  1 -
 module/server/server.scm       | 34 ++++++++++++++++++++++++++++++++++
 3 files changed, 39 insertions(+), 33 deletions(-)
 create mode 100644 module/server/server.scm

diff --git a/module/entry-points/server.scm b/module/entry-points/server.scm
index 76cdc7d1..dfa94cc7 100644
--- a/module/entry-points/server.scm
+++ b/module/entry-points/server.scm
@@ -6,24 +6,11 @@
   :use-module (srfi srfi-1)
 
   :use-module (ice-9 getopt-long)
-  :use-module (ice-9 regex) #| regex here due to bad macros |#
+  ;; :use-module (ice-9 regex) #| regex here due to bad macros |#
 
-  :use-module ((web server) :select (run-server))
+  :use-module ((server server) :select (start-server))
 
-  ;; :use-module (vcomponent)
-  ;; :use-module (vcomponent search)
-  ;; :use-module (datetime)
-  ;; :use-module (output html)
-  ;; :use-module (output ical)
-
-  :use-module ((server routes) :select (make-make-routes))
-
-  :export (main)
-  )
-
-
-
-
+  :export (main))
 
 
 (define options
@@ -64,16 +51,6 @@
         (if (eqv? family AF_INET6)
             "::" "0.0.0.0")))
 
-  ;; NOTE The default make-default-socket is broken for IPv6.
-  ;; A patch has been submitted to the mailing list. 2020-03-31
-  (module-set!
-   (resolve-module '(web server http))
-   'make-default-socket
-   (lambda (family addr port)
-     (let ((sock (socket family SOCK_STREAM 0)))
-       (setsockopt sock SOL_SOCKET SO_REUSEADDR 1)
-       (bind sock family addr port)
-       sock)))
 
   (format #t "Starting server on ~a:~a~%I'm ~a, runing from ~a~%"
           addr port
@@ -81,12 +58,8 @@
 
   (catch 'system-error
     (lambda ()
-     (run-server (make-make-routes)
-                 'http
-                 `(family: ,family
-                           port: ,port
-                           host: ,addr)
-                 0))
+      (start-server `(family: ,family port: ,port host: ,addr)))
+
     ;; probably address already in use
     (lambda (err proc fmt args errno)
       (format (current-error-port) "~a: ~?~%"
diff --git a/module/server/routes.scm b/module/server/routes.scm
index fefc9702..1e3af921 100644
--- a/module/server/routes.scm
+++ b/module/server/routes.scm
@@ -133,7 +133,6 @@
                                      intervaltype: 'month
                                      ))))))
 
-
    (POST "/remove" (uid)
          (unless uid
            (return (build-response code: 400)
diff --git a/module/server/server.scm b/module/server/server.scm
new file mode 100644
index 00000000..9c857b6d
--- /dev/null
+++ b/module/server/server.scm
@@ -0,0 +1,34 @@
+(define-module (server server)
+  :use-module (util)
+  :use-module (web server)
+  :use-module ((server routes) :select (make-make-routes))
+  :use-module (ice-9 threads))
+
+;; NOTE The default make-default-socket is broken for IPv6.
+;; A patch has been submitted to the mailing list. 2020-03-31
+(module-set!
+ (resolve-module '(web server http))
+ 'make-default-socket
+ (lambda (family addr port)
+   (let ((sock (socket family SOCK_STREAM 0)))
+     (setsockopt sock SOL_SOCKET SO_REUSEADDR 1)
+     (bind sock family addr port)
+     sock)))
+
+(define handler (make-make-routes))
+
+;; (define impl (lookup-server-impl 'http))
+;; (define server (open-server impl open-params))
+
+
+(define-public (start-server open-params)
+  (run-server handler 'http open-params 1)
+  ;; NOTE at first this seems to work, but it quickly deteriorates.
+  ;; (for i in (iota 16)
+  ;;      (begin-thread
+  ;;       (let lp ((state (list 0)))
+  ;;         (lp (serve-one-client handler impl server state)))))
+  ;; (pause)
+  )
+
+
-- 
cgit v1.2.3