Public archive for the Return to Ritherdon project.
https://www.nicolaellisandritherdon.com
You can not select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
1860 lines
74 KiB
1860 lines
74 KiB
(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 |
|
#:zip |
|
#:nera-db |
|
#:files |
|
#:search |
|
#:snapshot) |
|
(:export #:*web*)) |
|
(in-package #:ritherdon-archive.web) |
|
|
|
;; for @route annotation |
|
(syntax:use-syntax :annot) |
|
|
|
;; |
|
;; Application |
|
|
|
(defclass <web> (<app>) ()) |
|
(defvar *web* (make-instance '<web>)) |
|
(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 ("/site-settings/update-search-url" :method :POST) () |
|
(destructuring-bind |
|
(&key search-url 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? search-url) |
|
(utils:set-alert "No Search URL provided." "missing-data") |
|
(redirect "/site-settings")) |
|
(t (nera:update-search-url search-url) |
|
(utils:set-alert "Search URL updated." "success") |
|
(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 |
|
(:administrator) |
|
;; 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 |
|
(:administrator) |
|
;; 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")) |
|
((not (storage:raw-directory-exists? |
|
(format nil "snapshots/~a/" snapshot-name))) |
|
(utils:set-alert "Cannot find selected Snapshot." "invalid-data") |
|
(redirect "/danger/manage-snapshots")) |
|
(t (snapshot:delete-snapshot snapshot-name) |
|
(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"))))))) |
|
|
|
|
|
(defroute ("/danger/create-snapshot-download" :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")) |
|
((not (storage:raw-directory-exists? |
|
(format nil "snapshots/~a/" snapshot-name))) |
|
(utils:set-alert "Cannot find selected Snapshot." "invalid-data") |
|
(redirect "/danger/manage-snapshots")) |
|
((storage:file-exists-p |
|
"" "media" (format nil "~a.zip" snapshot-name)) |
|
(utils:set-alert |
|
"Snapshot already prepared and moved to Storage Files" |
|
"invalid-data") |
|
(redirect "/danger/manage-snapshots")) |
|
(t (zip:zip |
|
(storage:make-path |
|
"" "media" (format nil "~a.zip"snapshot-name)) |
|
(storage:make-raw-path |
|
(format nil "snapshots/~a/" snapshot-name))) |
|
(nera:add-storage-file |
|
(format nil "~a.zip"snapshot-name) |
|
(format nil "~a-zip"snapshot-name) |
|
"application/zip") |
|
(utils:set-alert "Snapshot ready for download." "success") |
|
(redirect "/danger/manage-snapshots"))) |
|
;; Not Authorised |
|
(progn (utils:set-alert |
|
"You are not authorised to delete page." "error") |
|
(redirect "/login"))))))) |
|
|
|
(defroute ("/danger/restore-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")) |
|
((not (storage:raw-directory-exists? |
|
(format nil "snapshots/~a/" snapshot-name))) |
|
(utils:set-alert "Cannot find selected Snapshot." |
|
"invalid-data") |
|
(redirect "/danger/manage-snapshots")) |
|
(t (snapshot:restore-from-snapshot snapshot-name) |
|
(if (str:contains? |
|
"://localhost:" (utils:build-url-root ningle:*request*)) |
|
(utils:set-alert |
|
"Snapshot restored. Restart local server for changes to take effect." |
|
"success") |
|
(progn |
|
(utils:set-alert |
|
"Snapshot restored restarting server. FEATURE NOT IMPLEMENTED YET..." |
|
"success") |
|
;; TODO: WRITE SCRIPT TO RESTART SYSTEMD SERVICE. |
|
;; utils:run-bash-command "Restart Systemd Service" |
|
(format |
|
t "[INFO] Restarting Systemd service is not yet implemented."))) |
|
(redirect "/danger/manage-snapshots"))) |
|
;; Not Authorised |
|
(progn (utils:set-alert |
|
"You are not authorised to delete page." "error") |
|
(redirect "/login"))))))) |
|
|
|
(defroute ("/danger/upload-snapshot" :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*) |
|
"SNAPSHOT-FILES"))) |
|
(hermetic:auth |
|
(:administrator) |
|
;; Authorised |
|
(cond ((validation:string-is-nil-or-empty? (caddr (car files))) |
|
(utils:set-alert "No Snapshots provided." "missing-data") |
|
(redirect "/danger/manage-snapshots")) |
|
(t (loop |
|
:for item :in files |
|
:do (when (and (not (storage:raw-directory-exists? |
|
(storage:make-raw-path |
|
(format |
|
nil "snapshots/~a/" |
|
(pathname-name (caddr item)))))) |
|
(string= "zip" (pathname-type (caddr item)))) |
|
(snapshot:store-snapshot |
|
(utils:format-filename (caddr item)) (cdr item)))) |
|
(utils:set-alert "Snapshot upload complete." "success") |
|
(redirect "/danger/manage-snapshots"))) |
|
;; Not Authorised |
|
(progn |
|
(utils:set-alert "You are not authorised to view this page." |
|
"error") |
|
(redirect "/login"))))))) |
|
|
|
;; |
|
;; Error pages |
|
|
|
(defmethod on-exception ((app <web>) (code (eql 404))) |
|
(declare (ignore app)) |
|
(merge-pathnames #P"_errors/404.html" |
|
*template-directory*))
|
|
|