diff --git a/lack-middleware-csrf.asd b/lack-middleware-csrf.asd new file mode 100644 index 0000000..2702a01 --- /dev/null +++ b/lack-middleware-csrf.asd @@ -0,0 +1,15 @@ +(in-package :cl-user) +(defpackage :lack-middleware-csrf-asd + (:use :cl :asdf)) +(in-package :lack-middleware-csrf-asd) + +(defsystem lack-middleware-csrf + :version "0.1" + :author "Eitaro Fukamachi" + :license "LLGPL" + :depends-on (:lack-request + :lack-util) + :components ((:module "src" + :components + ((:file "middleware/csrf")))) + :in-order-to ((test-op (test-op t-lack-middleware-csrf)))) diff --git a/src/middleware/csrf.lisp b/src/middleware/csrf.lisp new file mode 100644 index 0000000..1c28c80 --- /dev/null +++ b/src/middleware/csrf.lisp @@ -0,0 +1,60 @@ +(in-package :cl-user) +(defpackage lack.middleware.csrf + (:use :cl) + (:import-from :lack.request + :make-request + :request-body-parameters) + (:import-from :lack.util + :generate-random-id) + (:export :*lack-middleware-csrf* + :csrf-token + :csrf-html-tag)) +(in-package :lack.middleware.csrf) + +(defvar *lack-middleware-csrf* + (lambda (app &key (block-app #'return-400) one-time) + (lambda (env) + (block nil + (unless (danger-method-p (getf env :request-method)) + (return (funcall app env))) + + (let ((session (getf env :lack.session))) + (unless session + (error ":lack.session is missing in ENV. Wrap this app up with lack.middleware.session")) + + (if (valid-token-p env) + (progn + (when one-time + (remhash :csrf-token session)) + (funcall app env)) + (funcall block-app env))))))) + +(defun return-400 (env) + (declare (ignore env)) + '(400 + (:content-type "text/plain" + :content-length 31) + ("Bad Request: invalid CSRF token"))) + +(defun danger-method-p (request-method) + (member request-method + '(:POST :PUT :DELETE :PATCH) + :test #'eq)) + +(defun valid-token-p (env) + (let ((req (make-request env)) + (csrf-token (gethash :csrf-token + (getf env :lack.session)))) + (and csrf-token + (let ((recieved-csrf-token + (cdr (assoc "_csrf_token" (request-body-parameters req) :test #'string=)))) + (string= csrf-token recieved-csrf-token))))) + +(defun csrf-token (session) + (unless (gethash :csrf-token session) + (setf (gethash :csrf-token session) (generate-random-id))) + (gethash :csrf-token session)) + +(defun csrf-html-tag (session) + (format nil "" + (csrf-token session))) diff --git a/t-lack-middleware-csrf.asd b/t-lack-middleware-csrf.asd new file mode 100644 index 0000000..eb3a253 --- /dev/null +++ b/t-lack-middleware-csrf.asd @@ -0,0 +1,22 @@ +(in-package :cl-user) +(defpackage t-lack-middleware-csrf-asd + (:use :cl :asdf)) +(in-package :t-lack-middleware-csrf-asd) + +(defsystem t-lack-middleware-csrf + :author "Eitaro Fukamachi" + :license "LLGPL" + :depends-on (:lack + :lack-request + :lack-test + :lack-middleware-csrf + :prove + :cl-ppcre + :dexador + :cl-cookie) + :components + ((:test-file "t/middleware/csrf")) + + :defsystem-depends-on (:prove-asdf) + :perform (test-op :after (op c) + (funcall (intern #.(string :run-test-system) :prove) c))) diff --git a/t/middleware/csrf.lisp b/t/middleware/csrf.lisp new file mode 100644 index 0000000..c162b27 --- /dev/null +++ b/t/middleware/csrf.lisp @@ -0,0 +1,123 @@ +(in-package :cl-user) +(defpackage t.lack.middleware.csrf + (:use :cl + :prove + :lack + :lack.request + :lack.test + :lack.middleware.csrf + :cl-cookie)) +(in-package :t.lack.middleware.csrf) + +(plan 2) + +(defun html-form (env) + (concatenate + 'string + " + + +
+ +" + (csrf-html-tag (getf env :lack.session)) + " + +
+ + +")) + +(defun parse-csrf-token (body) + (let ((match (nth-value + 1 + (ppcre:scan-to-strings + "name=\"_csrf_token\" value=\"(.+?)\"" body)))) + (and match (elt match 0)))) + +(subtest-app "CSRF middleware" + (builder + :session + :csrf + #'(lambda (env) + (let ((req (make-request env))) + `(200 + (:content-type "text/html") + (,(if (and (eq :post (request-method req)) + (assoc "name" (request-body-parameters req) :test #'string=)) + (cdr (assoc "name" (request-body-parameters req) :test #'string=)) + (html-form env))))))) + (let (csrf-token + (cookie-jar (make-instance 'cookie-jar))) + (diag "first POST request") + (is (nth-value 1 (dex:post "http://localhost:4242/" + :cookie-jar cookie-jar)) + 400) + (diag "first GET request") + (multiple-value-bind (body status headers) + (dex:get "http://localhost:4242/" + :cookie-jar cookie-jar) + (is status 200 "Status is 200") + (is (gethash "content-type" headers) "text/html" "Content-Type is text/html") + (setf csrf-token (parse-csrf-token body)) + (ok csrf-token "can get CSRF token") + (is-type csrf-token 'string "CSRF token is string") + (is (length csrf-token) 40 "CSRF token is 40 chars")) + (diag "bad POST request (no token)") + (multiple-value-bind (body status headers) + (dex:post "http://localhost:4242/" + :cookie-jar cookie-jar) + (is status 400 "Status is 400") + (is (gethash "content-type" headers) "text/plain" "Content-Type is text/plain") + (is body "Bad Request: invalid CSRF token" "Body is 'forbidden'")) + (diag "bad POST request (wrong token)") + (is (nth-value + 1 + (dex:post "http://localhost:4242/" + :content '(("name" . "Eitaro Fukamachi") + ("_csrf_token" . "wrongtokeniknow")) + :cookie-jar cookie-jar)) + 400) + (diag "valid POST request") + (multiple-value-bind (body status headers) + (dex:post "http://localhost:4242/" + :content `(("name" . "Eitaro Fukamachi") + ("_csrf_token" . ,csrf-token)) + :cookie-jar cookie-jar) + (is status 200 "Status is 200") + (is (gethash "content-type" headers) "text/html" "Content-Type is text/html") + (is body "Eitaro Fukamachi" "can read body-parameter")))) + +(subtest-app "enable one-time token" + (builder + :session + (:csrf :one-time t) + #'(lambda (env) + (let ((req (make-request env))) + `(200 + (:content-type "text/html") + (,(if (and (eq :post (request-method req)) + (assoc "name" (request-body-parameters req) :test #'string=)) + (cdr (assoc "name" (request-body-parameters req) :test #'string=)) + (html-form env))))))) + (let (csrf-token + (cookie-jar (make-instance 'cookie-jar))) + (setf csrf-token + (parse-csrf-token + (dex:get "http://localhost:4242/" + :cookie-jar cookie-jar))) + (dex:post "http://localhost:4242/" + :content `(("name" . "Eitaro Fukamachi") + ("_csrf_token" . ,csrf-token)) + :cookie-jar cookie-jar) + (diag "bad POST request with before token") + (multiple-value-bind (body status headers) + (dex:post "http://localhost:4242/" + :content `(("name" . "Eitaro Fukamachi") + ("_csrf_token" . ,csrf-token)) + :cookie-jar cookie-jar) + (declare (ignore body)) + (is status 400 "Status is 400") + (is (gethash "content-type" headers) "text/plain" "Content-Type is text/plain")))) + +(finalize)