From 30aea3336645f612a5dd7790a177bd65d58b6595 Mon Sep 17 00:00:00 2001 From: paku <paku@skyizwhite.dev> Date: Mon, 22 Apr 2024 00:46:28 +0900 Subject: [PATCH] Add block-unsupported-browser middleware --- src/app.lisp | 3 ++- src/middlewares/block-unsupported-browser.lisp | 15 +++++++++++++++ 2 files changed, 17 insertions(+), 1 deletion(-) create mode 100644 src/middlewares/block-unsupported-browser.lisp diff --git a/src/app.lisp b/src/app.lisp index 1e608ab..b1dcd8b 100644 --- a/src/app.lisp +++ b/src/app.lisp @@ -31,7 +31,8 @@ (jg:install-middleware *app* mw:*public-files*) (jg:install-middleware *app* mw:*recovery*) (jg:install-middleware *app* mw:*normalize-path*) - (jg:install-middleware *app* mw:*accesslog*)) + (jg:install-middleware *app* mw:*accesslog*) + (jg:install-middleware *app* mw:*block-unsupported-browser*)) (defun update () (stop) diff --git a/src/middlewares/block-unsupported-browser.lisp b/src/middlewares/block-unsupported-browser.lisp new file mode 100644 index 0000000..9f2ad54 --- /dev/null +++ b/src/middlewares/block-unsupported-browser.lisp @@ -0,0 +1,15 @@ +(defpackage #:hp/middlewares/block-unsupported-browser + (:use #:cl) + (:local-nicknames (#:re #:cl-ppcre)) + (:export #:*block-unsupported-browser*)) +(in-package #:hp/middlewares/block-unsupported-browser) + +(defparameter *block-unsupported-browser* + (lambda (app) + (lambda (env) + (let ((user-agent (gethash "user-agent" (getf env :headers)))) + (if (re:scan "(Firefox|SamsungBrowser)" user-agent) + `(:400 + (:content-type "text/plain") + ("This site is not compatible with your browser. Please use Chrome, Edge, Safari, or another compatible browser.")) + (funcall app env))))))