(define-module (calp entry-points server)
:use-module (hnh util)
:use-module (hnh util options)
:use-module (calp util config)
:use-module (srfi srfi-1)
:use-module (ice-9 getopt-long)
:use-module (ice-9 format)
:use-module (calp translation)
:use-module (sxml simple)
:use-module ((calp server server) :select (start-server))
:export (main))
(define options
`((port (value #t) (single-char #\p)
(description ,(xml->sxml (_ "Bind to TCP port, defaults to 8080.
Can also be set through the config variable
port."))))
(addr (value #t)
(description ,(xml->sxml (_ "Address to use, defaults to 0.0.0.0 for IPv4,
and [::] for IPv6"))))
;; numbers as single-char doesn't work.
(six (description ,(_ "Use IPv6.")))
(four (description ,(_ "Use IPv4.")))
(sigusr (description ,(_ "Reload events on SIGUSR1")))
(help (single-char #\h)
(description ,(_ "Print this help.")))))
(define-config port 8080
description: (_ "Port to which the web server should bind."))
(define-public (main args)
(define opts (getopt-long args (getopt-opt options)))
(define addr (option-ref opts 'addr #f))
(define port (cond ((option-ref opts 'port #f) => string->number)
(else (port))))
(define family
(cond [(option-ref opts 'six #f) AF_INET6]
[(option-ref opts 'four #f) AF_INET]
[(and addr (string-contains addr ":")) AF_INET6]
[(and addr (string-contains addr ".")) AF_INET]
[else AF_INET6]))
(when (option-ref opts 'help #f)
(print-arg-help options)
(throw 'return))
;; update address if it was left blank. A bit clumsy since
;; @var{addr} & @var{family} depend on each other.
;; placed after load-calendars to keep Guile 2.2 compability.
(set! addr
(if addr addr
(if (eqv? family AF_INET6)
"::" "0.0.0.0")))
(when (option-ref opts 'sigusr #f)
(format (current-error-port) (_ "Listening for SIGUSR1~%"))
;; NOTE this uses the main thread, and does therefore block HTTP requests
;; while reloading. However, it appears to not cause any race conditions.
(sigaction SIGUSR1
(lambda _
(format (current-error-port) (_ "Received SIGUSR1, reloading calendars~%"))
((@ (vcomponent util instance) reload)))))
;; Arguments are
;; IP-address which we bind to
;; Port which we listen to
;; PID of this process
;; PWD of this process
(format #t (_ "Starting server on ~a:~a~%I'm ~a, runing from ~a~%")
addr port
(getpid) (getcwd))
(catch 'system-error
(lambda ()
(start-server (list family: family port: port host: addr)))
;; probably address already in use
(lambda (err proc fmt args errno)
(format (current-error-port) "~a: ~?~%"
proc fmt args))))