Browse Source

implement various 'raw' based functions in storage package.

The most notable ones are the 'copy' functions. The main intention here is to
provide the functionality needed by the snapshot package to help it take
programmatic snapshots of the website's data and database. At the time of
writing the 'restore from snapshot' functionality has not been implemented but
that is something these 'copy' functions will look to help with.
stable
Craig Oates 1 year ago
parent
commit
f629e3d750
  1. 43
      src/storage.lisp

43
src/storage.lisp

@ -1,6 +1,7 @@
(in-package #:cl-user)
(defpackage #:storage
(:use #:cl)
(:use #:cl
#:copy-directory)
(:export #:init-storage
#:directory-exists-p
#:ensure-directory-exists
@ -21,7 +22,12 @@
#:store-text-with-raw-path
#:open-text-file-with-raw-path
#:store-test
#:remove-file-with-raw-path))
#:remove-file-with-raw-path
#:make-raw-path
#:ensure-raw-directory-exists
#:remove-raw-directory
#:copy-storage-directory
#:copy-raw-directory))
(in-package #:storage)
(defun init-storage ()
@ -47,7 +53,19 @@ This is used as part of the /run-set defroute in web.lisp file."
(uiop:copy-file (make-path "" "default-assets" "site-wide-snippet.html")
(make-path "" "snippets" "site-wide-snippet.html"))
;; Nothing is added to /storage/media yet, this is just prep. work.
(ensure-directory-exists "" "media"))
(ensure-directory-exists "" "media")
(ensure-raw-directory-exists "snapshots/"))
(defun copy-storage-directory (target-path)
"Copies the contents of /storage directory to `TARGET-PATH'.
Make sure `TARGET-PATH' ends with a slash (E.G. snapshots/oct-2022/). Without
it, the system will assume you're trying to work with a file and throw an
error."
(copy-directory:copy (make-raw-path "storage/") (make-raw-path target-path)))
(defun copy-raw-directory (source-path target-path)
"Copies a directory (`SOURCE-PATH') outside of /storage to `TARGET-PATH'."
(copy-directory:copy (make-raw-path source-path) (make-raw-path target-path)))
(defun directory-exists-p (username directory)
"Checks to see if the specified diretory exists.
@ -55,6 +73,12 @@ The directories path is returned if it does exist and `NIL' is
returned if the directory cannot be found."
(cl:probe-file (make-path username directory "")))
(defun ensure-raw-directory-exists (directory-path)
"Creates directory if it doesn't exist (use for working outside of /storage).
The directories path is returned if it does exist and `NIL' is returned if the
directory cannot be found."
(ensure-directories-exist (make-raw-path directory-path)))
(defun ensure-directory-exists (username directory)
"The project's standardised way to call `ENSURE-DIRECTORY-EXISTS'.
If the directory exists, the full (absolute) path is
@ -90,7 +114,12 @@ not (user-)`ID' is because I wanted to easily identify the directories in
/storage."
(merge-pathnames (format nil "storage/~A/~A/~A"
username subdirectory slug)
ritherdon-archive.config::*application-root*))
ritherdon-archive.config:*application-root*))
(defun make-raw-path (path)
"Make a file/directory path outsite of the /storage directory."
(merge-pathnames (format nil "~a" path)
ritherdon-archive.config:*application-root*))
(defun open-binary-file (username subdirectory slug)
"Reads the file stored in the /storage directory."
@ -110,8 +139,12 @@ not (user-)`ID' is because I wanted to easily identify the directories in
(read-sequence data stream)
data)))
(defun remove-raw-directory (directory-path)
"Removes directory at `DIRECTORY-PATH' when outside /storage directory."
(cl-fad:delete-directory-and-files (make-raw-path directory-path)))
(defun remove-directory (username subdirectory)
"Deletes an entire sketchbook directory in /storage (not database).
"Deletes an directory in /storage.
Path template: `*APPLICATION-ROOT*'/storage/`USERNAME'/`SUBDIRECTORY'/'
- https://edicl.github.io/cl-fad/#delete-directory-and-files
- https://stackoverflow.com/questions/24350183/how-do-i-delete-a-directory-in-common-lisp

Loading…
Cancel
Save