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 2 years ago
parent
commit
f629e3d750
  1. 43
      src/storage.lisp

43
src/storage.lisp

@ -1,6 +1,7 @@
(in-package #:cl-user) (in-package #:cl-user)
(defpackage #:storage (defpackage #:storage
(:use #:cl) (:use #:cl
#:copy-directory)
(:export #:init-storage (:export #:init-storage
#:directory-exists-p #:directory-exists-p
#:ensure-directory-exists #:ensure-directory-exists
@ -21,7 +22,12 @@
#:store-text-with-raw-path #:store-text-with-raw-path
#:open-text-file-with-raw-path #:open-text-file-with-raw-path
#:store-test #: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) (in-package #:storage)
(defun init-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") (uiop:copy-file (make-path "" "default-assets" "site-wide-snippet.html")
(make-path "" "snippets" "site-wide-snippet.html")) (make-path "" "snippets" "site-wide-snippet.html"))
;; Nothing is added to /storage/media yet, this is just prep. work. ;; 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) (defun directory-exists-p (username directory)
"Checks to see if the specified diretory exists. "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." returned if the directory cannot be found."
(cl:probe-file (make-path username directory ""))) (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) (defun ensure-directory-exists (username directory)
"The project's standardised way to call `ENSURE-DIRECTORY-EXISTS'. "The project's standardised way to call `ENSURE-DIRECTORY-EXISTS'.
If the directory exists, the full (absolute) path is 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." /storage."
(merge-pathnames (format nil "storage/~A/~A/~A" (merge-pathnames (format nil "storage/~A/~A/~A"
username subdirectory slug) 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) (defun open-binary-file (username subdirectory slug)
"Reads the file stored in the /storage directory." "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) (read-sequence data stream)
data))) 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) (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'/' Path template: `*APPLICATION-ROOT*'/storage/`USERNAME'/`SUBDIRECTORY'/'
- https://edicl.github.io/cl-fad/#delete-directory-and-files - https://edicl.github.io/cl-fad/#delete-directory-and-files
- https://stackoverflow.com/questions/24350183/how-do-i-delete-a-directory-in-common-lisp - https://stackoverflow.com/questions/24350183/how-do-i-delete-a-directory-in-common-lisp

Loading…
Cancel
Save