implement back-end for take-snapshot feature (web.lisp).

src/web.lisp

@@ -17,7 +17,8 @@
 	#:user
 	#:nera-db
 	#:files
-        #:search)
+        #:search
+        #:snapshot)
   (:export #:*web*))
 (in-package #:ritherdon-archive.web)
 
@@ -1655,6 +1656,40 @@
 		      "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)
+		       ;; Snapshot data goes here...
+                       ))))
+  ;; 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")))))))
+
 ;;
 ;; Error pages