1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
|
;;; 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.property.live-build)
(named-readtables:in-readtable :consfigurator)
(defproplist installed :posix ()
"Install the Debian Live tool suite. See live-build(7)."
(:desc "Debian Live live-build installed")
(os:etypecase
(debianlike (apt:installed "live-build"))))
(defun auto/config (config)
(with-output-to-string (s)
(format s "#!/bin/sh~%lb config noauto")
(dolist (argument config)
(princ " " s)
(princ (escape-sh-token argument) s))
(princ " \"${@}\"" s)
(terpri s)))
(defprop %lbconfig :posix (dir)
(:desc (declare (ignore dir))
"lb config")
(:apply
(with-remote-current-directory (dir)
(run :inform "lb" "config"))))
(defprop %lbbootstrap :posix
(config-changed dir &aux (chroot (merge-pathnames "chroot/" dir)))
(:desc (declare (ignore config-changed chroot))
"lb bootstrap")
(:hostattrs
(declare (ignore config-changed chroot))
(os:required 'os:linux))
(:check
(and (not config-changed)
(remote-exists-p chroot)
(not (remote-exists-p (merge-pathnames "debootstrap/" chroot)))))
(:apply
(declare (ignore config-changed))
(ignoring-hostattrs (mount:unmounted-below-and-removed chroot))
(with-remote-current-directory (dir)
(apply #'run :inform
(if-let ((proxy (get-hostattrs-car :apt.proxy)))
(list :env (list :http_proxy proxy) "lb" "bootstrap")
'("lb" "bootstrap"))))))
(defprop %lbchroot :posix (dir)
(:desc (declare (ignore dir))
"lb chroot")
(:apply
(with-remote-current-directory (dir)
(run "lb" "chroot" "--force"))))
(defprop %lbbinary :posix (dir)
(:desc (declare (ignore dir))
"lb binary")
(:apply
(with-remote-current-directory (dir)
(run :inform "lb" "binary" "--force"))))
(defpropspec image-built :lisp (config dir properties)
"Build an image under DIR using live-build(7), where the resulting live
system has PROPERTIES, which should contain, at a minimum, a property from
CONSFIGURATOR.PROPERTY.OS setting the Debian suite and architecture. CONFIG
is a list of arguments to pass to lb_config(1), not including the '-a' and
'-d' options, which Consfigurator will supply based on PROPERTIES.
This property runs the lb_config(1), lb_bootstrap(1), lb_chroot(1) and
lb_binary(1) commands to build or rebuild the image. Rebuilding occurs only
when changes to CONFIG or PROPERTIES mean that the image is potentially
out-of-date; e.g. if you just add some new items to PROPERTIES then in most
cases only lb_chroot(1) and lb_binary(1) will be re-run.
Note that lb_chroot(1) and lb_binary(1) both run after applying PROPERTIES,
and might undo some of their effects. For example, to configure
/etc/apt/sources.list, you will need to use CONFIG not PROPERTIES."
(:desc (declare (ignore config properties))
#?"Debian Live image built in ${dir}")
(let* ((dir (ensure-directory-pathname dir))
(chroot (merge-pathnames "chroot/" dir))
(auto/config (merge-pathnames "auto/config" dir))
(clean (mapcar (rcurry #'merge-pathnames
(merge-pathnames "config/" dir))
'("binary" "bootstrap" "chroot" "common" "source")))
(host (make-host :propspec properties))
(host-os (get-hostattrs-car :os (preprocess-host host))))
(when-let ((mirror (get-hostattrs-car :apt.mirror)))
(setq config (list* "-m" mirror config)))
(setq config (list* "-a" (os:debian-architecture host-os)
"-d" (os:debian-suite host-os) config))
`(eseqprops
(installed)
(file:directory-exists ,(merge-pathnames "auto/" dir))
(on-change
(eseqprops
(on-change
(file:has-content ,auto/config ,(auto/config config) :mode #o755)
(file:does-not-exist ,@clean)
(%lbconfig ,dir)
(%lbbootstrap t ,dir))
(%lbbootstrap nil ,dir)
(deploys ((:chroot :into ,chroot)) ,host))
;; We could run lb_chroot before DEPLOYS, but lb_binary resets things
;; like /etc/apt/sources.list too, so doing that wouldn't avoid the
;; problem that sometimes CONFIG must be used when you'd normally use
;; PROPERTIES. And we can't really determine whether or not lb_chroot
;; made a change, so it is not good for running inside the first
;; argument to ON-CHANGE.
(%lbchroot ,dir)
(%lbbinary ,dir)))))
|
