cbaines/guile-knots
1
Fork 0
Code Issues 1 Pull requests Activity Actions

Fix some issues handling head requests

Browse source 
Rather than raising an exception when there's a body provided, use the
body as normal to inform the headers, as this is useful, and just
don't write the body to the client.
This commit is contained in:
Christopher Baines 2026-01-09 15:14:47 +00:00
parent 338d08081e
commit 4642f7c7d2
2 changed files with 127 additions and 59 deletions
Download patch file Download diff file Expand all files Collapse all files

65
tests/web-server.scm
View file

@ -1,5 +1,6 @@
(use-modules (srfi srfi-71)
(rnrs bytevectors)
(ice-9 match)
(ice-9 binary-ports)
(ice-9 textual-ports)
(tests)
@ -233,4 +234,68 @@
(assert-equal (get-message exception-handled-sucecssfully-channel)
#t))))
(run-fibers-for-tests
(lambda ()
(let* ((web-server
(run-knots-web-server
(lambda (request)
(match (split-and-decode-uri-path
(uri-path (request-uri request)))
(("head-no-body")
(values '((content-type . (text/plain)))
#f))
(("head-empty-body")
(values '((content-type . (text/plain)))
""))
(("head-no-body-with-content-length")
(values '((content-type . (text/plain))
(content-length . 10))
#f))
(("head-with-body")
(values '((content-type . (text/plain)))
"foo"))
(("head-procedure-body")
(values '((content-type . (text/plain)))
(lambda _
(error "should not be run"))))
(("head-procedure-body-with-content-length")
(values '((content-type . (text/plain))
(content-length . 10))
(lambda _
(error "should not be run"))))))
#:port 0)) ;; Bind to any port
(port
(web-server-port web-server)))
(define* (head path)
(let ((uri
(build-uri 'http #:host "127.0.0.1" #:port port
#:path path)))
(http-head
uri
#:port (non-blocking-open-socket-for-uri uri))))
(let ((response
(head "/head-no-body")))
(assert-equal 200 (response-code response)))
(let ((response
(head "/head-empty-body")))
(assert-equal 200 (response-code response))
(assert-equal 0 (response-content-length response)))
(let ((response
(head "/head-no-body-with-content-length")))
(assert-equal 200 (response-code response))
(assert-equal 10 (response-content-length response)))
(let ((response
(head "/head-with-body")))
(assert-equal 200 (response-code response))
(assert-equal 3 (response-content-length response)))
(let ((response
(head "/head-procedure-body")))
(assert-equal 200 (response-code response)))
(let ((response
(head "/head-procedure-body-with-content-length")))
(assert-equal 200 (response-code response))
(assert-equal 10 (response-content-length response))))))
(display "web-server test finished successfully\n")