diff --git a/src/web.lisp b/src/web.lisp index f02e196..7efc4cf 100644 --- a/src/web.lisp +++ b/src/web.lisp @@ -1028,6 +1028,53 @@ (progn (utils:set-alert "You are not logged in.") (redirect "/login"))))))) +(defroute ("/archive/delete/entry" :method :POST) () + (destructuring-bind + (&key slug authenticity-token &allow-other-keys) + (utils:request-params (lack.request:request-body-parameters ningle:*request*)) + (step + (cond ((not (string= authenticity-token (auth:csrf-token))) + `(,+forbidden+ (:content-type "text/plain") ("Denied"))) + (t (hermetic:auth + (:administrator) + ;; Authorised + (cond ((utils:string-is-nil-or-empty? slug) + (utils:set-alert "Cannot find archive entry in database. Nothing deleted.") + (redirect "/user/archive")) + + ((and (null (storage:file-exists-p "" "archive" slug)) + (null (nera:get-archive-entry :slug slug))) + (utils:set-alert "Unable to find archive entry. Nothing deleted.") + (redirect "/user/archive")) + + ((and (null (storage:file-exists-p "" "archive" slug)) + (not (null (nera:get-archive-entry :slug slug)))) + (nera:delete-archive-entry :slug slug) + (utils:set-alert "Couldn't find archive entry files. Deleted from database only.") + (redirect "/user/archive")) + + ((and (not (null (storage:file-exists-p "" "archive" slug))) + (null (nera:get-archive-entry :slug slug))) + (utils:set-alert "Couldn't find archive entry in database. Deleted files only.") + ;; The thumbnail in not know because it was linked to the + ;; text file via the database. You will need to delete the + ;; thumbnail manually at this point but the system has + ;; already failed here anyway so the extra work was already + ;; needed. + (storage:remove-file "" "archive" slug) + (redirect "/user/archive")) + + (t (storage:remove-file "" "archive" slug) + (storage:remove-file + "" "archive" + (archive::thumbnail-slug-of (nera:get-archive-entry :slug slug))) + (nera:delete-archive-entry :slug slug) + (utils:set-alert "Archive entry deleted.") + (redirect "/user/archive"))) + ;; Not Authorised + (progn (utils:set-alert "You are not authorised to delete this archive entry.") + (redirect "/login")))))))) + ;; ;; Error pages