|
|
|
(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)
|
|
|
|
(: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
|
|
|
|
#'utils: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)
|
|
|
|
: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")
|
|
|
|
(utils: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 ((utils: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 ((utils: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 ((utils: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
|
|
|
|
#'utils: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 ((utils: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
|
|
|
|
#'utils: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 ((utils:string-is-nil-or-empty? username)
|
|
|
|
(utils:set-alert "Username not provided. No change made."
|
|
|
|
"missing-data")
|
|
|
|
(redirect "/users"))
|
|
|
|
((utils: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 ((utils: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 ((utils: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 ((utils: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 ((utils: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 ((utils:string-is-nil-or-empty? slug)
|
|
|
|
(utils:set-alert "Cannot find file. Unable to save changes."
|
|
|
|
"missing-data")
|
|
|
|
(redirect "/user/pages"))
|
|
|
|
|
|
|
|
((utils: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)))
|
|
|
|
|
|
|
|
((utils: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 ((utils: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 ((utils: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 ((utils: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 (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 ((utils: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)
|
|
|
|
(render #P"archive-entry.html"
|
|
|
|
(append (if (hermetic:logged-in-p)
|
|
|
|
(auth:auth-user-data))
|
|
|
|
`(:alert ,alert
|
|
|
|
:db-data ,(nera:get-archive-entry :slug slug)
|
|
|
|
:system-data ,(nera:system-data)
|
|
|
|
: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 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 #'utils:string-is-nil-or-empty? `(,title ,keywords)))
|
|
|
|
(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
|
|
|
|
: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
|
|
|
|
: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
|
|
|
|
: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))
|
|
|
|
(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))
|
|
|
|
(local-time:now)
|
|
|
|
(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 ((utils: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 #'utils: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))
|
|
|
|
(mito.dao.mixin:object-created-at 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-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 #'utils: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))
|
|
|
|
(mito.dao.mixin:object-created-at 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 ((utils: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 ((utils: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 thumbnail in not know about here 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)))))
|
|
|
|
;;
|
|
|
|
;; Error pages
|
|
|
|
|
|
|
|
(defmethod on-exception ((app <web>) (code (eql 404)))
|
|
|
|
(declare (ignore app))
|
|
|
|
(merge-pathnames #P"_errors/404.html"
|
|
|
|
*template-directory*))
|