diff options
-rw-r--r-- | consfigurator.asd | 3 | ||||
-rw-r--r-- | doc/data.rst | 5 | ||||
-rw-r--r-- | src/data/git-snapshot.lisp | 97 | ||||
-rw-r--r-- | src/package.lisp | 3 |
4 files changed, 106 insertions, 2 deletions
diff --git a/consfigurator.asd b/consfigurator.asd index bf5c9b7..2508754 100644 --- a/consfigurator.asd +++ b/consfigurator.asd @@ -39,4 +39,5 @@ (:file "src/connection/chroot/fork") (:file "src/connection/chroot/shell") (:file "src/data/asdf") - (:file "src/data/pgp"))) + (:file "src/data/pgp") + (:file "src/data/git-snapshot"))) diff --git a/doc/data.rst b/doc/data.rst index be2d98c..1cdea9b 100644 --- a/doc/data.rst +++ b/doc/data.rst @@ -28,7 +28,10 @@ other purposes. ``SYSTEM`` - ``("--user-passwd--HOSTNAME" . USER)`` means the data is the password for - user ``USER`` on ``HOSTNAME``. + user ``USER`` on ``HOSTNAME`` + +- ``("--git-snapshot" . NAME)`` means the data is a snapshot of a git repo + identified by ``NAME``; see ``DATA.GIT-SNAPSHOT``. (Proposed convention: Except for the first item above, these reserved names should start with ``--`` and use ``--`` to separate parameter values within diff --git a/src/data/git-snapshot.lisp b/src/data/git-snapshot.lisp new file mode 100644 index 0000000..d331c14 --- /dev/null +++ b/src/data/git-snapshot.lisp @@ -0,0 +1,97 @@ +;;; Consfigurator -- Lisp declarative configuration management system + +;;; Copyright (C) 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.data.git-snapshot) +(named-readtables:in-readtable :consfigurator) + +(defmethod register-data-source ((type (eql :git-snapshot)) + &key name repo depth branch) + "Provide tarball snapshots of a branch of a local git repository. +Provides prerequisite data identified by \"--git-snapshot\", \"NAME\". + +Rather than using git-bundle(1) or git-archive(1), we create a (possibly +shallow) clone and tar it up. That way, it's still a git repo on the remote +side, but we don't require git to be installed on the remote side to get a +copy of the working tree over there." + (when (data-source-providing-p "--git-snapshot" name) + (simple-program-error + "Another data source is providing git snapshots identified by ~S." name)) + (with-current-directory (repo) + (unless (zerop (nth-value 2 (run-program '("git" "rev-parse" "--git-dir") + :ignore-error-status t))) + (missing-data-source "~A is not a git repository." repo))) + (let* ((cached + (get-highest-local-cached-prerequisite-data "--git-snapshot" name)) + (cached-commit (and cached (nth 1 (split-string (data-version cached) + :separator "."))))) + (when cached + (setf (data-mime cached) "application/gzip")) + (labels ((latest-version (tip) + (format nil "~A.~A" (get-universal-time) tip)) + (check (iden1 iden2) + (and (string= iden1 "--git-snapshot") + (string= iden2 name) + (let ((tip (get-branch-tip repo branch))) + (if (and cached-commit (string= cached-commit tip)) + (data-version cached) + (latest-version tip))))) + (extract (&rest ignore) + (declare (ignore ignore)) + (let* ((tip (get-branch-tip repo branch)) + (version (latest-version tip)) + (path (local-data-pathname + "--git-snapshot" name version))) + (if (and cached-commit (string= cached-commit tip)) + cached + (progn + (ignore-errors + (mapc #'delete-file + (directory-files + (pathname-directory-pathname path)))) + (make-snapshot repo depth branch path) + (setq cached-commit tip + cached (make-instance 'file-data + :file path + :mime "application/gzip" + :iden1 "--git-snapshot" + :iden2 name + :version version))))))) + (cons #'check #'extract)))) + +(defun make-snapshot (repo depth branch output) + (with-local-temporary-directory (dir) + (let* ((shortname (lastcar (pathname-directory repo))) + (loc (ensure-directory-pathname (merge-pathnames shortname dir)))) + (run-program `("git" "clone" + "--no-hardlinks" + ,@(and depth `("--depth" ,(write-to-string depth))) + "--origin" "local" + ,@(and branch (list "--branch" branch)) + ,(strcat "file://" (namestring repo)) + ,(namestring loc))) + (with-current-directory (loc) + (run-program '("git" "remote" "rm" "local"))) + (delete-directory-tree (merge-pathnames ".git/refs/remotes/local/" loc) + :validate t :if-does-not-exist :ignore) + (with-current-directory (dir) + (run-program `("tar" "cfz" ,(namestring output) ,shortname)))))) + +(defun get-branch-tip (repo branch) + (with-current-directory (repo) + (stripln + (run-program `("git" "rev-parse" "--verify" ,(strcat branch "^{commit}")) + :output :string)))) diff --git a/src/package.lisp b/src/package.lisp index 09ff35d..23f0f90 100644 --- a/src/package.lisp +++ b/src/package.lisp @@ -304,3 +304,6 @@ (defpackage :consfigurator.data.pgp (:use #:cl #:consfigurator #:alexandria) (:export #:list-data #:get-data #:set-data #:set-data-from-file)) + +(defpackage :consfigurator.data.git-snapshot + (:use #:cl #:consfigurator #:alexandria)) |