From 28d74eea06cf7ddb23733ad7ee0b55ffc66f849b Mon Sep 17 00:00:00 2001 From: colin Date: Thu, 15 Aug 2024 20:57:12 -0700 Subject: Add simple key protection to pasting --- package.lisp | 5 +++++ pastiche.lisp | 38 ++++++++++++++++++++++++++++---------- 2 files changed, 33 insertions(+), 10 deletions(-) diff --git a/package.lisp b/package.lisp index 4e6ef74..033efad 100644 --- a/package.lisp +++ b/package.lisp @@ -12,6 +12,11 @@ #:
#: #:

+   #:
+   #:
+   #:+   #:<button>
+   #:<form>
    #:@)
   (:local-nicknames
    (#:a #:alexandria-2)
diff --git a/pastiche.lisp b/pastiche.lisp
index 01ea05a..1ef0f55 100644
--- a/pastiche.lisp
+++ b/pastiche.lisp
@@ -32,8 +32,14 @@
    :ro
    :type integer
    :initform (error "Missing required slot"))
+  ((known-keys "List of known keys, these are included with pastes.")
+   :type list
+   :initform nil)
   :documentation "Application confiration, probably loaded from disk via LOAD-CONFIG.")
 
+(defun known-keys* ()
+  (known-keys *config*))
+
 (defun service-protocol* ()
   (service-protocol *config*))
 
@@ -201,8 +207,16 @@ from make-paste-filename."))
 
     (html:html-string page :pretty nil)))
 
+(eval-when (:compile-toplevel :load-toplevel :execute)
+  (def:class has-known-key ()
+    (key :type string :initform (error "key is required"))
+    :documentation "Mixin for endpoint classes that require a known key")
+
+  (defmethod http:authorize ((ep has-known-key))
+    (member (key ep) (known-keys*) :test #'equal)))
 
 (http:defendpoint create-paste
+  :using has-known-key
   :post :to "create" "paste"
   :returns "text/plain"
   :parameters
@@ -232,19 +246,23 @@ from make-paste-filename."))
     (fully-qualified-route-to instance)))
 
 (http:defendpoint new-paste-form
+  :using has-known-key
   :get :route ""
   :returns "text/html"
   :handle
   (with-output-to-string (out)
     (html:html
-     (html:<html>
-      (html:<body>
-       (html:<h1> "Paste something")
-       (html:<form>
-        (html:@ :method "POST" :action (http:route-to 'create-paste))
-        (html:<input> (html:@ :name "title" :placeholder "title"))
-        html:<br>
-        (html:<textarea> (html:@ :name "content" :rows "20" :cols "88"))
-        html:<br>
-        (html:<button> "Paste"))))
+     (<html>
+      (<body>
+       (<h1> "Paste something")
+       (<form>
+        (@ :method "POST" :action (http:route-to 'create-paste))
+        (<input> (@ :name "key" :value key :type "hidden"))
+        (<input> (@ :name "title" :placeholder "title"))
+        <br>
+        (<textarea> (@ :name "content" :rows "20" :cols "88"))
+        <br>
+        (<button> "Paste"))))
      out)))
+
+
-- 
cgit v1.2.3