;; Safsaf, a Guile web framework ;; Copyright (C) 2026 Christopher Baines ;; This program is free software: you can redistribute it and/or ;; modify it under the terms of the GNU Lesser General Public License ;; as published by the Free Software Foundation, either version 3 of ;; the License, or (at your option) any later version. ;; ;; This program is distributed in the hope that it will be useful, but ;; WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU ;; Lesser General Public License for more details. ;; ;; You should have received a copy of the GNU Lesser General Public ;; License along with this program. If not, see ;; . (define-module (safsaf) #:use-module (web request) #:use-module (web response) #:use-module (web uri) #:use-module (srfi srfi-1) #:use-module (srfi srfi-71) #:use-module (fibers) #:use-module (fibers conditions) #:use-module (fibers scheduler) #:use-module (knots) #:use-module (knots web-server) #:use-module (safsaf router) #:export (run-safsaf default-method-not-allowed-handler)) (define (default-method-not-allowed-handler request allowed-methods) "Return a 405 Method Not Allowed response with an Allow header listing ALLOWED-METHODS." (values (build-response #:code 405 #:headers `((allow . ,allowed-methods) (content-type text/plain))) "Method Not Allowed")) (define* (make-handler compiled-routes reverse-routes #:key method-not-allowed? method-not-allowed-handler) "Build a handler that dispatches to the matching route. Handler signature: (request body-port) -> (values response body). HEAD requests that have no explicit route are automatically handled by dispatching to the matching GET handler and discarding the response body. When METHOD-NOT-ALLOWED? is true, requests whose path matches a route but whose method does not receive a 405 response via METHOD-NOT-ALLOWED-HANDLER." (let ((catch-all-handler (compiled-route-handler (last compiled-routes)))) (define (run-handler handler bindings request body-port) (parameterize ((current-route-params bindings) (current-reverse-routes reverse-routes)) (handler request body-port))) (define (check-405-or-catch-all handler bindings path-segments request body-port) (if method-not-allowed? (let* ((allowed (find-allowed-methods compiled-routes path-segments)) ;; GET implies HEAD via auto-HEAD handling. (allowed (if (and (memq 'GET allowed) (not (memq 'HEAD allowed))) (cons 'HEAD allowed) allowed))) (if (null? allowed) (run-handler handler bindings request body-port) (method-not-allowed-handler request allowed))) (run-handler handler bindings request body-port))) (lambda (request body-port) (let* ((method (request-method request)) (path-segments (split-and-decode-uri-path (uri-path (request-uri request)))) (handler bindings (match-route compiled-routes method path-segments))) (cond ;; Direct match — dispatch normally. ((not (eq? handler catch-all-handler)) (run-handler handler bindings request body-port)) ;; HEAD with no explicit route — try GET, discard body. ((eq? method 'HEAD) (let ((get-handler get-bindings (match-route compiled-routes 'GET path-segments))) (if (eq? get-handler catch-all-handler) ;; No GET route either — 405 or catch-all. (check-405-or-catch-all handler bindings path-segments request body-port) ;; Run GET handler, keep response headers, discard body. (let ((response _body (run-handler get-handler get-bindings request body-port))) (values response ""))))) ;; Catch-all matched — check for 405. (else (check-405-or-catch-all handler bindings path-segments request body-port))))))) (define* (run-safsaf routes #:key (host #f) (port 8080) (method-not-allowed? #t) (method-not-allowed-handler default-method-not-allowed-handler) (connection-buffer-size #f)) "Start a Safsaf web server. ROUTES is a list of routes and route-groups (as returned by component constructors). The last route must be a catch-all so that every request is handled. HEAD requests are handled automatically: when no explicit HEAD route matches, the matching GET handler runs and its response body is discarded. Explicit HEAD routes always take precedence. When METHOD-NOT-ALLOWED? is #t (the default), requests that match a route's path but not its method receive a 405 response with an Allow header. METHOD-NOT-ALLOWED-HANDLER is a procedure (request allowed-methods) -> (values response body) that produces the 405 response; the default returns plain text. When called outside a Fibers scheduler, sets up a scheduler, starts the HTTP server, and blocks until Ctrl-C. When called inside an existing scheduler (e.g. within run-fibers), just starts the HTTP server and returns immediately — the caller manages the lifecycle." (let* ((compiled reverse-routes (compile-routes routes)) (handler (make-handler compiled reverse-routes #:method-not-allowed? method-not-allowed? #:method-not-allowed-handler method-not-allowed-handler))) (define (start-server) (apply run-knots-web-server handler #:host host #:port port #:call-handler-with-body-port? #t (if connection-buffer-size (list #:connection-buffer-size connection-buffer-size) '()))) (if (current-scheduler) ;; Already inside run-fibers — just start the server. (start-server) ;; Standalone — manage the full lifecycle. (run-fibers (lambda () (start-server) (let ((quit-cvar (make-condition))) (call-with-sigint (lambda () (wait quit-cvar)) quit-cvar)))))))