src/csrf.lisp

   1 (uiop:define-package #:lw2.csrf
   2   (:use #:cl #:lw2.conditions #:lw2.client-script)
   3   (:export #:make-csrf-token #:check-csrf-token #:check-csrf)
   4   (:recycle #:lw2-viewer))
   5
   6 (in-package #:lw2.csrf)
   7
   8 (client-defun make-csrf-token (&optional (session-token (when-server (hunchentoot:cookie-in "session-token"))) (nonce (when-server (ironclad:make-random-salt))))
   9   (if-client
  10    (ps:chain -g-w csrf-token)
  11    (progn
  12      (if (typep session-token 'string) (setf session-token (base64:base64-string-to-usb8-array session-token)))
  13      (let ((csrf-token (concatenate '(vector (unsigned-byte 8)) nonce (ironclad:digest-sequence :sha256 (concatenate '(vector (unsigned-byte 8)) nonce session-token)))))
  14        (values (base64:usb8-array-to-base64-string csrf-token) csrf-token)))))
  15
  16 (defun check-csrf-token (csrf-token &optional (session-token (hunchentoot:cookie-in "session-token")))
  17   (unless (and (> (length csrf-token) 0)
  18                (> (length session-token) 0))
  19     (error 'csrf-check-failed))
  20   (let* ((session-token (base64:base64-string-to-usb8-array session-token))
  21          (csrf-token (base64:base64-string-to-usb8-array csrf-token))
  22          (correct-token (nth-value 1 (make-csrf-token session-token (subseq csrf-token 0 16)))))
  23     (unless (ironclad:constant-time-equal csrf-token correct-token)
  24       (error 'csrf-check-failed))
  25     t))
  26
  27 (defun check-csrf ()
  28   (unless (member (hunchentoot:request-method*) '(:get :head))
  29     (check-csrf-token (hunchentoot:post-parameter "csrf-token"))))