79 lines
3.1 KiB
Scheme
79 lines
3.1 KiB
Scheme
;; Safsaf, a Guile web framework
|
|
;; Copyright (C) 2026 Christopher Baines <mail@cbaines.net>
|
|
|
|
;; 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
|
|
;; <https://www.gnu.org/licenses/>.
|
|
|
|
(define-module (safsaf handler-wrappers csrf)
|
|
#:use-module (ice-9 format)
|
|
#:use-module (rnrs bytevectors)
|
|
#:use-module (srfi srfi-71)
|
|
#:use-module (gcrypt random)
|
|
#:use-module (web response)
|
|
#:use-module (webutils cookie)
|
|
#:use-module (safsaf response-helpers)
|
|
#:use-module (safsaf utils)
|
|
#:export (csrf-handler-wrapper
|
|
current-csrf-token
|
|
csrf-token-field))
|
|
|
|
(define (generate-csrf-token)
|
|
"Generate a 32-byte hex-encoded CSRF token."
|
|
(let* ((bv (gen-random-bv 32))
|
|
(len (bytevector-length bv)))
|
|
(string-concatenate
|
|
(map (lambda (i)
|
|
(format #f "~2,'0x" (bytevector-u8-ref bv i)))
|
|
(iota len)))))
|
|
|
|
(define current-csrf-token
|
|
(make-parameter #f))
|
|
|
|
(define* (csrf-handler-wrapper handler
|
|
#:key
|
|
(cookie-name "csrf-token"))
|
|
"CSRF token handler wrapper.
|
|
|
|
Ensures a CSRF token cookie is present on every response (generates one
|
|
if the request has none). The token is bound to current-csrf-token so
|
|
handlers and templates can read it via (current-csrf-token).
|
|
|
|
Token validation is NOT done here — it belongs in the form processing
|
|
layer. Use parse-form-params from (safsaf params), which automatically
|
|
checks the submitted token against the cookie token."
|
|
(lambda (request body-port)
|
|
(let* ((existing-token (request-cookie-ref request cookie-name))
|
|
(token (or existing-token (generate-csrf-token))))
|
|
(let ((response body (parameterize ((current-csrf-token token))
|
|
(handler request body-port))))
|
|
(if existing-token
|
|
(values response body)
|
|
(values (add-csrf-cookie response token cookie-name)
|
|
body))))))
|
|
|
|
(define (add-csrf-cookie response token cookie-name)
|
|
"Add a Set-Cookie header for the CSRF token to RESPONSE."
|
|
(let ((cookie (set-cookie cookie-name token
|
|
#:path "/"
|
|
#:extensions '(("SameSite" . "Strict")))))
|
|
(build-response/inherit response
|
|
#:headers (append (response-headers response) (list cookie)))))
|
|
|
|
(define (csrf-token-field)
|
|
"Return an SXML hidden input element for the CSRF token.
|
|
Use in forms: @code{(csrf-token-field)} @result{} @code{(input (@@
|
|
(type \"hidden\") ...))}."
|
|
`(input (@ (type "hidden")
|
|
(name "csrf-token")
|
|
(value ,(or (current-csrf-token) "")))))
|