diff options
author | Sean Whitton <spwhitton@spwhitton.name> | 2021-03-24 17:12:38 -0700 |
---|---|---|
committer | Sean Whitton <spwhitton@spwhitton.name> | 2021-03-24 17:13:10 -0700 |
commit | c4624df9d40df313f490207c37c7a9f629929936 (patch) | |
tree | 865b30cffee61eda6992447d3daf6257700b8886 | |
parent | e5221bf896e49f36cf7593cc6c1e0ac8a7319c01 (diff) | |
download | consfigurator-c4624df9d40df313f490207c37c7a9f629929936.tar.gz |
add GIT:SNAPSHOT-EXTRACTED
Signed-off-by: Sean Whitton <spwhitton@spwhitton.name>
-rw-r--r-- | consfigurator.asd | 1 | ||||
-rw-r--r-- | src/connection.lisp | 11 | ||||
-rw-r--r-- | src/package.lisp | 7 | ||||
-rw-r--r-- | src/property/git.lisp | 46 |
4 files changed, 65 insertions, 0 deletions
diff --git a/consfigurator.asd b/consfigurator.asd index 5cf18cc..2f5ac38 100644 --- a/consfigurator.asd +++ b/consfigurator.asd @@ -31,6 +31,7 @@ (:file "src/property/apt") (:file "src/property/chroot") (:file "src/property/user") + (:file "src/property/git") (:file "src/connection/shell-wrap") (:file "src/connection/fork") (:file "src/connection/ssh") diff --git a/src/connection.lisp b/src/connection.lisp index b993761..56f2985 100644 --- a/src/connection.lisp +++ b/src/connection.lisp @@ -327,6 +327,17 @@ start with RUN." (defun test (&rest args) (zerop (apply #'mrun :for-exit "test" args))) +(defun delete-remote-tree (&rest paths) + "Recursively delete each of PATHS." + (mrun "rm" "-rf" paths)) + +(defun remote-exists-p (&rest paths) + "Does each of PATHS exists? +PATH may be any kind of file, including directories." + (test (loop for path on paths + nconc (list "-e" (car path)) + when (cdr path) collect "-a"))) + (defun readfile (&rest args) (apply #'connection-readfile *connection* args)) diff --git a/src/package.lisp b/src/package.lisp index 0f33b7d..2c6afd8 100644 --- a/src/package.lisp +++ b/src/package.lisp @@ -91,6 +91,8 @@ #:run-failed #:runlines #:test + #:remote-exists-p + #:delete-remote-tree #:readfile #:writefile @@ -274,6 +276,11 @@ (defpackage :consfigurator.property.gnupg (:use #:cl #:consfigurator)) +(defpackage :consfigurator.property.git + (:use #:cl #:consfigurator) + (:local-nicknames (#:file #:consfigurator.property.file)) + (:export #:snapshot-extracted)) + (defpackage :consfigurator.connection.shell-wrap (:use #:cl #:consfigurator) (:export #:shell-wrap-connection #:connection-shell-wrap)) diff --git a/src/property/git.lisp b/src/property/git.lisp new file mode 100644 index 0000000..6434575 --- /dev/null +++ b/src/property/git.lisp @@ -0,0 +1,46 @@ +;;; Consfigurator -- Lisp declarative configuration management system + +;;; Copyright (C) 2020-2021 Sean Whitton <spwhitton@spwhitton.name> + +;;; This file is free software; you can redistribute it and/or modify +;;; it under the terms of the GNU General Public License as published by +;;; the Free Software Foundation; either version 3, or (at your option) +;;; any later version. + +;;; This file is distributed in the hope that it will be useful, +;;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;;; GNU General Public License for more details. + +;;; You should have received a copy of the GNU General Public License +;;; along with this program. If not, see <http://www.gnu.org/licenses/>. + +(in-package :consfigurator.property.git) +(named-readtables:in-readtable :consfigurator) + +(defprop snapshot-extracted :posix + (directory snapshot-name + &key replace + &aux (dest + (merge-pathnames snapshot-name + (ensure-directory-pathname directory)))) + "Extract a tarball as produced by DATA:GIT-SNAPSHOT under DIRECTORY. +If REPLACE, delete and replace the snapshot (or anything else) that already +exists at DIRECTORY/SNAPSHOT-NAME. This is useful to ensure the latest +available version of the snapshot is present on the remote system." + ;; TODO Keyword argument to replace only if a newer version of the + ;; prerequisite data is available. + (:desc (declare (ignore replace dest)) + #?"git snapshot ${snapshot-name} extracted") + (:hostattrs (declare (ignore replace dest)) + (require-data "--git-snapshot" snapshot-name)) + (:check (and (not replace) (remote-exists-p dest))) + (:apply + (declare (ignore replace)) + (delete-remote-tree dest) + (file:directory-exists directory) + (mrun :input (get-data-stream "--git-snapshot" snapshot-name) + #?"cd '${directory}'; tar xfz -")) + (:unapply + (declare (ignore replace)) + (delete-remote-tree dest))) |