(in-package #:cl-user) (defpackage #:ritherdon-archive.web (:use #:cl #:caveman2 #:ritherdon-archive.config #:ritherdon-archive.view #:ritherdon-archive.db #:datafly #:sxql #:cl-pass #:app-constants #:status-codes ; (HTTP Status Codes) #:hermetic #:auth #:utils #:validation #:user #:nera-db #:files #:search #:snapshot) (:export #:*web*)) (in-package #:ritherdon-archive.web) ;; for @route annotation (syntax:use-syntax :annot) ;; ;; Application (defclass () ()) (defvar *web* (make-instance ')) (clear-routing-rules *web*) ;; ;; Routing rules (defroute "/" () (cond ((not (uiop:file-exists-p (ritherdon-archive.config:database-name))) (redirect "/setup")) ((string= "archive" (site-settings::home-page-of (nera:get-site-settings))) (redirect "/archive")) ((string= "login" (site-settings::home-page-of (nera:get-site-settings))) (redirect "/login")) ((string= "pages" (site-settings::home-page-of (nera:get-site-settings))) (redirect "/pages")) ((string= "search" (site-settings::home-page-of (nera:get-site-settings))) (redirect "/search")) ((string= "sign-up" (site-settings::home-page-of (nera:get-site-settings))) (redirect "/sign-up")) (t (render #P"index.html" (append (if (hermetic:logged-in-p) (auth:auth-user-data)) `(:alert ,(utils:get-and-reset-alert) :nav-menu ,(nera:nav-menu-slugs) :system-data ,(nera:system-data) :content ,(storage:open-text-file "" "pages" (site-settings::home-page-of (nera:get-site-settings))))))))) (defroute "/setup" () ;; If there is no database, there is no user, hence no more checks. (cond ((not (uiop:file-exists-p (ritherdon-archive.config:database-name))) (render #P"initial-setup.html" `(:token ,(auth:csrf-token)))) (t `(,+service-unavailable+ (:location "/"))))) (defroute ("/run-setup" :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"))) ((uiop:file-exists-p (ritherdon-archive.config:database-name)) `(,+service-unavailable+ (:location "/"))) (t (nera-db:init-db (lack.request:request-body-parameters ningle:*request*)) (storage:init-storage) ;; Redirect to /setup-complete? (utils:set-alert "All set-up. Log-in to continue." "created") (redirect "/login"))))) (defroute ("/sign-up" :method :GET) () (if (= +false+ (site-settings::enable-sign-up-p (nera:get-site-settings))) (progn (utils:set-alert "This feature has been disabled." "warning") (redirect "/")) (hermetic:auth (:logged-in) ;; Hermetic Authorised (Logged in users can't sign-up). (progn (utils:set-alert "You need to be signed out to create a new account." "warning") (redirect "/dashboard")) ;; Hermetic Not Authorised (let ((alert (utils:get-and-reset-alert))) (render "sign-up.html" `(:token ,(auth:csrf-token) :system-data ,(nera:system-data) :alert ,alert)))))) (defroute ("/sign-up" :method :POST) () (destructuring-bind (&key username display-name password password-check 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"))) ((not (null (nera:get-user username))) (utils:set-alert "Username already taken." "warning") (redirect "/sign-up")) ((not (string= password password-check)) (utils:set-alert "Passwords don't match." "invalid-data") (redirect "/sign-up")) ((find t (mapcar #'validation:string-is-nil-or-empty? `(,username ,display-name ,password))) (utils:set-alert "Incomplete form. Please fill out every section." "missing-data") (redirect "/sign-up")) (t (hermetic:auth (:logged-in) ;; Authorised (Logged in user can't sign-up). (progn (utils:set-alert "Logged in users are not allowed to create account." "warning") (redirect "/dashboard")) ;; Not Authorised (progn (nera-db:create-user username display-name password +false+) (utils:set-alert "Account created." "created") (redirect "/login"))))))) (defroute ("/login" :method :GET) () (hermetic:auth (:logged-in) ;; Authorised (redirect "/dashboard") ;; Not Authorised (let ((alert (utils:get-and-reset-alert))) (render "user/log-in.html" `(:token ,(auth:csrf-token) :system-data ,(nera:system-data) :alert ,alert))))) (defroute ("/login" :method :POST) () (destructuring-bind (&key username password authenticity-token &allow-other-keys) (utils:request-params (lack.request:request-body-parameters ningle:*request*)) (if (not (string= authenticity-token (csrf-token))) `(,+forbidden+ (:content-type "text/plain") ("Denied")) (let ((params (list :|username| username :|password| password))) (hermetic:login params ;; Successful log-in attempt. (progn (setf ;; Set session Id. to the logged in user. (gethash :id ningle:*session*) (nera:get-user-id username) ;; Set the users password (for session) (gethash :password ningle:*session*) password) (redirect "/dashboard")) ;; Failed log-in attempt. (progn (utils:set-alert "Incorrect details provided." "invalid-data") (redirect "/login")) ;; No user found. (progn (utils:set-alert "Can't find that user." "missing-data") (redirect "/login"))))))) (defroute ("/logout" :method :POST) () (destructuring-bind (&key authenticity-token &allow-other-keys) (utils:request-params (lack.request:request-body-parameters ningle:*request*)) (if (not (string= authenticity-token (auth:csrf-token))) `(,+forbidden+ (:content-type "text/plain") ("Denied")) (hermetic:auth (:logged-in) (hermetic:logout ;; Successful log-out. (progn (auth:flash-gethash :id ningle:*session*) (redirect "/")) ;; Failed log-out (progn (utils:set-alert "Error: Unable to log out." "error") (redirect "/"))))))) (defroute ("/dashboard" :method :GET) () (hermetic:auth (:logged-in) ;; Authorised (let ((alert (utils:get-and-reset-alert))) (render #P"user/dashboard.html" (append (auth:auth-user-data) `(:alert ,alert :storage-files ,(nera:latest-storage-editted-files 5 t) :pages ,(nera:latest-editted-pages 5 t) :archive-entries ,(nera::latest-archive-editted-entries 5 t) :disk-info ,(first (diskspace:list-all-disk-info t)) :system-data ,(nera:system-data))))) ;; Not Authorised (progn (utils:set-alert "You are not logged in." "error") (redirect "/login")))) (defroute ("/site-settings" :method :GET) () (hermetic:auth (:administrator) ;; Authorised (render #P"user/site-settings.html" (append (auth:auth-user-data) `(:alert ,(utils:get-and-reset-alert) :pages ,(nera:get-all-pages) :system-data ,(nera:system-data) :site-wide-snippet ,(storage:open-text-file "" "snippets" "site-wide-snippet.html") ;; Should this be replaced by `SYSTEM-DATA'? :settings ,(nera:get-site-settings)))) ;; Not Authorised (progn (utils:set-alert "You are not authorised to view this page." "error") (redirect "/login")))) (defroute ("/site-settings/update-sign-up" :method :POST) () (destructuring-bind (&key enable-sign-up authenticity-token &allow-other-keys) (utils:request-params (lack.request:request-body-parameters ningle:*request*)) (if (not (string= authenticity-token (auth:csrf-token))) `(,+forbidden+ (:content-type "text/plain") ("Denied")) (hermetic:auth (:administrator) ;; Authorised (progn (nera:update-enable-sign-on-settings enable-sign-up) (utils:set-alert "Enable Sign-Up setting updated." "success") (redirect "/site-settings")) ;; Not Authorised (progn (utils:set-alert "You are not authorised to view this page." "error") (redirect "/login")))))) (defroute ("/site-settings/update-nav-menu" :method :POST) (&key _parsed) (destructuring-bind (&key authenticity-token &allow-other-keys) (utils:request-params (lack.request:request-body-parameters ningle:*request*)) (if (not (string= authenticity-token (auth:csrf-token))) `(,+forbidden+ (:content-type "text/plain") ("Denied")) (hermetic:auth (:administrator) ;; Authorised (progn (nera:update-nav-menu (cdr (assoc "NAV-MENU" _parsed :test #'string=))) (utils:set-alert "Nav. menu updated." "success") (redirect "/site-settings")) ;; Not Authorised (progn (utils:set-alert "You are not authorised to view this page." "error") (redirect "/login")))))) (defroute ("/site-settings/update-home-page" :method :POST) () (destructuring-bind (&key set-home-page authenticity-token &allow-other-keys) (utils:request-params (lack.request:request-body-parameters ningle:*request*)) (if (not (string= authenticity-token (auth:csrf-token))) `(,+forbidden+ (:content-type "text/plain") ("Denied")) (hermetic:auth (:administrator) ;; Authorised (cond ((or (string= set-home-page "Select Page") (validation:string-is-nil-or-empty? set-home-page)) (utils:set-alert "No value provided. Home page not changed." "missing-data") (redirect "/site-settings")) (t (nera:set-home-page set-home-page) (utils:set-alert "Home page set." "success") (redirect "/site-settings"))) ;; Not Authorised (progn (utils:set-alert "You are not authorised to view this page." "error") (redirect "/login")))))) (defroute ("/site-settings/update-site-name" :method :POST) () (destructuring-bind (&key site-name authenticity-token &allow-other-keys) (utils:request-params (lack.request:request-body-parameters ningle:*request*)) (if (not (string= authenticity-token (auth:csrf-token))) `(,+forbidden+ (:content-type "text/plain") ("Denied")) (hermetic:auth (:administrator) ;; Authorised (cond ((validation:string-is-nil-or-empty? site-name) (utils:set-alert "No value provided. Site name not changed." "missing-data") (redirect "/site-settings")) (t (nera:update-site-name site-name) (utils:set-alert "Site name updated." "success") (redirect "/site-settings"))) ;; Not Authorised (progn (utils:set-alert "You are not authorised to view this page." "error") (redirect "/login")))))) (defroute ("/site-settings/update-code-snippet" :method :POST) () (destructuring-bind (&key code-snippet authenticity-token &allow-other-keys) (utils:request-params (lack.request:request-body-parameters ningle:*request*)) (if (not (string= authenticity-token (auth:csrf-token))) `(,+forbidden+ (:content-type "text/plain") ("Denied")) (hermetic:auth (:administrator) ;; Authorised (progn (storage:store-text "" "snippets" "site-wide-snippet.html" code-snippet) (utils:set-alert "Site-Wide snippet updated." "success") (redirect "/site-settings")) ;; Not Authorised (progn (utils:set-alert "You are not authorised to view this page." "error") (redirect "/login")))))) (defroute ("/site-settings/update-favicon" :method :POST) () (destructuring-bind (&key favicon-file authenticity-token &allow-other-keys) (utils:request-params (lack.request:request-body-parameters ningle:*request*)) (if (not (string= authenticity-token (auth:csrf-token))) `(,+forbidden+ (:content-type "text/plain") ("Denied")) (hermetic:auth (:administrator) ;; Authorised (cond ((validation:string-is-nil-or-empty? (cadr favicon-file)) (utils:set-alert "No file provided. Favicon not uploaded." "missing-data") (redirect "/site-settings")) ((not (str:contains? "image" (caddr favicon-file) :ignore-case t)) (utils:set-alert "Uploaded file is not an image." "invalid-data") (redirect "/site-settings")) (t (storage:store-with-raw-path "static/images/favicon.png" favicon-file) (utils:set-alert "Favicon saved." "success") (utils:run-bash-command (format nil "convert ~a -resize 192x192\\> ~a" (merge-pathnames #P"static/images/favicon.png" ritherdon-archive.config:*application-root*) (merge-pathnames #P"static/images/favicon.png" ritherdon-archive.config:*application-root*))) (redirect "/site-settings"))) ;; Not Authorised (progn (utils:set-alert "You are not authorised to view this page." "error") (redirect "/login")))))) (defroute ("/site-settings/update-enable-site-logo" :method :POST) () (destructuring-bind (&key enable-site-logo authenticity-token &allow-other-keys) (utils:request-params (lack.request:request-body-parameters ningle:*request*)) (if (not (string= authenticity-token (auth:csrf-token))) `(,+forbidden+ (:content-type "text/plain") ("Denied")) (hermetic:auth (:administrator) ;; Authorised (progn (nera:update-enable-site-logo-setting enable-site-logo) (utils:set-alert "Enable Site Logo setting saved." "success") (redirect "/site-settings")) ;; Not Authorised (progn (utils:set-alert "You are not authorised to view this page." "error") (redirect "/login")))))) (defroute ("/site-settings/update-site-logo" :method :POST) () (destructuring-bind (&key site-logo authenticity-token &allow-other-keys) (utils:request-params (lack.request:request-body-parameters ningle:*request*)) (if (not (string= authenticity-token (auth:csrf-token))) `(,+forbidden+ (:content-type "text/plain") ("Denied")) (hermetic:auth (:administrator) ;; Authorised (cond ((validation:string-is-nil-or-empty? (cadr site-logo)) (utils:set-alert "No file provided. Site logo not uploaded." "missing-data") (redirect "/site-settings")) ((not (str:contains? "image" (caddr site-logo) :ignore-case t)) (utils:set-alert "Uploaded file is not an image." "invalid-data") (redirect "/site-settings")) (t (storage:store-with-raw-path "static/images/site-logo.png" site-logo) (utils:set-alert "Site logo saved." "success") (utils:run-bash-command (format nil "convert ~a -resize 500x500\\> ~a" (merge-pathnames #P"static/images/site-logo.png" ritherdon-archive.config:*application-root*) (merge-pathnames #P"static/images/site-logo.png" ritherdon-archive.config:*application-root*))) (redirect "/site-settings"))) ;; Not Authorised (progn (utils:set-alert "You are not authorised to view this page." "error") (redirect "/login")))))) (defroute ("/users" :method :GET) () (hermetic:auth (:administrator) ;; Authorised (let ((alert (utils:get-and-reset-alert))) (render #P"user/index.html" (append (auth:auth-user-data) `(:alert ,alert :system-data ,(nera:system-data) :users ,(nera:get-all-users))))) ;; Not Authorised (progn (utils:set-alert "You are not authorised to view this page." "error") (redirect "/login")))) (defroute ("/user/admin/create" :method :POST) () (destructuring-bind (&key username display-name password password-check 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"))) ((not (string= password password-check)) (utils:set-alert "Passwords don't match." "invalid-data") (redirect "/users")) ((find t (mapcar #'validation:string-is-nil-or-empty? `(,username ,display-name ,password))) (utils:set-alert "Incomplete form. Please fill out every section." "missing-data") (redirect "/users")) ((not (null (nera:get-user username))) (utils:set-alert "Username already taken." "warning") (redirect "/users")) (t (hermetic:auth (:administrator) ;; Authorised (progn (nera-db:create-user username display-name password +false+) (utils:set-alert "Account created." "created") (redirect "/users")) ;; Not Authorised (progn (utils:set-alert "You are not authorised to view that page." "error") (redirect "/"))))))) (defroute ("/user/edit" :method :GET) () (hermetic:auth (:logged-in) ;; Authorised (let ((alert (utils:get-and-reset-alert))) (render #P"user/edit.html" (append (auth:auth-user-data) `(:alert ,alert :system-data ,(nera:system-data))))) ;; Not Authorised (progn (utils:set-alert "You are not logged in." "error") (redirect "/login")))) (defroute ("/user/edit/display-name" :method :POST) () (destructuring-bind (&key display-name 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 (:logged-in) ;; Authorised (cond ((validation:string-is-nil-or-empty? display-name) (utils:set-alert "Display name not entered." "missing-data") (redirect "/user/edit")) (t (nera-db:update-user (user::username-of (auth:get-current-user)) :display-name display-name :new-password nil) (utils:set-alert "Display name updated." "success") (redirect "/dashboard"))) ;; Not Authorised (progn (utils:set-alert "You are not logged in." "error") (redirect "/login"))))))) (defroute ("/user/edit/password" :method :POST) () (destructuring-bind (&key new-password password-check 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 (:logged-in) ;; Authorised (cond ((find t (mapcar #'validation:string-is-nil-or-empty? `(,new-password ,password-check))) (utils:set-alert "Missing new password data. Make sure both password boxes are filled out." "missing-data") (redirect "/user/edit")) ((not (string= new-password password-check)) (utils:set-alert "Passwords don't match." "invalid-data") (redirect "/user/edit")) (t (nera-db:update-user (user::username-of (auth:get-current-user)) :display-name nil :new-password new-password) (utils:set-alert "Password updated." "success") (redirect "/dashboard"))) ;; Not Authorised (progn (utils:set-alert "You are not logged in." "error") (redirect "/login"))))))) (defroute ("/user/admin/edit-password" :method :POST) () (destructuring-bind (&key username password 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 ((validation:string-is-nil-or-empty? username) (utils:set-alert "Username not provided. No change made." "missing-data") (redirect "/users")) ((validation:string-is-nil-or-empty? password) (utils:set-alert "Password not provided. No change made." "missing-data") (redirect "/users")) ((null (nera:get-user username)) (utils:set-alert "Unable to find user. Unable to delete account" "invalid-data") (redirect "/users")) (t (nera:update-user (user::username-of (nera:get-user username)) :new-password password) (utils:set-alert "Password changed." "success") (redirect "/users"))) ;; Not Authorised (progn (utils:set-alert "You are not authorised to view that page." "error") (redirect "/"))))))) (defroute ("/user/admin/delete" :method :POST) () (destructuring-bind (&key username 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 ((validation:string-is-nil-or-empty? username) (utils:set-alert "Username not provided. Unable to delete account." "missing-data") (redirect "/users")) ((null (nera:get-user username)) (utils:set-alert "Unable to find user. Unable to delete account" "invalid-data") (redirect "/users")) (t (nera:delete-user (user::username-of (nera:get-user username))) (utils:set-alert "Account deleted." "success") (redirect "/users"))) ;; Not Authorised (progn (utils:set-alert "You are not logged in." "error") (redirect "/login"))))))) (defroute ("/user/delete" :method :POST) () (destructuring-bind (&key authenticity-token delete-account-check &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 (:logged-in) ;; Authorised (cond ((validation:string-is-nil-or-empty? delete-account-check) (utils:set-alert "No username entered. Account not deleted." "missing-data") (redirect "/user/edit")) ((not (string= delete-account-check (user::username-of (auth:get-current-user)))) (utils:set-alert "Wrong username entered. Account not deleted." "invalid-data") (redirect "/user/edit")) (t (progn (nera-db:delete-user (user::username-of (auth:get-current-user))) (hermetic:logout ;; Successful log-out -- after account deleted ;; Session data cleared. (progn (auth:flash-gethash :id ningle:*session*) (redirect "/")) ;; Failed log-out -- after account deleted ;; Session data persits. (progn (utils:set-alert "Unable to delete session data." "error") (redirect "/")))))) ;; Not Authorised (progn (utils:set-alert "You are not logged in." "error") (redirect "/login"))))))) (defroute ("/create/page" :method :GET) () (hermetic:auth (:logged-in) ;; Authorised (let ((alert (utils:get-and-reset-alert))) (render "/user/create-page.html" (append (auth:auth-user-data) `(:alert ,alert :system-data ,(nera:system-data))))) ;; Not Authorised (progn (utils:set-alert "You are not logged in." "error") (redirect "/login")))) (defroute ("/create/page" :method :POST) () (destructuring-bind (&key title page-content 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 (:logged-in) ;; Authorised (cond ((validation:string-is-nil-or-empty? title) (render "/user/create-page.html" (append (auth:auth-user-data) `(:alert "Title not provided. Unable to save page." :title ,title :data ,page-content)))) ((storage:file-exists-p "" "pages" (utils:slugify title)) (render "/user/create-page.html" (append (auth:auth-user-data) `(:alert "Page with that title already exists. Unable to save page." :title ,title :data ,page-content)))) (t (storage:store-text "" ; `USERNAME' blank because it's not used/needed. "pages" (utils:slugify title) page-content) (nera:create-page title (utils:slugify title) +false+ +true+) (utils:set-alert "Page created." "created") (redirect "/dashboard"))) ;; Not Authorised (progn (utils:set-alert "You are not logged in." "error") (redirect "/login"))))))) (defroute ("/user/pages" :method :GET) () (hermetic:auth (:logged-in) ;; Authorised (let ((alert (utils:get-and-reset-alert))) (render "/user/pages.html" (append (auth:auth-user-data) `(:alert ,alert :system-data ,(nera:system-data) :pages ,(nera:get-all-pages))))) ;; Not Authorised (progn (utils:set-alert "You are not logged in." "error") (redirect "/login")))) (defroute ("/pages" :method :GET) () (let ((alert (utils:get-and-reset-alert))) (render #P"pages.html" (append (if (hermetic:logged-in-p) (auth:auth-user-data)) `(:alert ,alert :system-data ,(nera:system-data) :pages ,(nera:get-all-pages)))))) (defroute ("/view/page/:slug" :method :GET) (&key slug) (let ((alert (utils:get-and-reset-alert))) (if (storage:file-exists-p "" "pages" slug) (render #P"page.html" (append (if (hermetic:logged-in-p) (auth:auth-user-data)) `(:alert ,alert :db-data ,(nera:get-page slug) :system-data ,(nera:system-data) :data ,(storage:open-text-file "" "pages" slug)))) (on-exception *web* 404)))) (defroute ("/edit/page/:slug" :method :GET) (&key slug) (hermetic:auth (:logged-in) ;; Authorised (let ((alert (utils:get-and-reset-alert))) (render "/user/edit-page.html" (append (auth:auth-user-data) `(:alert ,alert :system-data ,(nera:system-data) :db-data ,(nera:get-page slug) :data ,(storage:open-text-file "" "pages" slug))))) ;; Not Authorised (progn (utils:set-alert "You are not logged in." "error") (redirect "/login")))) (defroute ("/edit/page" :method :POST) () (destructuring-bind (&key slug page-content 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 (:logged-in) ;; Authorised (cond ((validation:string-is-nil-or-empty? slug) (utils:set-alert "Page cannot be found." "missing-data") (redirect "/user/pages")) (t (storage:store-text "" ; `USERNAME' blank because it's not used/needed. "pages" slug page-content) (utils:set-alert "Page updated." "success") (redirect "/user/pages"))) ;; Not Authorised (progn (utils:set-alert "You are not logged in." "error") (redirect "/login"))))))) (defroute ("/rename/page" :method :POST) () (destructuring-bind (&key id slug new-title 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 (:logged-in) ;; Authorised (cond ((validation:string-is-nil-or-empty? slug) (utils:set-alert "Cannot find file. Unable to save changes." "missing-data") (redirect "/user/pages")) ((validation:string-is-nil-or-empty? new-title) (utils:set-alert "No title provided. Unable to save changes." "missing-data") (redirect (format nil "/edit/page/~a" slug))) ((validation:string-is-nil-or-empty? id) (utils:set-alert "No Id. found. Cannot find page in database." "missing-data") (redirect "/user/pages")) (t (storage:rename-content-file "" "pages" slug (utils:slugify new-title)) (nera:update-page id new-title (utils:slugify new-title)) (utils:set-alert "File name changed." "success") (redirect (format nil "/edit/page/~a" (utils:slugify new-title))))) ;; Not Authorised (progn (utils:set-alert "You are not logged in." "error") (redirect "/login"))))))) (defroute ("/page/set-nav-menu" :method :POST) () (destructuring-bind (&key slug show-in-nav 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 (:logged-in) ;; Authorised (cond ((validation:string-is-nil-or-empty? slug) (utils:set-alert "Cannot find page in database." "missing-data") (redirect "/user/pages")) (t (nera:update-single-nav-menu-item slug (if (null show-in-nav) +false+ +true+)) (utils:set-alert "Update nav. menu settings." "success") (redirect (format nil "/edit/page/~a" slug)))) ;; Not Authorised (progn (utils:set-alert "You are not logged in." "error") (redirect "/login"))))))) (defroute ("/page/delete" :method :POST) () (destructuring-bind (&key slug 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 ((validation:string-is-nil-or-empty? slug) (utils:set-alert "Cannot find page in database. Nothing deleted." "missing-data") (redirect "/user/pages")) ((null (storage:file-exists-p "" "pages" slug)) (utils:set-alert "Unable to find page. Nothing deleted." "missing-data") (redirect "/user/pages")) ((eql (pages::can-delete-p (nera:get-page slug)) +false+) (utils:set-alert "File not allowed to be deleted." "warning") (redirect "/user/pages")) (t (storage:remove-file "" ; `USERNAME' blank because it's not used/needed. "pages" slug) (nera:delete-page :slug slug) (utils:set-alert "Page deleted." "success") (redirect "/user/pages"))) ;; Not Authorised (progn (utils:set-alert "You are not authorised to delete page." "warning") (redirect "/login"))))))) (defroute ("/storage/view/media/:slug" :method :GET) (&key slug) (if (nera:get-storage-file :slug slug) `(200 (:content-type ,(files::file-type-of (nera:get-storage-file :slug slug))) ,(storage:open-binary-file "" "media" (files::name-of (nera:get-storage-file :slug slug)))) (on-exception *web* 404))) (defroute ("/storage/thumb/media/:slug" :method :GET) (&key slug) (let ((storage-file (nera:get-storage-file :slug slug))) (if storage-file `(200 (:content-type ,(files::file-type-of storage-file)) ,(storage:open-binary-file "" "media" (format nil "thumbnail-~a" (files::name-of storage-file)))) (on-exception *web* 404)))) (defroute ("/storage/thumb/archive/:slug" :method :GET) (&key slug) (if (nera:get-archive-entry :slug slug) (let ((archive-entry (nera:get-archive-entry :slug slug))) `(200 (:content-type ,(archive::thumbnail-file-type-of archive-entry)) ,(storage:open-binary-file "" "archive" (archive::thumbnail-slug-of archive-entry)))) (on-exception *web* 404))) (defroute ("/storage/manage" :method :GET) () (hermetic:auth (:logged-in) ;; Authorised (let ((alert (utils:get-and-reset-alert))) (render #P"/user/storage.html" (append (auth:auth-user-data) `(:alert ,alert :files ,(nera:get-all-storage-files) :system-data ,(nera:system-data))))) ;; Not Authorised (progn (utils:set-alert "You are not logged in." "error") (redirect "/login")))) (defroute ("/storage/multi-upload" :method :POST) () (destructuring-bind (&key authenticity-token &allow-other-keys) (utils:request-params (lack.request:request-body-parameters ningle:*request*)) (if (not (string= authenticity-token (auth:csrf-token))) `(,+forbidden+ (:content-type "text/plain") ("Denied")) (let ((files (utils:separate-files-in-web-request (lack.request:request-body-parameters ningle:*request*) "STORAGE-FILES"))) (hermetic:auth (:logged-in) ;; Authorised (cond ((validation:string-is-nil-or-empty? (caddr (car files))) (utils:set-alert "No files provided." "missing-data") (redirect "/storage/manage")) (t (loop :for item :in files :do (storage:store-file "" "media" (utils:format-filename (caddr item)) (cdr item)) (nera:add-storage-file (utils:format-filename (caddr item)) (utils:slugify (caddr item)) (cadddr item)) ;; Thumbnail not stored in the database. It ;; is a hard-coded utility feature of the ;; website. The thumbnail is created so ;; large-scale images are not used at the ;; thumbnail, decreasing download sizes. (when (str:contains? "image" (cadddr item) :ignore-case t) (utils:create-thumbnail "media" (utils:format-filename (caddr item)) nil))) (utils:set-alert "File upload complete." "success") (redirect "/storage/manage"))) ;; Not Authorised (progn (utils:set-alert "You are not authorised to view this page." "error") (redirect "/login"))))))) (defroute ("/storage/rename/:slug" :method :POST) (&key slug) (destructuring-bind (&key new-file-name authenticity-token &allow-other-keys) (utils:request-params (lack.request:request-body-parameters ningle:*request*)) (if (not (string= authenticity-token (auth:csrf-token))) `(,+forbidden+ (:content-type "text/plain") ("Denied")) (hermetic:auth (:logged-in) ;; Authorised (cond ((validation:string-is-nil-or-empty? new-file-name) (utils:set-alert "No file name provided. Nothing updated." "missing-data") (redirect "/storage/manage")) ((not (null (nera:get-storage-file :filename new-file-name))) (utils:set-alert "File with that name already exists. File not saved." "invalid-data") (redirect "/storage/manage")) (t (storage:rename-content-file "" "media" (files::name-of (nera:get-storage-file :slug slug)) new-file-name) (when (storage:file-exists-p "" "media" (format nil "thumbnail-~a" (files::name-of (nera:get-storage-file :slug slug)))) (storage:rename-content-file "" "media" (format nil "thumbnail-~a" (files::name-of (nera:get-storage-file :slug slug))) (format nil "thumbnail-~a" new-file-name))) (nera:rename-storage-file (files::name-of (nera:get-storage-file :slug slug)) new-file-name) (utils:set-alert "File renamed." "success") (redirect "/storage/manage"))) ;; Not Authorised (progn (utils:set-alert "You are not authorised to view this page." "error") (redirect "/login")))))) (defroute ("/storage/delete/:slug" :method :POST) (&key slug) (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 ((null (nera:get-storage-file :slug slug)) (utils:set-alert "Unable to find file. Nothing deleted." "missing-data") (redirect "/storage/manage")) (t (storage:remove-file "" "media" (files::name-of (nera:get-storage-file :slug slug))) (when (storage:file-exists-p "" "media" (format nil "thumbnail-~a" (files::name-of (nera:get-storage-file :slug slug)))) (storage:remove-file "" "media" (format nil "thumbnail-~a" (files::name-of (nera:get-storage-file :slug slug))))) (nera:delete-storage-file :slug slug) (utils:set-alert "File deleted." "success") (redirect "/storage/manage"))) ;; Not Authorised (progn (utils:set-alert "You are not authorised to delete page." "error") (redirect "/login"))))))) (defroute ("/archive" :method :GET) () (let ((alert (utils:get-and-reset-alert))) (render #P"archive.html" (append (if (hermetic:logged-in-p) (auth:auth-user-data)) `(:alert ,alert :system-data ,(nera:system-data) :archive-entries ,(nera:get-all-archive-entries)))))) (defroute ("/view/archive/:slug" :method :GET) (&key slug) (let ((alert (utils:get-and-reset-alert))) (if (storage:file-exists-p "" "archive" slug) (let* ((archive-entry (nera:get-archive-entry :slug slug)) (archive-id (archive::object-id archive-entry))) (render #P"archive-entry.html" (append (if (hermetic:logged-in-p) (auth:auth-user-data)) `(:alert ,alert :db-data ,archive-entry :system-data ,(nera:system-data) :newer-entries ,(nera:get-newer-archive-entries archive-id 2) :older-entries ,(nera:get-older-archive-entries archive-id 2) :data ,(storage:open-text-file "" "archive" slug))))) (on-exception *web* 404)))) (defroute ("/user/archive" :method :GET) () (hermetic:auth (:logged-in) ;; Authorised (let ((alert (utils:get-and-reset-alert))) (render "/user/archive.html" (append (auth:auth-user-data) `(:alert ,alert :system-data ,(nera:system-data) :archive-entries ,(nera:get-all-archive-entries))))) ;; Not Authorised (progn (utils:set-alert "You are not logged in." "error") (redirect "/login")))) (defroute ("/create/archive-entry" :method :GET) () (hermetic:auth (:logged-in) ;; Authorised (let ((alert (utils:get-and-reset-alert))) (render "/user/create-archive.html" (append (auth:auth-user-data) `(:alert ,alert :system-data ,(nera:system-data))))) ;; Not Authorised (progn (utils:set-alert "You are not logged in." "error") (redirect "/login")))) (defroute ("/create/archive-entry" :method :POST) () (destructuring-bind (&key title month year keywords thumbnail-file page-content 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 (:logged-in) ;; Authorised (cond ((find t (mapcar #'validation:string-is-nil-or-empty? `(,title ,month ,year))) (render "/user/create-archive.html" (append (auth:auth-user-data) `(:alert ,(utils:build-alert-string "missing-data" "sherlock-cat.png" "Data is missing. Unable to create entry.") :title ,title :month ,month :year ,year :keywords ,keywords :data ,page-content)))) ((not (null (nera:get-archive-entry :title title))) (render "/user/create-archive.html" (append (auth:auth-user-data) `(:alert ,(utils:build-alert-string "invalid-data" "confused-cat.png" "Entry with that title already exists. Unable to create entry.") :title ,title :month ,month :year ,year :keywords ,keywords :data ,page-content)))) ((not (str:contains? "image" (caddr thumbnail-file) :ignore-case t)) (render "/user/create-archive.html" (append (auth:auth-user-data) `(:alert ,(utils:build-alert-string "invalid-data" "confused-cat.png" "File uploaded is not an image. Entry not created.") :title ,title :month ,month :year ,year :keywords ,keywords :data ,page-content)))) (t (let ((search-id (utils:create-timestamp-id))) ;; Database Entry (nera:create-archive-entry title search-id (format nil "~a.html" (utils:slugify title)) month year (utils:format-filename (cadr thumbnail-file)) ; File Name (caddr thumbnail-file) ; File Type (utils:format-keywords keywords)) ;; Use placeholder thumbnail if one not detected? ;; Meilisearch Database Entry (search:submit-entry (search:build-payload search-id title (format nil "view/archive/~a.html" (utils:slugify title)) (format nil "storage/thumb/archive/~a.html" (utils:slugify title)) month year (utils:format-keywords keywords))) ;; Storage File Entry (storage:store-text "" "archive" (format nil "~a.html" (utils:slugify title)) page-content) (storage:store-file "" "archive" (utils:format-filename (cadr thumbnail-file)) thumbnail-file) (utils:create-thumbnail ; Overwrites the original here. "archive" (utils:format-filename (cadr thumbnail-file)) t) (utils:set-alert "Archive entry created. Great Success!" "created") (redirect "/dashboard")))) ;; Not Authorised (progn (utils:set-alert "You are not logged in." "error") (redirect "/login"))))))) (defroute ("/edit/archive/:slug" :method :GET) (&key slug) (if (nera:get-archive-entry :slug slug) (progn (hermetic:auth (:logged-in) ;; Authorised (let ((alert (utils:get-and-reset-alert))) (render "/user/edit-archive.html" (append (auth:auth-user-data) `(:alert ,alert :system-data ,(nera:system-data) :db-data ,(nera:get-archive-entry :slug slug) :data ,(storage:open-text-file "" "archive" slug))))) ;; Not Authorised (progn (utils:set-alert "You are not logged in." "error") (redirect "/login")))) (on-exception *web* 404))) (defroute ("/edit/archive-thumbnail" :method :POST) () (destructuring-bind (&key archive-slug thumbnail-file 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 ((validation:string-is-nil-or-empty? archive-slug) (utils:set-alert "No archive slug provided. Thumbnail not updated." "missing-data") (redirect "/user/archive")) ((null (nera:get-archive-entry :slug archive-slug)) (utils:set-alert "Cannot file thumbnail's archive entry. Nothing updated." "missing-data") (redirect "/user/archive")) ((not (str:contains? "image" (caddr thumbnail-file) :ignore-case t)) (utils:set-alert "File uploaded is not an image. Thumbnail not updated." "invalid-data") (redirect (format nil "/edit/archive/~a" archive-slug))) (t (let ((archive-entry (nera:get-archive-entry :slug archive-slug))) (storage:remove-file "" "archive" (archive::thumbnail-slug-of archive-entry)) (storage:store-file "" "archive" (cadr thumbnail-file) thumbnail-file) (nera:update-archive-entry-property :slug archive-slug :property 'archive::thumbnail-file-type-of :value (caddr thumbnail-file)) (nera:update-archive-entry-property :slug archive-slug :property 'archive::thumbnail-slug-of :value (cadr thumbnail-file)) (utils:create-thumbnail "archive" (archive::thumbnail-slug-of archive-entry) t) ;; Meilisearch DB doesn't need updating because nothing ;; has changed from its perspective. (utils:set-alert "Thumbnail updated." "success") (redirect (format nil "/edit/archive/~a" archive-slug))))) ;; Not Authorised (progn (utils:set-alert "You are not authorised to delete this archive entry." "error") (redirect "/login"))))))) (defroute ("/rename/archive-entry" :method :POST) () (destructuring-bind (&key id archive-slug new-title 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 #'validation:string-is-nil-or-empty? `(,id ,archive-slug ,new-title))) (utils:set-alert "Title and meta-data not provided. Archive entry not renamed." "missing-data") (redirect "/user/archive")) ((null (nera:get-archive-entry :slug archive-slug)) (utils:set-alert "Cannot file archive entry. Archive entry not updated." "invalid-data") (redirect "/user/archive")) (t (let ((archive-entry (nera:get-archive-entry :id (parse-integer id)))) (storage:rename-content-file "" "archive" (archive::slug-of archive-entry) (utils:format-filename (format nil "~a.html" new-title))) (nera:update-archive-entry-property :slug archive-slug :property 'archive::title-of :value new-title) (nera:update-archive-entry-property :slug archive-slug :property 'archive::slug-of :value (utils:format-filename (format nil "~a.html" new-title))) (search:submit-entry (search:build-payload (archive::search-id-of archive-entry) new-title (format nil "view/archive/~a.html" (utils:slugify new-title)) (format nil "storage/thumb/archive/~a.html" (utils:slugify new-title)) (archive::month-of archive-entry) (archive::year-of archive-entry) (archive::keywords-of archive-entry))) (utils:set-alert "Archive entry updated." "success") (redirect (format nil "/edit/archive/~a" (utils:format-filename (format nil "~a.html" new-title))))))) ;; Not Authorised (progn (utils:set-alert "You are not authorised to delete this archive entry." "error") (redirect "/login"))))))) (defroute ("/edit/archive-publish-date" :method :POST) () (destructuring-bind (&key archive-slug authenticity-token month year &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 #'validation:string-is-nil-or-empty? `(,archive-slug ,month ,year))) (utils:set-alert "Full date not provided. Not updated." "missing-data") (redirect "/user/archive")) ((null (nera:get-archive-entry :slug archive-slug)) (utils:set-alert "Cannot file archive entry. Keywords not updated." "invalid-data") (redirect "/user/archive")) (t (let ((archive-entry (nera:get-archive-entry :slug archive-slug))) (nera:update-archive-entry-property :slug archive-slug :property 'archive::month-of :value month) (nera:update-archive-entry-property :slug archive-slug :property 'archive::year-of :value year) (search:submit-entry (search:build-payload (archive::search-id-of archive-entry) (archive::title-of archive-entry) (format nil "view/archive/~a" (archive::slug-of archive-entry)) (format nil "storage/thumb/archive/~a" (archive::slug-of archive-entry)) month year (archive::keywords-of archive-entry))) (utils:set-alert "Archive entry updated." "success") (redirect (format nil "/edit/archive/~a" archive-slug))))) ;; Not Authorised (progn (utils:set-alert "You are not authorised to delete this archive entry." "error") (redirect "/login"))))))) (defroute ("/edit/archive-keywords" :method :POST) () (destructuring-bind (&key archive-slug new-keywords 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 #'validation:string-is-nil-or-empty? `(,archive-slug ,new-keywords))) (utils:set-alert "Keywords not provided. Not updated." "missing-data") (redirect "/user/archive")) ((null (nera:get-archive-entry :slug archive-slug)) (utils:set-alert "Cannot file archive entry. Keywords not updated." "invalid-data") (redirect "/user/archive")) (t (let ((archive-entry (nera:get-archive-entry :slug archive-slug)) (keywords (utils:format-keywords new-keywords))) (nera:update-archive-entry-property :slug archive-slug :property 'archive::keywords-of :value keywords) (search:submit-entry (search:build-payload (archive::search-id-of archive-entry) (archive::title-of archive-entry) (format nil "view/archive/~a" (archive::slug-of archive-entry)) (format nil "storage/thumb/archive/~a" (archive::slug-of archive-entry)) (archive::month-of archive-entry) (archive::year-of archive-entry) keywords)) (utils:set-alert "Archive entry updated." "success") (redirect (format nil "/edit/archive/~a" archive-slug))))) ;; Not Authorised (progn (utils:set-alert "You are not authorised to delete this archive entry." "error") (redirect "/login"))))))) (defroute ("/edit/archive" :method :POST) () (destructuring-bind (&key slug page-content 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 (:logged-in) ;; Authorised (cond ((validation:string-is-nil-or-empty? slug) (utils:set-alert "Archive entry cannot be found." "missing-data") (redirect "/user/archive")) (t (storage:store-text "" "archive" slug page-content) ;; Meilisearch integration not needed here because ;; nothing has changed from the Meilisearch DB ;; perspective. (utils:set-alert "Archive entry updated." "success") (redirect (format nil "/edit/archive/~a" slug)))) ;; Not Authorised (progn (utils:set-alert "You are not logged in." "error") (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*)) (cond ((not (string= authenticity-token (auth:csrf-token))) `(,+forbidden+ (:content-type "text/plain") ("Denied"))) (t (hermetic:auth (:administrator) ;; Authorised (cond ((validation:string-is-nil-or-empty? slug) (utils:set-alert "Cannot find archive entry in database. Nothing deleted." "missing-data") (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." "invalid-data") (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." "invalid-data") (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." "invalid-data") ;; The system doesn't know about the thumbnail at this ;; point 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))) (search:delete-entry (archive::search-id-of (nera:get-archive-entry :slug slug))) (nera:delete-archive-entry :slug slug) (utils:set-alert "Archive entry deleted." "success") (redirect "/user/archive"))) ;; Not Authorised (progn (utils:set-alert "You are not authorised to delete this archive entry." "error") (redirect "/login"))))))) (defroute ("/search" :method :GET) () (render #P"search.html" (append (if (hermetic:logged-in-p) (auth:auth-user-data)) `(:alert ,(utils:get-and-reset-alert) :nav-menu ,(nera:nav-menu-slugs) :system-data ,(nera:system-data))))) (defroute ("/sitemap" :method :GET) () (redirect "/sitemap.xml")) (defroute ("/sitemap.xml" :method :GET) () (setf (getf (response-headers *response*) :content-type) "application/xml") (with-output-to-string (stream) (let ((pages (nera:get-all-pages)) (entries (nera:get-all-archive-entries)) (root-url (utils:build-url-root ningle:*request*))) (xml-emitter:with-xml-output (stream :encoding "utf-8") (xml-emitter:with-simple-tag ("urlset" nil "http://www.sitemaps.org/schemas/sitemap/0.9") ;; Lists all the pages first. ;; The 'unless' block is to remove pages which are not wanting to be ;; part of a search engine's crawler results. (loop for item in pages do (unless (or (string= "sign-up" (pages::slug-of item)) (string= "login" (pages::slug-of item))) (xml-emitter:with-tag ("url") (xml-emitter:emit-simple-tags :loc (format nil "~a/view/page/~a" root-url (pages::slug-of item)) :lastmod (format nil "~a" (mito.dao.mixin:object-updated-at item)))))) ;; Lists all the archive entries second. (loop for item in entries do (xml-emitter:with-tag ("url") (xml-emitter:emit-simple-tags :loc (format nil "~a/view/archive/~a" root-url (archive::slug-of item)) :lastmod (format nil "~a" (mito.dao.mixin:object-updated-at item)))))))))) (defroute ("/danger/manage-files" :method :GET) () (hermetic:auth (:logged-in) ;; Authorised (let ((alert (utils:get-and-reset-alert))) (render "/danger/manage-files.html" (append (auth:auth-user-data) `(:alert ,alert :system-data ,(nera:system-data) :archive-files ,(storage:get-file-names (storage:get-files-in-directory "" "archive")) :media-files ,(storage:get-file-names (storage:get-files-in-directory "" "media")) :pages-files ,(storage:get-file-names (storage:get-files-in-directory "" "pages")))))) ;; Not Authorised (progn (utils:set-alert "You are not authorised to view this page." "error") (redirect "/login")))) (defroute ("/danger/delete-file" :method :POST) () (destructuring-bind (&key filename directory 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 #'validation:string-is-nil-or-empty? `(,filename ,directory))) (utils:set-alert "File name or directory not provided." "missing-data") (redirect "/danger/manage-files")) ((not (storage:file-exists-p "" directory filename)) (utils:set-alert "File cannot be found." "invalid-data") (redirect "/danger/manage-files")) (t (storage:file-exists-p "" directory filename) (storage:remove-file "" directory filename) (utils:set-alert "File deleted." "success") (redirect "/danger/manage-files"))) ;; Not Authorised (progn (utils:set-alert "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 #'validation: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) (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 (progn (search:repopulate-database (nera:get-all-archive-entries)) (utils:set-alert "Search database re-populated. Great Success!" "success") (redirect "/site-settings")) ;; Not Authorised (progn (utils:set-alert "You are not authorised to use this feature." "error") (redirect "/login"))))))) (defroute ("/danger/reset-website" :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 (progn ;; The 'when' checks are just a precaution. These directories ;; were created during the site's first-run/initial set-up. If ;; they are missing, though, whilst this function is executing, ;; an error is thrown -- hence the check. (when (storage:directory-exists-p "" "media") (storage:remove-directory "" "media")) (when (storage:directory-exists-p "" "archive") (storage:remove-directory "" "archive")) (when (storage:directory-exists-p "" "pages") (storage:remove-directory "" "pages")) (when (storage:directory-exists-p "" "snippets") (storage:remove-directory "" "snippets")) ;; If the database doesn't exist, the site is in a much worse ;; state than anticipated and needs someone to SSH into the host ;; and look at it -- hence no 'when' check. (storage:remove-file-with-raw-path (ritherdon-archive.config:database-name)) ;; If Meilisearch service is down, you need to SSH into ;; host. That is a separate service which this website utilises ;; but doesn't control. (search:delete-all-entries) (redirect "/")) ;; Not Authorised (progn (utils:set-alert "You are not authorised to use this feature." "error") (redirect "/login"))))))) (defroute ("/danger/manage-snapshots" :method :GET) () (hermetic:auth (:logged-in) ;; Authorised (let ((alert (utils:get-and-reset-alert))) (render "/danger/snapshots.html" (append (auth:auth-user-data) `(:alert ,alert :system-data ,(nera:system-data) :snapshots ,(reverse (storage::get-directory-names (storage::get-raw-directories "snapshots/"))))))) ;; Not Authorised (progn (utils:set-alert "You are not authorised to view this page." "error") (redirect "/login")))) (defroute ("/danger/take-snapshot" :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 (progn (snapshot:take-snapshot) (utils:set-alert "Snapshot taken." "success") (redirect "/danger/manage-snapshots")) ;; Not Authorised (progn (utils:set-alert "You are not authorised to delete page." "error") (redirect "/login"))))))) (defroute ("/danger/delete-snapshot" :method :POST) () (destructuring-bind (&key snapshot-name 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 ((validation::string-is-nil-or-empty? snapshot-name) (utils:set-alert "No Snapshot Name provided." "missing-data") (redirect "/danger/manage-snapshots")) ;; Check snapshot exists here... (t ;; (snapshot:delete-snapshot) (utils:set-alert "Snapshot deleted." "success") (redirect "/danger/manage-snapshots"))) ;; Not Authorised (progn (utils:set-alert "You are not authorised to delete page." "error") (redirect "/login"))))))) ;; ;; Error pages (defmethod on-exception ((app ) (code (eql 404))) (declare (ignore app)) (merge-pathnames #P"_errors/404.html" *template-directory*))