73 lines
1.5 KiB
Scheme
73 lines
1.5 KiB
Scheme
(import frontend
|
|
command-line
|
|
texts
|
|
spiffy
|
|
openssl
|
|
(chicken tcp)
|
|
intarweb
|
|
uri-common)
|
|
|
|
(define -port- (make-parameter #f))
|
|
(define -certificate- (make-parameter #f))
|
|
(define -key- (make-parameter #f))
|
|
(define -user- (make-parameter #f))
|
|
(define -group- (make-parameter #f))
|
|
|
|
(command-line
|
|
print-help
|
|
(-h () "This help"
|
|
(print banner-line)
|
|
(newline)
|
|
(print "Command-line options:")
|
|
(print-help)
|
|
(newline)
|
|
(exit 0))
|
|
(-license () "Show licensing terms"
|
|
(print banner-line)
|
|
(newline)
|
|
(print license)
|
|
(exit 0))
|
|
""
|
|
"Configuration options:"
|
|
(-p (port) "Listen port"
|
|
(-port- (string->number port)))
|
|
(-c (cert) "Certificate"
|
|
(-certificate- cert))
|
|
(-k (key) "Private key"
|
|
(-key- key))
|
|
)
|
|
|
|
(define ssl? (and (-certificate-) (-key-) #t))
|
|
(define port (or (-port-) (if ssl? 443 80)))
|
|
|
|
(print banner-line)
|
|
(print "Port: " port)
|
|
(print "SSL: " ssl?)
|
|
(when ssl?
|
|
(print " Certificate:" (-certificate-))
|
|
(print " Key:" (-key-)))
|
|
|
|
(define listener
|
|
(if ssl?
|
|
(ssl-listen port)
|
|
(tcp-listen port)))
|
|
|
|
(when (and (-user-) (-group-))
|
|
(switch-user/group (-user-) (-group-)))
|
|
|
|
(handle-not-found
|
|
(lambda (path)
|
|
(define path-lst (uri-path (request-uri (current-request))))
|
|
(print (car path-lst))
|
|
(define body
|
|
(cond ((equal? (car path-lst) '/)
|
|
(print "index")
|
|
(frontend-lookup "index.html" "index not found"))
|
|
(else
|
|
"error")))
|
|
(send-response #:body body)))
|
|
|
|
(accept-loop listener
|
|
(if ssl?
|
|
ssl-accept
|
|
tcp-accept))
|