aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorHugo Hörnquist <hugo@lysator.liu.se>2020-08-12 13:07:10 +0200
committerHugo Hörnquist <hugo@lysator.liu.se>2020-08-12 13:07:10 +0200
commit6f2bab1cbd3434ba7057aad0dfa33bbf39368826 (patch)
treea85c08a089566643402da51e32463677bb284a84
parentStart adding tests for server. (diff)
downloadcalp-6f2bab1cbd3434ba7057aad0dfa33bbf39368826.tar.gz
calp-6f2bab1cbd3434ba7057aad0dfa33bbf39368826.tar.xz
Move run-server to (server server).
-rw-r--r--module/entry-points/server.scm37
-rw-r--r--module/server/routes.scm1
-rw-r--r--module/server/server.scm34
3 files changed, 39 insertions, 33 deletions
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)
+ )
+
+