61 lines
1.7 KiB
Scheme
61 lines
1.7 KiB
Scheme
(define-module (starvat handler)
|
|
#:use-module (config)
|
|
#:use-module (goblins)
|
|
#:use-module (goblins actor-lib methods)
|
|
#:use-module (goblins actor-lib let-on)
|
|
#:use-module (goblins actor-lib cell)
|
|
#:use-module (web uri)
|
|
#:use-module (ice-9 textual-ports))
|
|
|
|
(define (response-code code)
|
|
(case code
|
|
((input) "10")
|
|
((sensitive-input) "11")
|
|
((success) "20")
|
|
((redirect-temporary) "30")
|
|
((redirect-permanent) "31")
|
|
((temporary-failure) "40")
|
|
((server-unavailable) "41")
|
|
((cgi-error) "42")
|
|
((proxy-error) "43")
|
|
((slow-down) "44")
|
|
((permanent-failure) "50")
|
|
((not-found) "51")
|
|
((gone) "52")
|
|
((proxy-request-refused) "53")
|
|
((bad-request) "59")
|
|
((client-certificate-required) "60")
|
|
((certificate-not-authorised) "61")
|
|
((certificate-not-valid) "62")))
|
|
|
|
(define (resource-dir hostname resources)
|
|
(define dir (assoc hostname resources))
|
|
(if dir
|
|
(cdr dir)
|
|
#f))
|
|
|
|
(define* (build-response code meta #:optional body)
|
|
(if body
|
|
(string-append (response-code code) " " meta "\r\n" body)
|
|
(string-append (response-code code) " " meta "\r\n")))
|
|
|
|
(define-public (^handler bcom config)
|
|
(define conf (spawn ^cell config))
|
|
(methods
|
|
((handle raw-url)
|
|
(define url (string->uri raw-url))
|
|
(if (not url)
|
|
(build-response 'bad-request "Could not parse URL")
|
|
(let ((dir (resource-dir (uri-host url)
|
|
(option-ref ($ conf) 'resources))))
|
|
(if (not dir)
|
|
(build-response 'not-found "Unknown host")
|
|
(if (not (file-exists? (string-append dir
|
|
(uri-path url))))
|
|
(build-response 'not-found "Unknown path")
|
|
(build-response 'success "text/gemini"
|
|
(call-with-input-file
|
|
(string-append dir
|
|
(uri-path url))
|
|
get-string-all)))))))))
|