From 1cf86c674c03613e9116ef0c0176494218fb1b0f Mon Sep 17 00:00:00 2001 From: Craig Oates Date: Tue, 20 Sep 2022 20:35:05 +0100 Subject: [PATCH] end-of-session-commit: working on /storage/delete/:slug defroute. Need to test it and make sure the logic in the various 'cond' sections. --- src/web.lisp | 37 +++++++++++++++++++++++++++++++++++++ 1 file changed, 37 insertions(+) diff --git a/src/web.lisp b/src/web.lisp index 932dd63..4c64077 100644 --- a/src/web.lisp +++ b/src/web.lisp @@ -843,6 +843,43 @@ (utils:set-alert "You are not authorised to view this page.") (redirect "/login")))))) +;; TODO: FINISH WORKING ON /STORAGE/DELETE DEFROUTE -- NEED TO TEST IT. +(defroute ("/storage/delete/:slug" :method :POST) () + (destructuring-bind + (&key 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 ((and (null (storage:file-exists-p "" "media" :slug slug)) + (null (nera:get-storage-file :slug slug))) + (utils:set-alert "Unable to find file. Nothing deleted.") + (redirect "/storage/manage")) + + ((and (storage:file-exists-p "" "media" :slug slug) + (null (nera:get-storage-file :slug slug))) + (utils:set-alert "Unable to entry in database. Delete file from system.") + (storage:remove-file "" "media" slug) + (redirect "/storage/manage")) + + ((and (null (storage:file-exists-p "" "media" :slug slug)) + ((nera:get-storage-file :slug slug))) + (utils:set-alert "Unable to find file. Deleted entry from database.") + (nera:delete-storage-file :slug slug) + (redirect "/storage/manage")) + + (t (storage:remove-file + "" ; `USERNAME' blank because it's not used/needed. + "media" slug) + (nera:delete-storage-file :slug slug) + (utils:set-alert "File deleted.") + (redirect "/storage/manage"))) + ;; Not Authorised + (progn (utils:set-alert "You are not authorised to delete page.") + (redirect "/login"))))))) + ;; ;; Error pages