From 030254f63b19f8fc2f915d221809285c27d408b7 Mon Sep 17 00:00:00 2001 From: Sean Whitton Date: Tue, 22 Jun 2021 12:09:05 -0700 Subject: add a number of git, gpg and cron properties Signed-off-by: Sean Whitton --- consfigurator.asd | 1 + doc/data.rst | 3 ++ src/package.lisp | 24 +++++++++++++-- src/property/cron.lisp | 78 +++++++++++++++++++++++++++++++++++++++++++++++++ src/property/git.lisp | 48 ++++++++++++++++++++++++++++++ src/property/gnupg.lisp | 28 ++++++++++++++++++ 6 files changed, 179 insertions(+), 3 deletions(-) create mode 100644 src/property/cron.lisp diff --git a/consfigurator.asd b/consfigurator.asd index 01128f9..a089c49 100644 --- a/consfigurator.asd +++ b/consfigurator.asd @@ -57,6 +57,7 @@ (:file "src/property/schroot") (:file "src/property/sbuild") (:file "src/property/postfix") + (:file "src/property/cron") (:file "src/connection/shell-wrap") (:file "src/connection/fork") (:file "src/connection/rehome") diff --git a/doc/data.rst b/doc/data.rst index ea8a7d2..32bc0fe 100644 --- a/doc/data.rst +++ b/doc/data.rst @@ -36,6 +36,9 @@ other purposes. - ``("--pgp-pubkey" . FINGERPRINT)`` means the/a OpenPGP public key with fingerprint FINGERPRINT, ASCII-armoured +- ``("--pgp-seckey" . FINGERPRINT)`` means the/a OpenPGP secret key with + fingerprint FINGERPRINT, ASCII-armoured + - ``("--luks-passphrase" . VOLUME-LABEL)`` means a LUKS passphrase for volume with label ``VOLUME-LABEL``. diff --git a/src/package.lisp b/src/package.lisp index cc0a6b0..88ac6a2 100644 --- a/src/package.lisp +++ b/src/package.lisp @@ -520,12 +520,21 @@ (defpackage :consfigurator.property.gnupg (:use #:cl #:consfigurator) - (:export #:public-key-imported)) + (:local-nicknames (#:re #:cl-ppcre)) + (:export #:public-key-imported + #:trusts-public-key + #:public-key-imported-and-trusted + #:secret-key-imported)) (defpackage :consfigurator.property.git (:use #:cl #:consfigurator) - (:local-nicknames (#:file #:consfigurator.property.file)) - (:export #:snapshot-extracted)) + (:local-nicknames (#:os #:consfigurator.property.os) + (#:file #:consfigurator.property.file) + (#:apt #:consfigurator.property.apt)) + (:export #:installed + #:snapshot-extracted + #:cloned + #:pulled)) (defpackage :consfigurator.property.sshd (:use #:cl #:consfigurator) @@ -670,6 +679,15 @@ #:main-configured #:mapped-file)) +(defpackage :consfigurator.property.cron + (:use #:cl #:consfigurator) + (:local-nicknames (#:service #:consfigurator.property.service) + (#:apt #:consfigurator.property.apt) + (#:os #:consfigurator.property.os) + (#:file #:consfigurator.property.file)) + (:export #:system-job + #:nice-system-job)) + (defpackage :consfigurator.connection.local (:use #:cl #:consfigurator #:alexandria) (:export #:local-connection)) diff --git a/src/property/cron.lisp b/src/property/cron.lisp new file mode 100644 index 0000000..d486ed9 --- /dev/null +++ b/src/property/cron.lisp @@ -0,0 +1,78 @@ +;;; Consfigurator -- Lisp declarative configuration management system + +;;; Copyright (C) 2021 Sean Whitton + +;;; 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 . + +(in-package :consfigurator.property.cron) +(named-readtables:in-readtable :consfigurator) + +;;; A number of techniques here are from Propellor's Cron properties module. + +(defpropspec system-job :posix (desc when user shell-command) + "Installs a cronjob running SHELL-COMMAND as USER to /etc/cron.*. +DESC must be unique, as it will be used as a filename for a script. WHEN is +either :DAILY, WEEKLY, :MONTHLY or a string formatted according to crontab(5), +e.g. \"0 3 * * *\". + +The output of the cronjob will be mailed only if the job exits nonzero." + (:desc #?"Cronned ${desc}") + (:hostattrs + ;; /etc/cron.* is Debian-specific. Also, we rely on runuser(1), which is + ;; Linux-specific. This is done because su(1) for non-interactive usage + ;; has some pitfalls, and the command line argument '-c' is not portable. + (os:required 'os:debianlike)) + (let* ((times (not (keywordp when))) + (dir (ensure-directory-pathname + (strcat "/etc/cron." (if (keywordp when) + (string-downcase (symbol-name when)) + "d")))) + (job (merge-pathnames (string->filename desc) dir)) + (script (merge-pathnames (strcat (string->filename desc) "_cronjob") + #P"/usr/local/bin/")) + (script* (escape-sh-token (unix-namestring script)))) + `(eseqprops + (apt:service-installed-running "cron") + (apt:installed "moreutils") + (file:has-content ,job + ,`(,@(and (not times) '("#!/bin/sh" "" "set -e" "")) + "SHELL=/bin/sh" + "PATH=/usr/local/sbin:/usr/local/bin:/sbin:/bin:/usr/sbin:/usr/bin" + "" + ,@`(,(if times + #?"${when} ${user} chronic ${script*}" + (if (string= user "root") + (format nil "chronic ~A" script*) + (format nil "chronic runuser -u ~A -c ~A" + user script*))))) + ,@(and (not times) '(:mode #o755))) + ;; Using a separate script makes for more readable e-mail subject lines, + ;; and also makes it easy to do a manual run of the job. + (file:has-content ,script + ,`("#!/bin/sh" + "" + "set -e" + "" + ;; Use flock(1) to ensure that only one instance of the job is ever + ;; running, no matter how long one run of the job takes. + ,(format nil "flock -n ~A sh -c ~A" + (escape-sh-token (unix-namestring job)) + (escape-sh-token shell-command))) + :mode #o755)))) + +(defproplist nice-system-job :posix (desc when user shell-command) + "Like CRON:SYSTEM-JOB, but run the command niced and ioniced." + (:desc #?"Cronned ${desc}, niced and ioniced") + (system-job desc when user (format nil "nice ionice -c 3 sh -c ~A" + (escape-sh-token shell-command)))) diff --git a/src/property/git.lisp b/src/property/git.lisp index 9cd49f8..b3fae68 100644 --- a/src/property/git.lisp +++ b/src/property/git.lisp @@ -18,6 +18,12 @@ (in-package :consfigurator.property.git) (named-readtables:in-readtable :consfigurator) +(defproplist installed :posix () + "Ensures that git(1) is installed." + (:desc "Git installed") + (os:etypecase + (debianlike (apt:installed "git")))) + (defprop snapshot-extracted :posix (directory snapshot-name &key replace @@ -45,3 +51,45 @@ available version of the snapshot is present on the remote system." (:unapply (declare (ignore replace)) (delete-remote-trees dest))) + +(defprop %cloned :posix (url dest branch + &aux (dest (ensure-directory-pathname dest))) + (:check + (declare (ignore branch)) + (let ((config (merge-pathnames ".git/config" dest))) + (and (remote-exists-p config) + (string= url (car (runlines "git" "config" "--file" config + "remote.origin.url")))))) + (:apply + (delete-remote-trees dest) + (file:containing-directory-exists dest) + (run "git" "clone" url dest) + (with-remote-current-directory (dest) + (when branch + (mrun "git" "checkout" branch)) + ;; Do this in case this repo is to be served via HTTP, though note that + ;; we don't set up the hook to do this upon update here. + (mrun "git" "update-server-info")))) + +(defproplist cloned :posix (url dest &optional branch) + "Clone git repo available at URL to DEST. +If the directory already exists and contains anything but a git repo cloned +from URL, recursively delete it first. If BRANCH, check out that branch." + (:desc #?"${url} cloned to ${dest}") + (installed) + (%cloned url dest branch)) + +(defprop %pulled :posix (dest &aux (dest (ensure-directory-pathname dest))) + (:apply + (with-change-if-changes-file-content + ((merge-pathnames ".git/FETCH_HEAD" dest)) + (with-remote-current-directory (dest) + (mrun "git" "pull") + (mrun "git" "update-server-info"))))) + +(defproplist pulled :posix (url dest &optional branch) + "Like GIT:CLONED, but also 'git pull' each time this property is applied." + (:desc #?"${url} pulled to ${dest}") + (installed) + (%cloned url dest branch) + (%pulled dest)) diff --git a/src/property/gnupg.lisp b/src/property/gnupg.lisp index 6f3167f..fc16cd8 100644 --- a/src/property/gnupg.lisp +++ b/src/property/gnupg.lisp @@ -32,3 +32,31 @@ keyring." (with-change-if-changes-file (".gnupg/pubring.kbx") (mrun :input (get-data-stream "--pgp-pubkey" fingerprint) "gpg" "--import")))) + +(defprop trusts-public-key :posix (fingerprint level) + "Ensure that the PGP public key identified by FINGERPRINT is trusted at level +LEVEL, an integer." + (:desc #?"PGP public key ${fingerprint} trusted, level ${level}") + (:preprocess (list (remove #\Space fingerprint) level)) + (:apply (with-change-if-changes-file (".gnupg/trustdb.gpg") + (mrun :input (format nil "~A:~A:~%" fingerprint level) + "gpg" "--import-ownertrust")))) + +(defproplist public-key-imported-and-trusted :posix (fingerprint level) + (:desc "PGP public key ${fingerprint} imported and trusted, level ${level}") + (public-key-imported fingerprint) + (trusts-public-key fingerprint level)) + +(defprop secret-key-imported :posix (fingerprint) + (:desc #?"PGP public key ${fingerprint} imported") + (:preprocess (list (remove #\Space fingerprint))) + (:hostattrs (require-data "--pgp-seckey" fingerprint)) + (:check + ;; Look for plain "sec" not, e.g., "sec#", which indicates the secret key + ;; is not available. + (multiple-value-bind (out err exit) + (run :may-fail "gpg" "--list-secret-keys" fingerprint) + (declare (ignore err)) + (and (zerop exit) (re:scan #?/^sec\s/ out)))) + (:apply (mrun :input (get-data-stream "--pgp-seckey" fingerprint) + "gpg" "--import"))) -- cgit v1.2.3