From a45747c7d80ed7999657f08f67be7a575a1ae72d Mon Sep 17 00:00:00 2001
From: Craig Oates <craig@craigoates.net>
Date: Sat, 22 Oct 2022 22:51:13 +0100
Subject: [PATCH] implement back-end for 'manage database entries' ('danger
 zone').

This includes the HTTP GET and HTTP POST requests (defroutes in web.lisp). This
is part of the 'danger zone' features because it can leave the website in an
un-recoverable state.
---
 src/web.lisp | 63 ++++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 63 insertions(+)

diff --git a/src/web.lisp b/src/web.lisp
index 3ede973..da52332 100644
--- a/src/web.lisp
+++ b/src/web.lisp
@@ -1534,6 +1534,69 @@
                       "You are not authorised to delete page." "error")
 		     (redirect "/login")))))))
 
+(defroute ("/danger/manage-database-entries" :method :GET) ()
+  (hermetic:auth
+   (:logged-in)
+   ;; Authorised
+   (let ((alert (utils:get-and-reset-alert)))
+     (render "/danger/manage-db-entries.html"
+	     (append (auth:auth-user-data)
+		     `(:alert ,alert
+		       :system-data ,(nera:system-data)
+		       :archive-entries ,(nera:get-all-archive-entries)
+                       :storage-entries ,(nera:get-all-storage-files)
+                       :pages-entries ,(nera:get-all-pages)))))
+  ;; Not Authorised
+  (progn
+    (utils:set-alert "You are not authorised to view this page." "error")
+    (redirect "/login"))))
+
+(defroute ("/danger/delete-database-entry" :method :POST) ()
+  (destructuring-bind
+      (&key name table authenticity-token &allow-other-keys)
+      (utils:request-params (lack.request:request-body-parameters ningle:*request*))
+    (cond ((not (string= authenticity-token (auth:csrf-token)))
+	   `(,+forbidden+ (:content-type "text/plain") ("Denied")))
+	  (t (hermetic:auth
+	      (:administrator)
+	      ;; Authorised
+	      (cond ((find t (mapcar #'utils:string-is-nil-or-empty? `(,name ,table)))
+                     (utils:set-alert
+                      "Entry name or database table not provided." "missing-data")
+                     (redirect "/danger/manage-database-entries"))
+                    ((string= "page" table)
+                     (if (not (nera:get-page name))
+                         (utils:set-alert
+                          "Database entry cannot be found." "invalid-data")
+                         (progn
+                           (nera:delete-page :slug name)
+                           (utils:set-alert "Database entry deleted." "success")))
+                     (redirect "/danger/manage-database-entries"))
+                    ((string= "archive" table)
+                     (if (not (nera:get-archive-entry :slug name))
+                         (utils:set-alert
+                          "Database entry cannot be found." "invalid-data")
+                         (progn
+                           (nera:delete-archive-entry :slug name)
+                           (utils:set-alert
+                            "Database entry deleted." "success")))
+                     (redirect "/danger/manage-database-entries"))
+                    ((string= "storage-file" table)
+                     (if (not (nera:get-storage-file :slug name))
+                         (utils:set-alert
+                          "Database entry cannot be found." "invalid-data")
+                         (progn
+                           (nera:delete-storage-file :slug name)
+                           (utils:set-alert
+                            "Database entry deleted." "success")))
+                     (redirect "/danger/manage-database-entries"))
+                    (t (utils:set-alert "Database table not found." "invalid-data")
+                       (redirect "/danger/manage-database-entries")))
+	     ;; Not Authorised
+	     (progn (utils:set-alert
+                     "You are not authorised to delete page." "error")
+		    (redirect "/login")))))))
+
 (defroute ("/danger/repopulate-search-db" :method :POST) ()
    (destructuring-bind
       (&key authenticity-token &allow-other-keys)