diff options
author | Hugo Hörnquist <hugo@lysator.liu.se> | 2020-08-12 13:07:10 +0200 |
---|---|---|
committer | Hugo Hörnquist <hugo@lysator.liu.se> | 2020-08-12 13:07:10 +0200 |
commit | 6f2bab1cbd3434ba7057aad0dfa33bbf39368826 (patch) | |
tree | a85c08a089566643402da51e32463677bb284a84 /module/server | |
parent | Start adding tests for server. (diff) | |
download | calp-6f2bab1cbd3434ba7057aad0dfa33bbf39368826.tar.gz calp-6f2bab1cbd3434ba7057aad0dfa33bbf39368826.tar.xz |
Move run-server to (server server).
Diffstat (limited to 'module/server')
-rw-r--r-- | module/server/routes.scm | 1 | ||||
-rw-r--r-- | module/server/server.scm | 34 |
2 files changed, 34 insertions, 1 deletions
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) + ) + + |