From ab83e1f054ef8c9ce1486a56f2484430630d42a3 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Mon, 22 Jun 2020 16:35:39 +0200 Subject: doc: cookbook: Clarify 'git-fetch' conventions. * doc/guix-cookbook.texi (Extended example): Clarify use of 'git-file-name' and 'git-version'. --- doc/guix-cookbook.texi | 10 ++++++---- 1 file changed, 6 insertions(+), 4 deletions(-) (limited to 'doc') diff --git a/doc/guix-cookbook.texi b/doc/guix-cookbook.texi index 1342826c97..31c4cd4121 100644 --- a/doc/guix-cookbook.texi +++ b/doc/guix-cookbook.texi @@ -843,12 +843,14 @@ tags, so if the @code{version} is tagged, then it can be used directly. Sometim the tag is prefixed with a @code{v}, in which case you'd use @code{(commit (string-append "v" version))}. -To ensure that the source code from the Git repository is stored in a unique -directory with a readable name we use @code{(file-name (git-file-name name +To ensure that the source code from the Git repository is stored in a +directory with a descriptive name, we use @code{(file-name (git-file-name name version))}. -Note that there is also a @code{git-version} procedure that can be used to derive the -version when packaging programs for a specific commit. +The @code{git-version} procedure that can be used to derive the +version when packaging programs for a specific commit, following the +Guix contributor guidelines (@pxref{Version Numbers,,, guix, GNU Guix +Reference Manual}). @subsubsection Snippets -- cgit v1.2.3 From 2f562699ea936f9639ccf5deef2e7b458a7426bf Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Mon, 22 Jun 2020 16:40:18 +0200 Subject: doc: cookbook: Mention "guix hash -rx" for Git checkouts. * doc/guix-cookbook.texi (Extended example): Mention "guix hash -rx ." --- doc/guix-cookbook.texi | 18 ++++++++++++++++++ 1 file changed, 18 insertions(+) (limited to 'doc') diff --git a/doc/guix-cookbook.texi b/doc/guix-cookbook.texi index 31c4cd4121..efafbd9d93 100644 --- a/doc/guix-cookbook.texi +++ b/doc/guix-cookbook.texi @@ -852,6 +852,24 @@ version when packaging programs for a specific commit, following the Guix contributor guidelines (@pxref{Version Numbers,,, guix, GNU Guix Reference Manual}). +How does one obtain the @code{sha256} hash that's in there, you ask? By +invoking @command{guix hash} on a checkout of the desired commit, along +the lines: + +@example +git clone https://github.com/libgit2/libgit2/ +cd libgit2 +git checkout v0.26.6 +guix hash -rx . +@end example + +@command{guix hash -rx} computes a SHA256 hash over the whole directory, +excluding the @file{.git} sub-directory (@pxref{Invoking guix hash,,, +guix, GNU Guix Reference Manual}). + +In the future, @command{guix download} will hopefully be able to do +these steps for you, just like it does for regular downloads. + @subsubsection Snippets Snippets are quoted (i.e. non-evaluated) Scheme code that are a means of patching -- cgit v1.2.3 From 96a95aa9c7f309bd8014ccf4e28d915241d1045e Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Tue, 23 Jun 2020 00:01:48 +0200 Subject: doc: cookbook: Tweak intro to the REPL. * doc/guix-cookbook.texi (A Scheme Crash Course): Reword first paragraph. Remove extra paren. --- doc/guix-cookbook.texi | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) (limited to 'doc') diff --git a/doc/guix-cookbook.texi b/doc/guix-cookbook.texi index efafbd9d93..e4d685c747 100644 --- a/doc/guix-cookbook.texi +++ b/doc/guix-cookbook.texi @@ -109,8 +109,8 @@ Let's get started! Guix uses the Guile implementation of Scheme. To start playing with the language, install it with @code{guix install guile} and start a -@uref{https://en.wikipedia.org/wiki/Read%E2%80%93eval%E2%80%93print_loop, -REPL} by running @code{guile} from the command line. +@dfn{REPL}---short for @uref{https://en.wikipedia.org/wiki/Read%E2%80%93eval%E2%80%93print_loop, +@dfn{read-eval-print loop}}---by running @code{guile} from the command line. Alternatively you can also run @code{guix environment --ad-hoc guile -- guile} if you'd rather not have Guile installed in your user profile. @@ -118,7 +118,7 @@ if you'd rather not have Guile installed in your user profile. In the following examples, lines show what you would type at the REPL; lines starting with ``@result{}'' show evaluation results, while lines starting with ``@print{}'' show things that get printed. @xref{Using Guile -Interactively,,, guile, GNU Guile Reference Manual}), for more details on the +Interactively,,, guile, GNU Guile Reference Manual}, for more details on the REPL. @itemize -- cgit v1.2.3 From 4ebbd92c291573c1ae5a1cf7c004caeefa09dd86 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Tue, 23 Jun 2020 08:57:58 +0200 Subject: doc: cookbook: Fix typos. * doc/guix-cookbook.texi (Extended example): Fix typos. --- doc/guix-cookbook.texi | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'doc') diff --git a/doc/guix-cookbook.texi b/doc/guix-cookbook.texi index e4d685c747..ec6217c69c 100644 --- a/doc/guix-cookbook.texi +++ b/doc/guix-cookbook.texi @@ -847,14 +847,14 @@ To ensure that the source code from the Git repository is stored in a directory with a descriptive name, we use @code{(file-name (git-file-name name version))}. -The @code{git-version} procedure that can be used to derive the +The @code{git-version} procedure can be used to derive the version when packaging programs for a specific commit, following the Guix contributor guidelines (@pxref{Version Numbers,,, guix, GNU Guix Reference Manual}). How does one obtain the @code{sha256} hash that's in there, you ask? By invoking @command{guix hash} on a checkout of the desired commit, along -the lines: +these lines: @example git clone https://github.com/libgit2/libgit2/ -- cgit v1.2.3 From 5813a0c94f92d5b5d3360eac5a0d61314131a84a Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Thu, 25 Jun 2020 23:26:35 +0200 Subject: doc: 'guix hash' is not SHA256-only. This is a followup to 18ae1ec3ecfe22d55d6cdf595a442afebbc5595a. * doc/guix.texi (Invoking guix hash): Remove "SHA256" from the first paragraph. --- doc/guix.texi | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'doc') diff --git a/doc/guix.texi b/doc/guix.texi index 5b854ccbd4..de34939248 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -9171,7 +9171,7 @@ store. @section Invoking @command{guix hash} @cindex @command{guix hash} -The @command{guix hash} command computes the SHA256 hash of a file. +The @command{guix hash} command computes the hash of a file. It is primarily a convenience tool for anyone contributing to the distribution: it computes the cryptographic hash of a file, which can be used in the definition of a package (@pxref{Defining Packages}). -- cgit v1.2.3 From 8f19e63f760fe02f9969225da2f3f3c36801218f Mon Sep 17 00:00:00 2001 From: Efraim Flashner Date: Sun, 21 Jun 2020 16:20:16 +0300 Subject: services: Add rshiny service. * gnu/services/science.scm: New file. (): New record. (rshiny-shepherd-service-type): New variable. * doc/guix.texi (Miscellaneous Services): Document it. * gnu/local.mk (GNU_SYSTEM_MODULES): Add it. --- doc/guix.texi | 49 +++++++++++++++++++++++++++++++++++++++++ gnu/local.mk | 1 + gnu/services/science.scm | 57 ++++++++++++++++++++++++++++++++++++++++++++++++ 3 files changed, 107 insertions(+) create mode 100644 gnu/services/science.scm (limited to 'doc') diff --git a/doc/guix.texi b/doc/guix.texi index de34939248..ffc77cbb8b 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -26612,6 +26612,55 @@ setuid-root (@pxref{Setuid Programs}) such that unprivileged users can invoke @command{singularity run} and similar commands. @end defvr +@cindex rshiny +@subsubheading R-Shiny service + +The @code{(gnu services science)} module provides the following service. + +@defvr {Scheme Variable} rshiny-service-type + +This is a type of service which is used to run a webapp created with +@code{r-shiny}. This service sets the @code{R_LIBS_USER} environment +variable and runs the provided script to call @code{runApp}. + +@deftp {Data Type} rshiny-configuration +This is the data type representing the configuration of rshiny. + +@table @asis + +@item @code{package} (default: @code{r-shiny}) +The package to use. + +@item @code{binary} (defaunlt @code{"rshiny"}) +The name of the binary or shell script located at @code{package/bin/} to +run when the service is run. + +The common way to create this file is as follows: + +@lisp +@dots{} +(let* ((out (assoc-ref %outputs "out")) + (targetdir (string-append out "/share/" ,name)) + (app (string-append out "/bin/" ,name)) + (Rbin (string-append (assoc-ref %build-inputs "r-min") + "/bin/Rscript"))) +@dots{} + (mkdir-p (string-append out "/bin")) + (call-with-output-file app + (lambda (port) + (format port +"#!~a +library(shiny) +setwd(\"~a\") +runApp(launch.browser=0, port=4202)~%\n" + Rbin targetdir))) +@dots{} +@end lisp + +@end table +@end deftp +@end defvr + @cindex Nix @subsubheading Nix service diff --git a/gnu/local.mk b/gnu/local.mk index fb157c0ab1..8bb56010c2 100644 --- a/gnu/local.mk +++ b/gnu/local.mk @@ -599,6 +599,7 @@ GNU_SYSTEM_MODULES = \ %D%/services/nix.scm \ %D%/services/nfs.scm \ %D%/services/pam-mount.scm \ + %D%/services/science.scm \ %D%/services/security-token.scm \ %D%/services/shepherd.scm \ %D%/services/sound.scm \ diff --git a/gnu/services/science.scm b/gnu/services/science.scm new file mode 100644 index 0000000000..94ff0f36f2 --- /dev/null +++ b/gnu/services/science.scm @@ -0,0 +1,57 @@ +(define-module (gnu services science) + #:export ( + rshiny-configuration + rshiny-configuration? + rshiny-configuration-package + rshiny-configuration-binary + rshiny-shepherd-service + rshiny-service-type)) + +(use-modules (gnu) + (guix records) + (ice-9 match)) +(use-service-modules shepherd) +(use-package-modules cran) + +(define-record-type* + rshiny-configuration + make-rshiny-configuration + rshiny-configuration? + (package rshiny-configuration-package ; package + (default r-shiny)) + (binary rshiny-configuration-binary ; string + (default "rshiny"))) + +(define rshiny-shepherd-service + (match-lambda + (($ package binary) + (list + (shepherd-service + (documentation (string-append "R-Shiny service for " binary)) + (provision (list (symbol-append 'rshiny- (string->symbol + (string-take binary 9))))) + (requirement '(networking)) + (start + #~(exec-command + (list + #$(string-append "/run/current-system/profile/bin/" binary)) + ;#:log-file #$(string-append "/var/log/" binary ".log") ; kills shepherd + #:environment-variables + (list "R_LIBS_USER=/run/current-system/profile/site-library/"))) + (stop #~(make-kill-destructor))))))) + +(define rshiny-service-type + (service-type + (name 'rshiny) + (extensions + (list + (service-extension shepherd-root-service-type + rshiny-shepherd-service) + (service-extension profile-service-type + ;; We want the package installed so that it + ;; pulls in the propagated inputs as well. + (lambda (config) + (list + (rshiny-configuration-package config)))))) + (description + "Run an R-Shiny webapp as a Guix Service."))) -- cgit v1.2.3 From f8945734a5abff69644284231cc47fb67456657b Mon Sep 17 00:00:00 2001 From: André Batista Date: Thu, 18 Jun 2020 10:23:23 -0300 Subject: doc: cookbook: Update entry about getting substitutes through Tor. * doc/guix-cookbook.texi (Getting substitutes from Tor): Update section warning to mention the use of torsocks when pulling. --- doc/guix-cookbook.texi | 9 ++++++++- 1 file changed, 8 insertions(+), 1 deletion(-) (limited to 'doc') diff --git a/doc/guix-cookbook.texi b/doc/guix-cookbook.texi index ec6217c69c..1669cb8666 100644 --- a/doc/guix-cookbook.texi +++ b/doc/guix-cookbook.texi @@ -15,6 +15,7 @@ Copyright @copyright{} 2020 Oleg Pykhalov@* Copyright @copyright{} 2020 Matthew Brooks@* Copyright @copyright{} 2020 Marcin Karpezo@* Copyright @copyright{} 2020 Brice Waegeneire@* +Copyright @copyright{} 2020 André Batista@* Permission is granted to copy, distribute and/or modify this document under the terms of the GNU Free Documentation License, Version 1.3 or @@ -1819,10 +1820,16 @@ HTTP/HTTPS will get proxied; FTP, Git protocol, SSH, etc connections will still go through the clearnet. Again, this configuration isn't foolproof some of your traffic won't get routed by Tor at all. Use it at your own risk. + +Also note that the procedure described here applies only to package +substitution. When you update your guix distribution with +@command{guix pull}, you still need to use @command{torsocks} if +you want to route the connection to guix's git repository servers +through Tor. @end quotation Guix's substitute server is available as a Onion service, if you want -to use it to get your substitutes from Tor configure your system as +to use it to get your substitutes through Tor configure your system as follow: @lisp -- cgit v1.2.3 From e39b2363f5b92b9c8dfc0da7d8fbaedb1c172b46 Mon Sep 17 00:00:00 2001 From: Brice Waegeneire Date: Fri, 26 Jun 2020 13:54:32 +0200 Subject: doc: Add progress display in 'dd' command lines. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * doc/guix.texi (System Installation): Adjust 'dd' command line to display progress … (System Configuration): … same here. --- doc/guix.texi | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'doc') diff --git a/doc/guix.texi b/doc/guix.texi index ffc77cbb8b..a4c409ea12 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -1978,7 +1978,7 @@ its device name. Assuming that the USB stick is known as @file{/dev/sdX}, copy the image with: @example -dd if=guix-system-install-@value{VERSION}.x86_64-linux.iso of=/dev/sdX +dd if=guix-system-install-@value{VERSION}.x86_64-linux.iso of=/dev/sdX status=progress sync @end example @@ -27665,7 +27665,7 @@ the device corresponding to a USB stick, one can copy the image to it using the following command: @example -# dd if=$(guix system disk-image my-os.scm) of=/dev/sdc +# dd if=$(guix system disk-image my-os.scm) of=/dev/sdc status=progress @end example When using @code{docker-image}, a Docker image is produced. Guix builds -- cgit v1.2.3 From e3d2e618fe5bbf85911d6c283b34cbd76191536a Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Sun, 28 Jun 2020 23:28:55 +0200 Subject: doc: cookbook: Fix encoding of "André". MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit This is a followup to f8945734a5abff69644284231cc47fb67456657b. * doc/guix-cookbook.texi: Encode "André" as UTF-8, not ISO-8859-1. --- doc/guix-cookbook.texi | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'doc') diff --git a/doc/guix-cookbook.texi b/doc/guix-cookbook.texi index 1669cb8666..13ec2976a6 100644 --- a/doc/guix-cookbook.texi +++ b/doc/guix-cookbook.texi @@ -15,7 +15,7 @@ Copyright @copyright{} 2020 Oleg Pykhalov@* Copyright @copyright{} 2020 Matthew Brooks@* Copyright @copyright{} 2020 Marcin Karpezo@* Copyright @copyright{} 2020 Brice Waegeneire@* -Copyright @copyright{} 2020 André Batista@* +Copyright @copyright{} 2020 André Batista@* Permission is granted to copy, distribute and/or modify this document under the terms of the GNU Free Documentation License, Version 1.3 or -- cgit v1.2.3 From 8b7d982e6ae090eb5b3938db14a8eb2e2c3a1419 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Thu, 25 Jun 2020 00:08:05 +0200 Subject: channels: Make channel introductions public. * guix/channels.scm (): Rename constructor to '%make-channel-introduction'. (make-channel-introduction): New procedure. * tests/channels.scm ("authenticate-channel, wrong first commit signer") ("authenticate-channel, .guix-authorizations"): Use 'make-channel-introduction' without '@@' and without third argument. * doc/guix.texi (Channels)[Channel Authentication, Specifying Channel Authorizations]: New subsections. --- doc/guix.texi | 112 ++++++++++++++++++++++++++++++++++++++++++++++++++++- guix/channels.scm | 14 +++++-- tests/channels.scm | 10 ++--- 3 files changed, 125 insertions(+), 11 deletions(-) (limited to 'doc') diff --git a/doc/guix.texi b/doc/guix.texi index a4c409ea12..67c86de4b6 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -3975,8 +3975,47 @@ deploys Guix itself from the official GNU@tie{}Guix repository. This can be customized by defining @dfn{channels} in the @file{~/.config/guix/channels.scm} file. A channel specifies a URL and branch of a Git repository to be deployed, and @command{guix pull} can be instructed -to pull from one or more channels. In other words, channels can be used to -@emph{customize} and to @emph{extend} Guix, as we will see below. +to pull from one or more channels. In other words, channels can be used +to @emph{customize} and to @emph{extend} Guix, as we will see below. +Before that, some security considerations. + +@subsection Channel Authentication + +@cindex authentication, of channel code +The @command{guix pull} and @command{guix time-machine} commands +@dfn{authenticate} the code retrieved from channels: they make sure each +commit that is fetched is signed by an authorized developer. The goal +is to protect from unauthorized modifications to the channel that would +lead users to run malicious code. + +As a user, you must provide a @dfn{channel introduction} in your +channels file so that Guix knows how to authenticate its first commit. +A channel specification, including its introduction, looks something +along these lines: + +@lisp +(channel + (name 'my-channel) + (url "https://example.org/my-channel.git") + (introduction + (make-channel-introduction + "6f0d8cc0d88abb59c324b2990bfee2876016bb86" + (openpgp-fingerprint + "CABB A931 C0FF EEC6 900D 0CFB 090B 1199 3D9A EBB5")))) +@end lisp + +The specification above shows the name and URL of the channel. The call +to @code{make-channel-introduction} above specifies that authentication +of this channel starts at commit @code{6f0d8cc@dots{}}, which is signed +by the OpenPGP key with fingerprint @code{CABB A931@dots{}}. + +For the main channel, called @code{guix}, you automatically get that +information from your Guix installation. For other channels, include +the channel introduction provided by the channel authors in your +@file{channels.scm} file. Make sure you retrieve the channel +introduction from a trusted source since that is the root of your trust. + +If you're curious about the authentication mechanics, read on! @subsection Using a Custom Guix Channel @@ -4150,6 +4189,75 @@ add a meta-data file @file{.guix-channel} that contains: (directory "guix")) @end lisp +@cindex channel authorizations +@subsection Specifying Channel Authorizations + +As we saw above, Guix ensures the source code it pulls from channels +comes from authorized developers. As a channel author, you need to +specify the list of authorized developers in the +@file{.guix-authorizations} file in the channel's Git repository. The +authentication rule is simple: each commit must be signed by a key +listed in the @file{.guix-authorizations} file of its parent +commit(s)@footnote{Git commits form a @dfn{directed acyclic graph} +(DAG). Each commit can have zero or more parents; ``regular'' commits +have one parent and merge commits have two parent commits. Read +@uref{https://eagain.net/articles/git-for-computer-scientists/, @i{Git +for Computer Scientists}} for a great overview.} The +@file{.guix-authorizations} file looks like this: + +@lisp +;; Example '.guix-authorizations' file. + +(authorizations + (version 0) ;current file format version + + (("AD17 A21E F8AE D8F1 CC02 DBD9 F8AE D8F1 765C 61E3" + (name "alice")) + ("2A39 3FFF 68F4 EF7A 3D29 12AF 68F4 EF7A 22FB B2D5" + (name "bob")) + ("CABB A931 C0FF EEC6 900D 0CFB 090B 1199 3D9A EBB5" + (name "charlie")))) +@end lisp + +Each fingerprint is followed by optional key/value pairs, as in the +example above. Currently these key/value pairs are ignored. + +This authentication rule creates a chicken-and-egg issue: how do we +authenticate the first commit? Related to that: how do we deal with +channels whose repository history contains unsigned commits and lack +@file{.guix-authorizations}? And how do we fork existing channels? + +@cindex channel introduction +Channel introductions answer these questions by describing the first +commit of a channel that should be authenticated. The first time a +channel is fetched with @command{guix pull} or @command{guix +time-machine}, the command looks up the introductory commit and verifies +that it is signed by the specified OpenPGP key. From then on, it +authenticates commits according to the rule above. + +To summarize, as the author of a channel, there are two things you have +to do to allow users to authenticate your code: + +@enumerate +@item +Introduce an initial @file{.guix-authorizations} in the channel's +repository. Do that in a signed commit (@pxref{Commit Access}, for +information on how to sign Git commits.) + +@item +Advertise the channel introduction, for instance on your channel's web +page. The channel introduction, as we saw above, is the commit/key +pair---i.e., the commit that introduced @file{.guix-authorizations}, and +the fingerprint of the OpenPGP used to sign it. +@end enumerate + +Publishing a signed channel requires discipline: any mistake, such as an +unsigned commit or a commit signed by an unauthorized key, will prevent +users from pulling from your channel---well, that's the whole point of +authentication! Pay attention to merges in particular: merge commits +are considered authentic if and only if they are signed by a key present +in the @file{.guix-authorizations} file of @emph{both} branches. + @cindex primary URL, channels @subsection Primary URL diff --git a/guix/channels.scm b/guix/channels.scm index 02619c253f..5f48e6f04f 100644 --- a/guix/channels.scm +++ b/guix/channels.scm @@ -69,7 +69,9 @@ channel-location channel-introduction? - ;; accessors purposefully omitted for now. + make-channel-introduction + channel-introduction-first-signed-commit + channel-introduction-first-commit-signer openpgp-fingerprint->bytevector openpgp-fingerprint @@ -130,13 +132,19 @@ ;; commit so that only them may emit this introduction. Introductions are ;; used to bootstrap trust in a channel. (define-record-type - (make-channel-introduction first-signed-commit first-commit-signer - signature) + (%make-channel-introduction first-signed-commit first-commit-signer + signature) channel-introduction? (first-signed-commit channel-introduction-first-signed-commit) ;hex string (first-commit-signer channel-introduction-first-commit-signer) ;bytevector (signature channel-introduction-signature)) ;string +(define (make-channel-introduction commit signer) + "Return a new channel introduction: COMMIT is the introductory where +authentication starts, and SIGNER is the OpenPGP fingerprint (a bytevector) of +the signer of that commit." + (%make-channel-introduction commit signer #f)) + (define (openpgp-fingerprint->bytevector str) "Convert STR, an OpenPGP fingerprint (hexadecimal string with whitespace), to the corresponding bytevector." diff --git a/tests/channels.scm b/tests/channels.scm index d7202f8cbf..591b7b9749 100644 --- a/tests/channels.scm +++ b/tests/channels.scm @@ -451,12 +451,11 @@ (with-repository directory repository (let* ((commit1 (find-commit repository "first")) (commit2 (find-commit repository "second")) - (intro ((@@ (guix channels) make-channel-introduction) + (intro (make-channel-introduction (commit-id-string commit1) (openpgp-public-key-fingerprint (read-openpgp-packet - %ed25519bis-public-key-file)) ;different key - #f)) ;no signature + %ed25519bis-public-key-file)))) ;different key (channel (channel (name 'example) (url (string-append "file://" directory)) (introduction intro)))) @@ -507,12 +506,11 @@ (let* ((commit1 (find-commit repository "first")) (commit2 (find-commit repository "second")) (commit3 (find-commit repository "third")) - (intro ((@@ (guix channels) make-channel-introduction) + (intro (make-channel-introduction (commit-id-string commit1) (openpgp-public-key-fingerprint (read-openpgp-packet - %ed25519-public-key-file)) - #f)) ;no signature + %ed25519-public-key-file)))) (channel (channel (name 'example) (url (string-append "file://" directory)) (introduction intro)))) -- cgit v1.2.3 From 6d39f0cb7791ff1a6feb0084dad9851a820a900c Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Thu, 25 Jun 2020 17:50:48 +0200 Subject: guix describe: Display channel introductions and add 'channels-sans-intro'. * guix/scripts/describe.scm (%available-formats): Add "channels-sans-intro". (channel->sexp): Add #:include-introduction?. Emit CHANNEL's intro if INCLUDE-INTRODUCTION? is true and CHANNEL has an introduction. (channel->json): Include CHANNEL's introduction, if any. (channel->recutils): Likewise. (display-profile-info): Add 'channels-sans-intro' case. * doc/guix.texi (Invoking guix describe): Add introduction in example. Add 'channels-sans-intro' case. --- doc/guix.texi | 13 ++++++++++- guix/scripts/describe.scm | 56 ++++++++++++++++++++++++++++++++++++++--------- 2 files changed, 58 insertions(+), 11 deletions(-) (limited to 'doc') diff --git a/doc/guix.texi b/doc/guix.texi index 67c86de4b6..c3dd977860 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -4608,7 +4608,12 @@ $ guix describe -f channels (name 'guix) (url "https://git.savannah.gnu.org/git/guix.git") (commit - "e0fa68c7718fffd33d81af415279d6ddb518f727"))) + "e0fa68c7718fffd33d81af415279d6ddb518f727") + (introduction + (make-channel-introduction + "9edb3f66fd807b096b48283debdcddccfea34bad" + (openpgp-fingerprint + "BBB0 2DDF 2CEA F6A8 0D1D E643 A2A0 6DF2 A33A 54FA"))))) @end example @noindent @@ -4634,6 +4639,12 @@ produce human-readable output; produce a list of channel specifications that can be passed to @command{guix pull -C} or installed as @file{~/.config/guix/channels.scm} (@pxref{Invoking guix pull}); +@item channels-sans-intro +like @code{channels}, but omit the @code{introduction} field; use it to +produce a channel specification suitable for Guix version 1.1.0 or +earlier---the @code{introduction} field has to do with channel +authentication (@pxref{Channels, Channel Authentication}) and is not +supported by these older versions; @item json @cindex JSON produce a list of channel specifications in JSON format; diff --git a/guix/scripts/describe.scm b/guix/scripts/describe.scm index ea982955da..bc868ffbbf 100644 --- a/guix/scripts/describe.scm +++ b/guix/scripts/describe.scm @@ -26,9 +26,11 @@ #:use-module (guix scripts) #:use-module (guix describe) #:use-module (guix profiles) + #:autoload (guix openpgp) (openpgp-format-fingerprint) #:use-module (git) #:use-module (json) #:use-module (srfi srfi-1) + #:use-module (srfi srfi-26) #:use-module (srfi srfi-37) #:use-module (ice-9 match) #:use-module (ice-9 format) @@ -43,7 +45,8 @@ ;;; ;;; Command-line options. ;;; -(define %available-formats '("human" "channels" "json" "recutils")) +(define %available-formats + '("human" "channels" "channels-sans-intro" "json" "recutils")) (define (list-formats) (display (G_ "The available formats are:\n")) @@ -110,21 +113,50 @@ Display information about the channels currently in use.\n")) (_ (warning (G_ "'GUIX_PACKAGE_PATH' is set but it is not captured~%"))))))) -(define (channel->sexp channel) - `(channel - (name ',(channel-name channel)) - (url ,(channel-url channel)) - (commit ,(channel-commit channel)))) +(define* (channel->sexp channel #:key (include-introduction? #t)) + (let ((intro (and include-introduction? + (channel-introduction channel)))) + `(channel + (name ',(channel-name channel)) + (url ,(channel-url channel)) + (commit ,(channel-commit channel)) + ,@(if intro + `((introduction (make-channel-introduction + ,(channel-introduction-first-signed-commit intro) + (openpgp-fingerprint + ,(openpgp-format-fingerprint + (channel-introduction-first-commit-signer + intro)))))) + '())))) (define (channel->json channel) - (scm->json-string `((name . ,(channel-name channel)) - (url . ,(channel-url channel)) - (commit . ,(channel-commit channel))))) + (scm->json-string + (let ((intro (channel-introduction channel))) + `((name . ,(channel-name channel)) + (url . ,(channel-url channel)) + (commit . ,(channel-commit channel)) + ,@(if intro + `((introduction + . ((commit . ,(channel-introduction-first-signed-commit + intro)) + (signer . ,(openpgp-format-fingerprint + (channel-introduction-first-commit-signer + intro)))))) + '()))))) (define (channel->recutils channel port) + (define intro + (channel-introduction channel)) + (format port "name: ~a~%" (channel-name channel)) (format port "url: ~a~%" (channel-url channel)) - (format port "commit: ~a~%" (channel-commit channel))) + (format port "commit: ~a~%" (channel-commit channel)) + (when intro + (format port "introductioncommit: ~a~%" + (channel-introduction-first-signed-commit intro)) + (format port "introductionsigner: ~a~%" + (openpgp-format-fingerprint + (channel-introduction-first-commit-signer intro))))) (define (display-checkout-info fmt) "Display information about the current checkout according to FMT, a symbol @@ -182,6 +214,10 @@ in the format specified by FMT." (display-profile-content profile number)) ('channels (pretty-print `(list ,@(map channel->sexp channels)))) + ('channels-sans-intro + (pretty-print `(list ,@(map (cut channel->sexp <> + #:include-introduction? #f) + channels)))) ('json (format #t "[~a]~%" (string-join (map channel->json channels) ","))) ('recutils -- cgit v1.2.3 From d774c7b1218a3cc20079b19812da119f9ed26b54 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Wed, 1 Jul 2020 23:32:25 +0200 Subject: channels: Dependencies listed in '.guix-channel' can have an introduction. Suggested by Ricardo Wurmus and Simon Tournier. * guix/channels.scm (sexp->channel-introduction): New procedure. (read-channel-metadata): Use it. (profile-channels)[sexp->channel-introduction]: Remove. * tests/channels.scm ("latest-channel-instances, authenticate dependency"): New test. * doc/guix.texi (Channels)[Declaring Channel Dependencies]: Augment example. --- doc/guix.texi | 10 +++++++++- guix/channels.scm | 20 +++++++++++--------- tests/channels.scm | 50 ++++++++++++++++++++++++++++++++++++++++++++++++++ 3 files changed, 70 insertions(+), 10 deletions(-) (limited to 'doc') diff --git a/doc/guix.texi b/doc/guix.texi index c3dd977860..7823367605 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -4160,7 +4160,15 @@ The meta-data file should contain a simple S-expression like this: (dependencies (channel (name some-collection) - (url "https://example.org/first-collection.git")) + (url "https://example.org/first-collection.git") + + ;; The 'introduction' bit below is optional: you would + ;; provide it for dependencies that can be authenticated. + (introduction + (channel-introduction + (version 0) + (commit "a8883b58dc82e167c96506cf05095f37c2c2c6cd") + (signer "CABB A931 C0FF EEC6 900D 0CFB 090B 1199 3D9A EBB5")))) (channel (name some-other-collection) (url "https://example.org/second-collection.git") diff --git a/guix/channels.scm b/guix/channels.scm index 32ada7bbc6..500c956f0f 100644 --- a/guix/channels.scm +++ b/guix/channels.scm @@ -223,6 +223,14 @@ introduction, add it." (#f `(branch . ,(channel-branch channel))) (commit `(commit . ,(channel-commit channel))))) +(define sexp->channel-introduction + (match-lambda + (('channel-introduction ('version 0) + ('commit commit) ('signer signer) + _ ...) + (make-channel-introduction commit (openpgp-fingerprint signer))) + (x #f))) + (define (read-channel-metadata port) "Read from PORT channel metadata in the format expected for the '.guix-channel' file. Return a record, or raise an error @@ -250,7 +258,9 @@ if valid metadata could not be read from PORT." (name name) (branch branch) (url url) - (commit (get 'commit)))))) + (commit (get 'commit)) + (introduction (and=> (get 'introduction) + sexp->channel-introduction)))))) dependencies) news-file keyring-reference @@ -948,14 +958,6 @@ to 'latest-channel-instances'." (define (profile-channels profile) "Return the list of channels corresponding to entries in PROFILE. If PROFILE is not a profile created by 'guix pull', return the empty list." - (define sexp->channel-introduction - (match-lambda - (('channel-introduction ('version 0) - ('commit commit) ('signer signer) - _ ...) - (make-channel-introduction commit (openpgp-fingerprint signer))) - (x #f))) - (filter-map (lambda (entry) (match (assq 'source (manifest-entry-properties entry)) (('source ('repository ('version 0) diff --git a/tests/channels.scm b/tests/channels.scm index 7e593b84c4..cde3b668fb 100644 --- a/tests/channels.scm +++ b/tests/channels.scm @@ -536,4 +536,54 @@ #:keyring-reference-prefix "") 'failed))))))) +(unless (gpg+git-available?) (test-skip 1)) +(test-equal "latest-channel-instances, authenticate dependency" + #t + ;; Make sure that a channel dependency that has an introduction is + ;; authenticated. This test checks that an authentication error is raised + ;; as it should when authenticating the dependency. + (with-fresh-gnupg-setup (list %ed25519-public-key-file + %ed25519-secret-key-file) + (with-temporary-git-repository dependency-directory + `((add ".guix-channel" + ,(object->string + '(channel (version 0) + (keyring-reference "master")))) + (add ".guix-authorizations" + ,(object->string + `(authorizations (version 0) ()))) + (add "signer.key" ,(call-with-input-file %ed25519-public-key-file + get-string-all)) + (commit "zeroth commit" + (signer ,(key-fingerprint %ed25519-public-key-file))) + (add "foo.txt" "evil") + (commit "unsigned commit")) + (with-repository dependency-directory dependency + (let* ((commit0 (find-commit dependency "zeroth")) + (commit1 (find-commit dependency "unsigned")) + (intro `(channel-introduction + (version 0) + (commit ,(commit-id-string commit0)) + (signer ,(openpgp-format-fingerprint + (openpgp-public-key-fingerprint + (read-openpgp-packet + %ed25519-public-key-file))))))) + (with-temporary-git-repository directory + `((add ".guix-channel" + ,(object->string + `(channel (version 0) + (dependencies + (channel + (name test-channel) + (url ,dependency-directory) + (introduction ,intro)))))) + (commit "single commit")) + (let ((channel (channel (name 'test) (url directory)))) + (guard (c ((unsigned-commit-error? c) + (oid=? (git-authentication-error-commit c) + (commit-id commit1)))) + (with-store store + (latest-channel-instances store (list channel)) + 'failed))))))))) + (test-end "channels") -- cgit v1.2.3 From 4d06076714f03da55d09efede055f0c40da3403e Mon Sep 17 00:00:00 2001 From: Marius Bakke Date: Thu, 25 Jun 2020 00:33:38 +0200 Subject: services: wpa-supplicant: Support specifying additional service dependencies. * gnu/services/networking.scm ()[requirement]: New parameter. (wpa-supplicant-shepherd-service): Use it instead of hard-coded list. * doc/guix.texi (Networking Services): Document accordingly. --- doc/guix.texi | 3 +++ gnu/services/networking.scm | 9 ++++++--- 2 files changed, 9 insertions(+), 3 deletions(-) (limited to 'doc') diff --git a/doc/guix.texi b/doc/guix.texi index 7823367605..ce17c2de8e 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -14172,6 +14172,9 @@ It takes the following parameters: @item @code{wpa-supplicant} (default: @code{wpa-supplicant}) The WPA Supplicant package to use. +@item @code{requirement} (default: @code{'(user-processes dbus-system loopback syslogd)} +List of services that should be started before WPA Supplicant starts. + @item @code{dbus?} (default: @code{#t}) Whether to listen for requests on D-Bus. diff --git a/gnu/services/networking.scm b/gnu/services/networking.scm index bd01df1ba7..348dc369d8 100644 --- a/gnu/services/networking.scm +++ b/gnu/services/networking.scm @@ -133,6 +133,7 @@ wpa-supplicant-configuration wpa-supplicant-configuration? wpa-supplicant-configuration-wpa-supplicant + wpa-supplicant-configuration-requirement wpa-supplicant-configuration-pid-file wpa-supplicant-configuration-dbus? wpa-supplicant-configuration-interface @@ -1319,6 +1320,8 @@ whatever the thing is supposed to do)."))) wpa-supplicant-configuration? (wpa-supplicant wpa-supplicant-configuration-wpa-supplicant ; (default wpa-supplicant)) + (requirement wpa-supplicant-configuration-requirement ;list of symbols + (default '(user-processes dbus-system loopback syslogd))) (pid-file wpa-supplicant-configuration-pid-file ;string (default "/var/run/wpa_supplicant.pid")) (dbus? wpa-supplicant-configuration-dbus? ;Boolean @@ -1332,12 +1335,12 @@ whatever the thing is supposed to do)."))) (define wpa-supplicant-shepherd-service (match-lambda - (($ wpa-supplicant pid-file dbus? interface - config-file extra-options) + (($ wpa-supplicant requirement pid-file dbus? + interface config-file extra-options) (list (shepherd-service (documentation "Run the WPA supplicant daemon") (provision '(wpa-supplicant)) - (requirement '(user-processes dbus-system loopback syslogd)) + (requirement requirement) (start #~(make-forkexec-constructor (list (string-append #$wpa-supplicant "/sbin/wpa_supplicant") -- cgit v1.2.3 From 60941b94e25853424262931a781c0e90835a40e0 Mon Sep 17 00:00:00 2001 From: Arun Isaac Date: Sun, 5 Jul 2020 15:43:03 +0530 Subject: doc: Fix minor typo in Programming Interface. * doc/guix.texi (Programming Interface): Replace "under a specific build users" with "under specific build users". --- doc/guix.texi | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'doc') diff --git a/doc/guix.texi b/doc/guix.texi index ce17c2de8e..b0d31f1bab 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -5616,7 +5616,7 @@ turned into concrete build actions. Build actions are performed by the Guix daemon, on behalf of users. In a standard setup, the daemon has write access to the store---the @file{/gnu/store} directory---whereas users do not. The recommended -setup also has the daemon perform builds in chroots, under a specific +setup also has the daemon perform builds in chroots, under specific build users, to minimize interference with the rest of the system. @cindex derivation -- cgit v1.2.3 From dffc82fa55f4a1fd710c84088d118d9e6a8472b3 Mon Sep 17 00:00:00 2001 From: Arun Isaac Date: Sun, 5 Jul 2020 19:33:52 +0530 Subject: doc: Fix minor typo in X Window. * doc/guix.texi (X Window): Replace "not" with "no". --- doc/guix.texi | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'doc') diff --git a/doc/guix.texi b/doc/guix.texi index b0d31f1bab..62e8bc9d68 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -15458,7 +15458,7 @@ auto-login session. @cindex Xorg, configuration @deftp {Data Type} xorg-configuration This data type represents the configuration of the Xorg graphical display -server. Note that there is not Xorg service; instead, the X server is started +server. Note that there is no Xorg service; instead, the X server is started by a ``display manager'' such as GDM, SDDM, and SLiM. Thus, the configuration of these display managers aggregates an @code{xorg-configuration} record. -- cgit v1.2.3 From 332f0a4685e1ec837ba4bc7838e26038d8cf69a2 Mon Sep 17 00:00:00 2001 From: Arun Isaac Date: Sun, 5 Jul 2020 13:55:15 +0530 Subject: doc: Fix texinfo identifiers in Version Control Services. * doc/guix.texi (Version Control Services): Use @code, @command, @file, @indicateurl, @samp texinfo identifiers correctly. --- doc/guix.texi | 48 +++++++++++++++++++++++++----------------------- 1 file changed, 25 insertions(+), 23 deletions(-) (limited to 'doc') diff --git a/doc/guix.texi b/doc/guix.texi index 62e8bc9d68..992bc303bb 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -52,7 +52,7 @@ Copyright @copyright{} 2017, 2019, 2020 Maxim Cournoyer@* Copyright @copyright{} 2017, 2018, 2019, 2020 Tobias Geerinckx-Rice@* Copyright @copyright{} 2017 George Clemmer@* Copyright @copyright{} 2017 Andy Wingo@* -Copyright @copyright{} 2017, 2018, 2019 Arun Isaac@* +Copyright @copyright{} 2017, 2018, 2019, 2020 Arun Isaac@* Copyright @copyright{} 2017 nee@* Copyright @copyright{} 2018 Rutger Helling@* Copyright @copyright{} 2018 Oleg Pykhalov@* @@ -24926,39 +24926,41 @@ access to exported@footnote{By creating the magic file Data type representing the configuration for @code{git-daemon-service}. @table @asis -@item @code{package} (default: @var{git}) +@item @code{package} (default: @code{git}) Package object of the Git distributed version control system. -@item @code{export-all?} (default: @var{#f}) +@item @code{export-all?} (default: @code{#f}) Whether to allow access for all Git repositories, even if they do not have the @file{git-daemon-export-ok} file. @item @code{base-path} (default: @file{/srv/git}) Whether to remap all the path requests as relative to the given path. -If you run git daemon with @var{(base-path "/srv/git")} on example.com, -then if you later try to pull @code{git://example.com/hello.git}, git -daemon will interpret the path as @code{/srv/git/hello.git}. +If you run @command{git daemon} with @code{(base-path "/srv/git")} on +@samp{example.com}, then if you later try to pull +@indicateurl{git://example.com/hello.git}, git daemon will interpret the +path as @file{/srv/git/hello.git}. -@item @code{user-path} (default: @var{#f}) +@item @code{user-path} (default: @code{#f}) Whether to allow @code{~user} notation to be used in requests. When -specified with empty string, requests to @code{git://host/~alice/foo} is -taken as a request to access @code{foo} repository in the home directory -of user @code{alice}. If @var{(user-path "path")} is specified, the -same request is taken as a request to access @code{path/foo} repository -in the home directory of user @code{alice}. - -@item @code{listen} (default: @var{'()}) +specified with empty string, requests to +@indicateurl{git://host/~alice/foo} is taken as a request to access +@code{foo} repository in the home directory of user @code{alice}. If +@code{(user-path "@var{path}")} is specified, the same request is taken +as a request to access @file{@var{path}/foo} repository in the home +directory of user @code{alice}. + +@item @code{listen} (default: @code{'()}) Whether to listen on specific IP addresses or hostnames, defaults to all. -@item @code{port} (default: @var{#f}) +@item @code{port} (default: @code{#f}) Whether to listen on an alternative port, which defaults to 9418. -@item @code{whitelist} (default: @var{'()}) +@item @code{whitelist} (default: @code{'()}) If not empty, only allow access to this list of directories. -@item @code{extra-options} (default: @var{'()}) -Extra options will be passed to @code{git daemon}, please run +@item @code{extra-options} (default: @code{'()}) +Extra options will be passed to @command{git daemon}, please run @command{man git-daemon} for more information. @end table @@ -24990,14 +24992,14 @@ Package object of the Git distributed version control system. @item @code{git-root} (default: @file{/srv/git}) Directory containing the Git repositories to expose to the world. -@item @code{export-all?} (default: @var{#f}) +@item @code{export-all?} (default: @code{#f}) Whether to expose access for all Git repositories in @var{git-root}, even if they do not have the @file{git-daemon-export-ok} file. -@item @code{uri-path} (default: @file{/git/}) -Path prefix for Git access. With the default @code{/git/} prefix, this -will map @code{http://@var{server}/git/@var{repo}.git} to -@code{/srv/git/@var{repo}.git}. Requests whose URI paths do not begin +@item @code{uri-path} (default: @samp{/git/}) +Path prefix for Git access. With the default @samp{/git/} prefix, this +will map @indicateurl{http://@var{server}/git/@var{repo}.git} to +@file{/srv/git/@var{repo}.git}. Requests whose URI paths do not begin with this prefix are not passed on to this Git instance. @item @code{fcgiwrap-socket} (default: @code{127.0.0.1:9000}) -- cgit v1.2.3 From e892b9c3dc7915b77e7aa56a066dfdc856a7d69b Mon Sep 17 00:00:00 2001 From: Tobias Geerinckx-Rice Date: Thu, 9 Jul 2020 16:38:37 +0200 Subject: doc: cookbook: Fix ‘file system’ spelling. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * doc/guix-cookbook.texi (Getting help, Customizing the Kernel): Fix ‘file system’ spelling. --- doc/guix-cookbook.texi | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) (limited to 'doc') diff --git a/doc/guix-cookbook.texi b/doc/guix-cookbook.texi index 13ec2976a6..f541592d13 100644 --- a/doc/guix-cookbook.texi +++ b/doc/guix-cookbook.texi @@ -1288,7 +1288,7 @@ version or compilation options. @subsection Getting help Sadly, some applications can be tough to package. Sometimes they need a patch to -work with the non-standard filesystem hierarchy enforced by the store. +work with the non-standard file system hierarchy enforced by the store. Sometimes the tests won't run properly. (They can be skipped but this is not recommended.) Other times the resulting package won't be reproducible. @@ -1501,7 +1501,7 @@ custom kernel: @lisp (define %macbook41-full-config (append %macbook41-config-options - %filesystems + %file-systems %efi-support %emulation (@@@@ (gnu packages linux) %default-extra-linux-options))) @@ -1517,8 +1517,8 @@ custom kernel: #:extra-options %macbook41-config-options)) @end lisp -In the above example @code{%filesystems} is a collection of flags enabling -different filesystem support, @code{%efi-support} enables EFI support and +In the above example @code{%file-systems} is a collection of flags enabling +different file system support, @code{%efi-support} enables EFI support and @code{%emulation} enables a x86_64-linux machine to act in 32-bit mode also. @code{%default-extra-linux-options} are the ones quoted above, which had to be added in since they were replaced in the @code{extra-options} keyword. @@ -1582,7 +1582,7 @@ The second way to setup the kernel configuration makes more use of Guix's features and allows you to share configuration segments between different kernels. For example, all machines using EFI to boot have a number of EFI configuration flags that they need. It is likely that all the kernels will -share a list of filesystems to support. By using variables it is easier to +share a list of file systems to support. By using variables it is easier to see at a glance what features are enabled and to make sure you don't have features in one kernel but missing in another. -- cgit v1.2.3 From 4f4fb2151ef131c4bfccadb362a91319034968c8 Mon Sep 17 00:00:00 2001 From: Tobias Geerinckx-Rice Date: Thu, 9 Jul 2020 16:49:03 +0200 Subject: doc: Fix typo. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * doc/contributing.texi (The Perfect Setup): Fix spelling & placement of ‘additionally’. --- doc/contributing.texi | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'doc') diff --git a/doc/contributing.texi b/doc/contributing.texi index 2a73d2c47a..4049073b96 100644 --- a/doc/contributing.texi +++ b/doc/contributing.texi @@ -277,7 +277,7 @@ trigger string @code{origin...}, which can be expanded further. The @cindex insert or update copyright @cindex @code{M-x guix-copyright} @cindex @code{M-x copyright-update} -Additionaly we provide insertion and automatic update of a copyright in +We additionally provide insertion and automatic update of a copyright in @file{etc/copyright.el}. You may want to set your full name, mail, and load a file. -- cgit v1.2.3 From a98712785e0b042a290420fd74e5a4a5da4fc68f Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Sun, 5 Jul 2020 23:40:29 +0200 Subject: Add 'guix git authenticate'. * guix/scripts/git.scm, guix/scripts/git/authenticate.scm, tests/guix-git-authenticate.sh: New files. * Makefile.am (MODULES): Add the *.scm files. (SH_TESTS): Add 'tests/guix-git-authenticate.sh'. * doc/guix.texi (Channels)[Specifying Channel Authorizations]: Mention 'guix git authenticate'. (Invoking guix git authenticate): New node. * po/guix/POTFILES.in: Add 'guix/scripts/git.scm' and 'guix/scripts/git/authenticate.scm'. --- Makefile.am | 3 + doc/guix.texi | 83 +++++++++++++++++- guix/scripts/git.scm | 63 ++++++++++++++ guix/scripts/git/authenticate.scm | 179 ++++++++++++++++++++++++++++++++++++++ po/guix/POTFILES.in | 2 + tests/guix-git-authenticate.sh | 56 ++++++++++++ 6 files changed, 383 insertions(+), 3 deletions(-) create mode 100644 guix/scripts/git.scm create mode 100644 guix/scripts/git/authenticate.scm create mode 100644 tests/guix-git-authenticate.sh (limited to 'doc') diff --git a/Makefile.am b/Makefile.am index 47699351b9..20bfaba88b 100644 --- a/Makefile.am +++ b/Makefile.am @@ -281,6 +281,8 @@ MODULES = \ guix/scripts/publish.scm \ guix/scripts/edit.scm \ guix/scripts/size.scm \ + guix/scripts/git.scm \ + guix/scripts/git/authenticate.scm \ guix/scripts/graph.scm \ guix/scripts/weather.scm \ guix/scripts/container.scm \ @@ -463,6 +465,7 @@ SH_TESTS = \ tests/guix-build-branch.sh \ tests/guix-download.sh \ tests/guix-gc.sh \ + tests/guix-git-authenticate.sh \ tests/guix-hash.sh \ tests/guix-pack.sh \ tests/guix-pack-localstatedir.sh \ diff --git a/doc/guix.texi b/doc/guix.texi index 992bc303bb..17338ed764 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -3981,6 +3981,7 @@ Before that, some security considerations. @subsection Channel Authentication +@anchor{channel-authentication} @cindex authentication, of channel code The @command{guix pull} and @command{guix time-machine} commands @dfn{authenticate} the code retrieved from channels: they make sure each @@ -4200,6 +4201,7 @@ add a meta-data file @file{.guix-channel} that contains: @cindex channel authorizations @subsection Specifying Channel Authorizations +@anchor{channel-authorizations} As we saw above, Guix ensures the source code it pulls from channels comes from authorized developers. As a channel author, you need to specify the list of authorized developers in the @@ -4259,6 +4261,18 @@ pair---i.e., the commit that introduced @file{.guix-authorizations}, and the fingerprint of the OpenPGP used to sign it. @end enumerate +Before pushing to your public Git repository, you can run @command{guix +git-authenticate} to verify that you did sign all the commits you are +about to push with an authorized key: + +@example +guix git authenticate @var{commit} @var{signer} +@end example + +@noindent +where @var{commit} and @var{signer} are your channel introduction. +@xref{Invoking guix git authenticate}, for details. + Publishing a signed channel requires discipline: any mistake, such as an unsigned commit or a commit signed by an unauthorized key, will prevent users from pulling from your channel---well, that's the whole point of @@ -4862,9 +4876,10 @@ pack} command allows you to create @dfn{application bundles} that can be easily distributed to users who do not run Guix. @menu -* Invoking guix environment:: Setting up development environments. -* Invoking guix pack:: Creating software bundles. -* The GCC toolchain:: Working with languages supported by GCC. +* Invoking guix environment:: Setting up development environments. +* Invoking guix pack:: Creating software bundles. +* The GCC toolchain:: Working with languages supported by GCC. +* Invoking guix git authenticate:: Authenticating Git repositories. @end menu @node Invoking guix environment @@ -5602,6 +5617,68 @@ The package @code{gfortran-toolchain} provides a complete GCC toolchain for Fortran development. For other languages, please use @samp{guix search gcc toolchain} (@pxref{guix-search,, Invoking guix package}). + +@node Invoking guix git authenticate +@section Invoking @command{guix git authenticate} + +The @command{guix git authenticate} command authenticates a Git checkout +following the same rule as for channels (@pxref{channel-authentication, +channel authentication}). That is, starting from a given commit, it +ensures that all subsequent commits are signed by an OpenPGP key whose +fingerprint appears in the @file{.guix-authorizations} file of its +parent commit(s). + +You will find this command useful if you maintain a channel. But in +fact, this authentication mechanism is useful in a broader context, so +you might want to use it for Git repositories that have nothing to do +with Guix. + +The general syntax is: + +@example +guix git authenticate @var{commit} @var{signer} [@var{options}@dots{}] +@end example + +By default, this command authenticates the Git checkout in the current +directory; it outputs nothing and exits with exit code zero on success +and non-zero on failure. @var{commit} above denotes the first commit +where authentication takes place, and @var{signer} is the OpenPGP +fingerprint of public key used to sign @var{commit}. Together, they +form a ``channel introduction'' (@pxref{channel-authentication, channel +introduction}). The options below allow you to fine-tune the process. + +@table @code +@item --repository=@var{directory} +@itemx -r @var{directory} +Open the Git repository in @var{directory} instead of the current +directory. + +@item --keyring=@var{reference} +@itemx -k @var{reference} +Load OpenPGP keyring from @var{reference}, the reference of a branch +such as @code{origin/keyring} or @code{my-keyring}. The branch must +contain OpenPGP public keys in @file{.key} files, either in binary form +or ``ASCII-armored''. By default the keyring is loaded from the branch +named @code{keyring}. + +@item --stats +Display commit signing statistics upon completion. + +@item --cache-key=@var{key} +Previously-authenticated commits are cached in a file under +@file{~/.cache/guix/authentication}. This option forces the cache to be +stored in file @var{key} in that directory. + +@item --historical-authorizations=@var{file} +By default, any commit whose parent commit(s) lack the +@file{.guix-authorizations} file is considered inauthentic. In +contrast, this option considers the authorizations in @var{file} for any +commit that lacks @file{.guix-authorizations}. The format of @var{file} +is the same as that of @file{.guix-authorizations} +(@pxref{channel-authorizations, @file{.guix-authorizations} format}). +@end table + + @c ********************************************************************* @node Programming Interface @chapter Programming Interface diff --git a/guix/scripts/git.scm b/guix/scripts/git.scm new file mode 100644 index 0000000000..bc829cbe99 --- /dev/null +++ b/guix/scripts/git.scm @@ -0,0 +1,63 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2020 Ludovic Courtès +;;; +;;; This file is part of GNU Guix. +;;; +;;; GNU Guix 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 of the License, or (at +;;; your option) any later version. +;;; +;;; GNU Guix 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 GNU Guix. If not, see . + +(define-module (guix scripts git) + #:use-module (ice-9 match) + #:use-module (guix ui) + #:export (guix-git)) + +(define (show-help) + (display (G_ "Usage: guix git COMMAND ARGS... +Operate on Git repositories.\n")) + (newline) + (display (G_ "The valid values for ACTION are:\n")) + (newline) + (display (G_ "\ + authenticate verify commit signatures and authorizations\n")) + (newline) + (display (G_ " + -h, --help display this help and exit")) + (display (G_ " + -V, --version display version information and exit")) + (newline) + (show-bug-report-information)) + +(define %sub-commands '("authenticate")) + +(define (resolve-sub-command name) + (let ((module (resolve-interface + `(guix scripts git ,(string->symbol name)))) + (proc (string->symbol (string-append "guix-git-" name)))) + (module-ref module proc))) + +(define (guix-git . args) + (with-error-handling + (match args + (() + (format (current-error-port) + (G_ "guix git: missing sub-command~%"))) + ((or ("-h") ("--help")) + (show-help) + (exit 0)) + ((or ("-V") ("--version")) + (show-version-and-exit "guix git")) + ((sub-command args ...) + (if (member sub-command %sub-commands) + (apply (resolve-sub-command sub-command) args) + (format (current-error-port) + (G_ "guix git: invalid sub-command~%"))))))) diff --git a/guix/scripts/git/authenticate.scm b/guix/scripts/git/authenticate.scm new file mode 100644 index 0000000000..5f5d423f28 --- /dev/null +++ b/guix/scripts/git/authenticate.scm @@ -0,0 +1,179 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2020 Ludovic Courtès +;;; +;;; This file is part of GNU Guix. +;;; +;;; GNU Guix 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 of the License, or (at +;;; your option) any later version. +;;; +;;; GNU Guix 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 GNU Guix. If not, see . + +(define-module (guix scripts git authenticate) + #:use-module (git) + #:use-module (guix ui) + #:use-module (guix scripts) + #:use-module (guix git-authenticate) + #:autoload (guix openpgp) (openpgp-format-fingerprint + openpgp-public-key-fingerprint) + #:use-module ((guix channels) #:select (openpgp-fingerprint)) + #:use-module ((guix git) #:select (with-git-error-handling)) + #:use-module (guix progress) + #:use-module (guix base64) + #:use-module (srfi srfi-1) + #:use-module (srfi srfi-26) + #:use-module (srfi srfi-37) + #:use-module (ice-9 format) + #:use-module (ice-9 match) + #:export (guix-git-authenticate)) + +;;; Commentary: +;;; +;;; Authenticate a Git checkout by reading '.guix-authorizations' files and +;;; following the "authorizations invariant" also used by (guix channels). +;;; +;;; Code: + +(define %options + ;; Specifications of the command-line options. + (list (option '(#\h "help") #f #f + (lambda args + (show-help) + (exit 0))) + (option '(#\V "version") #f #f + (lambda args + (show-version-and-exit "guix git authenticate"))) + + (option '(#\r "repository") #t #f + (lambda (opt name arg result) + (alist-cons 'directory arg result))) + (option '(#\e "end") #t #f + (lambda (opt name arg result) + (alist-cons 'end-commit (string->oid arg) result))) + (option '(#\k "keyring") #t #f + (lambda (opt name arg result) + (alist-cons 'keyring-reference arg result))) + (option '("cache-key") #t #f + (lambda (opt name arg result) + (alist-cons 'cache-key arg result))) + (option '("historical-authorizations") #t #f + (lambda (opt name arg result) + (alist-cons 'historical-authorizations arg + result))) + (option '("stats") #f #f + (lambda (opt name arg result) + (alist-cons 'show-stats? #t result))))) + +(define %default-options + '((directory . ".") + (keyring-reference . "keyring"))) + +(define (show-stats stats) + "Display STATS, an alist containing commit signing stats as returned by +'authenticate-repository'." + (format #t (G_ "Signing statistics:~%")) + (for-each (match-lambda + ((signer . count) + (format #t " ~a ~10d~%" + (openpgp-format-fingerprint + (openpgp-public-key-fingerprint signer)) + count))) + (sort stats + (match-lambda* + (((_ . count1) (_ . count2)) + (> count1 count2)))))) + +(define (show-help) + (display (G_ "Usage: guix git authenticate COMMIT SIGNER [OPTIONS...] +Authenticate the given Git checkout using COMMIT/SIGNER as its introduction.\n")) + (display (G_ " + -r, --repository=DIRECTORY + open the Git repository at DIRECTORY")) + (display (G_ " + -k, --keyring=REFERENCE + load keyring from REFERENCE, a Git branch")) + (display (G_ " + --stats display commit signing statistics upon completion")) + (display (G_ " + --cache-key=KEY cache authenticated commits under KEY")) + (display (G_ " + --historical-authorizations=FILE + read historical authorizations from FILE")) + (newline) + (display (G_ " + -h, --help display this help and exit")) + (display (G_ " + -V, --version display version information and exit")) + (newline) + (show-bug-report-information)) + + +;;; +;;; Entry point. +;;; + +(define (guix-git-authenticate . args) + (define options + (parse-command-line args %options (list %default-options) + #:build-options? #f)) + + (define (command-line-arguments lst) + (reverse (filter-map (match-lambda + (('argument . arg) arg) + (_ #f)) + lst))) + + (define commit-short-id + (compose (cut string-take <> 7) oid->string commit-id)) + + (define (make-reporter start-commit end-commit commits) + (format (current-error-port) + (G_ "Authenticating commits ~a to ~a (~h new \ +commits)...~%") + (commit-short-id start-commit) + (commit-short-id end-commit) + (length commits)) + + (if (isatty? (current-error-port)) + (progress-reporter/bar (length commits)) + progress-reporter/silent)) + + (with-error-handling + (with-git-error-handling + (match (command-line-arguments options) + ((commit signer) + (let* ((directory (assoc-ref options 'directory)) + (show-stats? (assoc-ref options 'show-stats?)) + (keyring (assoc-ref options 'keyring-reference)) + (repository (repository-open directory)) + (end (match (assoc-ref options 'end-commit) + (#f (reference-target + (repository-head repository))) + (oid oid))) + (history (match (assoc-ref options 'historical-authorizations) + (#f '()) + (file (call-with-input-file file + read-authorizations)))) + (cache-key (or (assoc-ref options 'cache-key) + (repository-cache-key repository)))) + (define stats + (authenticate-repository repository (string->oid commit) + (openpgp-fingerprint signer) + #:end end + #:keyring-reference keyring + #:historical-authorizations history + #:cache-key cache-key + #:make-reporter make-reporter)) + + (when (and show-stats? (not (null? stats))) + (show-stats stats)))) + (_ + (leave (G_ "wrong number of arguments; \ +expected COMMIT and SIGNER~%"))))))) diff --git a/po/guix/POTFILES.in b/po/guix/POTFILES.in index 62b3cbf4e4..f4d020782c 100644 --- a/po/guix/POTFILES.in +++ b/po/guix/POTFILES.in @@ -53,6 +53,8 @@ guix/scripts/upgrade.scm guix/scripts/search.scm guix/scripts/show.scm guix/scripts/gc.scm +guix/scripts/git.scm +guix/scripts/git/authenticate.scm guix/scripts/hash.scm guix/scripts/import.scm guix/scripts/import/cran.scm diff --git a/tests/guix-git-authenticate.sh b/tests/guix-git-authenticate.sh new file mode 100644 index 0000000000..1c76e240b5 --- /dev/null +++ b/tests/guix-git-authenticate.sh @@ -0,0 +1,56 @@ +# GNU Guix --- Functional package management for GNU +# Copyright © 2020 Ludovic Courtès +# +# This file is part of GNU Guix. +# +# GNU Guix 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 of the License, or (at +# your option) any later version. +# +# GNU Guix 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 GNU Guix. If not, see . + +# +# Test the 'guix git authenticate' command-line utility. +# + +# Skip if we're not in a Git checkout. +[ -d "$abs_top_srcdir/.git" ] || exit 77 + +# Skip if there's no 'keyring' branch. +guile -c '(use-modules (git)) + (member "refs/heads/keyring" (branch-list (repository-open ".")))' || \ + exit 77 + +# Keep in sync with '%default-channels' in (guix channels)! +intro_commit="9edb3f66fd807b096b48283debdcddccfea34bad" +intro_signer="BBB0 2DDF 2CEA F6A8 0D1D E643 A2A0 6DF2 A33A 54FA" + +cache_key="test-$$" + +guix git authenticate "$intro_commit" "$intro_signer" \ + --cache-key="$cache_key" --stats \ + --end=9549f0283a78fe36f2d4ff2a04ef8ad6b0c02604 + +rm "$XDG_CACHE_HOME/guix/authentication/$cache_key" + +# Commit and signer of the 'v1.0.0' tag. +v1_0_0_commit="6298c3ffd9654d3231a6f25390b056483e8f407c" +v1_0_0_signer="3CE4 6455 8A84 FDC6 9DB4 0CFB 090B 1199 3D9A EBB5" # civodul +v1_0_1_commit="d68de958b60426798ed62797ff7c96c327a672ac" + +# This should fail because these commits lack '.guix-authorizations'. +if guix git authenticate "$v1_0_0_commit" "$v1_0_0_signer" \ + --cache-key="$cache_key" --end="$v1_0_1_commit"; +then false; else true; fi + +# This should work thanks to '--historical-authorizations'. +guix git authenticate "$v1_0_0_commit" "$v1_0_0_signer" \ + --cache-key="$cache_key" --end="$v1_0_1_commit" --stats \ + --historical-authorizations="$abs_top_srcdir/etc/historical-authorizations" -- cgit v1.2.3 From 9a622827559b223cc6b48733a82c74ce14a29bab Mon Sep 17 00:00:00 2001 From: Marius Bakke Date: Sat, 4 Jul 2020 00:30:19 +0200 Subject: services: Add ganeti. * gnu/services/ganeti.scm, gnu/tests/ganeti.scm: New files. * doc/guix.texi (Virtualization Services): Document the Ganeti services. --- doc/guix.texi | 646 +++++++++++++++++++++++++++ gnu/local.mk | 2 + gnu/services/ganeti.scm | 1109 +++++++++++++++++++++++++++++++++++++++++++++++ gnu/tests/ganeti.scm | 265 +++++++++++ 4 files changed, 2022 insertions(+) create mode 100644 gnu/services/ganeti.scm create mode 100644 gnu/tests/ganeti.scm (limited to 'doc') diff --git a/doc/guix.texi b/doc/guix.texi index 17338ed764..a6ee679b11 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -24975,6 +24975,652 @@ the @code{--snapshot} flag using something along these lines: (options '("--hda")))) @end lisp +@subsubheading Ganeti + +@cindex ganeti + +@quotation Note +This service is considered experimental. Configuration options may be changed +in a backwards-incompatible manner, and not all features have been thorougly +tested. Users of this service are encouraged to share their experience at +@email{guix-devel@@gnu.org}. +@end quotation + +Ganeti is a virtual machine management system. It is designed to keep virtual +machines running on a cluster of servers even in the event of hardware failures, +and to make maintenance and recovery tasks easy. It consists of multiple +services which are described later in this section. In addition to the Ganeti +service, you will need the OpenSSH service (@pxref{Networking Services, +@code{openssh-service-type}}), and update the @file{/etc/hosts} file +(@pxref{operating-system Reference, @code{hosts-file}}) with the cluster name +and address (or use a DNS server). + +All nodes participating in a Ganeti cluster should have the same Ganeti and +@file{/etc/hosts} configuration. Here is an example configuration for a Ganeti +cluster node that supports multiple storage backends, and installs the +@code{debootstrap} and @code{guix} @dfn{OS providers}: + +@lisp +(use-package-modules virtualization) +(use-service-modules base ganeti networking ssh) +(operating-system + ;; @dots{} + (host-name "node1") + (hosts-file (plain-file "hosts" (format #f " +127.0.0.1 localhost +::1 localhost + +192.168.1.200 ganeti.example.com +192.168.1.201 node1.example.com node1 +192.168.1.202 node2.example.com node2 +"))) + + ;; Install QEMU so we can use KVM-based instances, and LVM, DRBD and Ceph + ;; in order to use the "plain", "drbd" and "rbd" storage backends. + (packages (append (map specification->package + '("qemu" "lvm2" "drbd-utils" "ceph" + ;; Add the debootstrap and guix OS providers. + "ganeti-instance-guix" "ganeti-instance-debootstrap")) + %base-packages)) + (services + (append (list (static-networking-service "eth0" "192.168.1.201" + #:netmask "255.255.255.0" + #:gateway "192.168.1.254" + #:name-servers '("192.168.1.252" + "192.168.1.253")) + + ;; Ganeti uses SSH to communicate between nodes. + (service openssh-service-type + (openssh-configuration + (permit-root-login 'without-password))) + + (service ganeti-service-type + (ganeti-configuration + ;; This list specifies allowed file system paths + ;; for storing virtual machine images. + (file-storage-paths '("/srv/ganeti/file-storage")) + ;; This variable configures a single "variant" for + ;; both Debootstrap and Guix that works with KVM. + (os %default-ganeti-os)))) + %base-services))) +@end lisp + +Users are advised to read the +@url{http://docs.ganeti.org/ganeti/master/html/admin.html,Ganeti +administrators guide} to learn about the various cluster options and +day-to-day operations. There is also a +@url{https://guix.gnu.org/blog/2020/ganeti-on-guix/,blog post} +describing how to configure a small cluster. + +@defvr {Scheme Variable} ganeti-service-type +This is a service type that includes all the various services that Ganeti +nodes should run. + +Its value is a @code{ganeti-configuration} object that defines the package +to use for CLI operations, as well as configuration for the various daemons. +@end defvr + +@deftp {Data Type} ganeti-configuration +The @code{ganeti} service takes the following configuration options: + +@table @asis +@item @code{ganeti} (default: @code{ganeti}) +The @code{ganeti} package to use. It will be installed to the system profile +and make @command{gnt-cluster}, @command{gnt-instance}, etc available. Note +that the value specified here does not affect the other services as each refer +to a specific @code{ganeti} package (see below). + +@item @code{noded-configuration} (default: @code{(ganeti-noded-configuration)}) +@itemx @code{confd-configuration} (default: @code{(ganeti-confd-configuration)}) +@itemx @code{wconfd-configuration} (default: @code{(ganeti-wconfd-configuration)}) +@itemx @code{luxid-configuration} (default: @code{(ganeti-luxid-configuration)}) +@itemx @code{rapi-configuration} (default: @code{(ganeti-rapi-configuration)}) +@itemx @code{kvmd-configuration} (default: @code{(ganeti-kvmd-configuration)}) +@itemx @code{mond-configuration} (default: @code{(ganeti-mond-configuration)}) +@itemx @code{metad-configuration} (default: @code{(ganeti-metad-configuration)}) +@itemx @code{watcher-configuration} (default: @code{(ganeti-watcher-configuration)}) +@itemx @code{cleaner-configuration} (default: @code{(ganeti-cleaner-configuration)}) + +These options control the various daemons and cron jobs that are distributed +with Ganeti. The possible values for these are described in detail below. +To override a setting, you must use the configuration type for that service: + +@lisp +(service ganeti-service-type + (ganeti-configuration + (rapi-configuration + (ganeti-rapi-configuration + (interface "eth1")))) + (watcher-configuration + (ganeti-watcher-configuration + (rapi-ip "10.0.0.1")))) +@end lisp + +@item @code{file-storage-paths} (default: @code{'()}) +List of allowed directories for file storage backend. + +@item @code{os} (default: @code{%default-ganeti-os}) +List of @code{} records. +@end table + +In essence @code{ganeti-service-type} is shorthand for declaring each service +individually: + +@lisp +(service ganeti-noded-service-type) +(service ganeti-confd-service-type) +(service ganeti-wconfd-service-type) +(service ganeti-luxid-service-type) +(service ganeti-kvmd-service-type) +(service ganeti-mond-service-type) +(service ganeti-metad-service-type) +(service ganeti-watcher-service-type) +(service ganeti-cleaner-service-type) +@end lisp + +Plus a service extension for @code{etc-service-type} that configures the file +storage backend and OS variants. + +@end deftp + +@deftp {Data Type} ganeti-os +This data type is suitable for passing to the @code{os} configuration of +Ganeti. It takes the following parameters: + +@table @asis +@item @code{name} +The name for this OS provider. It is only used to specify where the +configuration ends up. Setting it to ``debootstrap'' will create +@file{/etc/ganeti/instance-debootstrap}. + +@item @code{extension} +The file extension for variants of this OS type. For example +@file{.conf} or @file{.scm}. + +@item @code{variants} (default: @code{'()}) +List of @code{ganeti-os-variant} objects for this OS. + +@end table +@end deftp + +@deftp {Data Type} ganeti-os-variant +This is the data type for a Ganeti OS variant. It takes the following +parameters: + +@table @asis +@item @code{name} +The name of this variant. + +@item @code{configuration} +A configuration file for this variant. +@end table +@end deftp + +@defvr {Scheme Variable} %default-debootstrap-hooks +This variable contains hooks to configure networking and the GRUB bootloader. +@end defvr + +@defvr {Scheme Variable} %default-debootstrap-extra-pkgs +This variable contains a list of packages suitable for a fully-virtualized guest. +@end defvr + +@deftp {Data Type} debootstrap-configuration + +This data type creates configuration files suitable for the debootstrap OS provider. + +@table @asis +@item @code{hooks} (default: @code{%default-debootstrap-hooks}) +When not @code{#f}, this must be a G-expression that specifies a directory with +scripts that will run when the OS is installed. It can also be a list of +@code{(name . file-like)} pairs. For example: + +@lisp + +`((99-hello-world . ,(plain-file "#!/bin/sh\necho Hello, World"))) + +@end lisp + +That will create a directory with one executable named @code{99-hello-world} +and run it every time this variant is installed. If set to @code{#f}, hooks +in @file{/etc/ganeti/instance-debootstrap/hooks} will be used, if any. +@item @code{proxy} (default: @code{#f}) +HTTP proxy to use, if any. +@item @code{mirror} (default: @code{#f}) +The Debian mirror. Typically something like @code{http://ftp.no.debian.org/debian}. +The default varies depending on the distribution. +@item @code{arch} (default: @code{#f}) +The dpkg architecture. Set to @code{armhf} to debootstrap an ARMv7 instance +on an AArch64 host. Default is to use the current system architecture. +@item @code{suite} (default: @code{"stable"}) +When set, this must be a Debian distribution ``suite'' such as @code{buster} +or @code{focal}. If set to @code{#f}, the default for the OS provider is used. +@item @code{extra-pkgs} (default: @code{%default-debootstrap-extra-pkgs}) +List of extra packages that will get installed by dpkg in addition +to the minimal system. +@item @code{components} (default: @code{#f}) +When set, must be a list of Debian repository ``components''. For example +@code{'("main" "contrib")}. +@item @code{generate-cache?} (default: @code{#t}) +Whether to automatically cache the generated debootstrap archive. +@item @code{clean-cache} (default: @code{14}) +Discard the cache after this amount of days. Use @code{#f} to never +clear the cache. +@item @code{partition-style} (default: @code{'msdos}) +The type of partition to create. When set, it must be one of +@code{'msdos}, @code{'none} or a string. +@item @code{partition-alignment} (default: @code{2048}) +Alignment of the partition in sectors. +@end table +@end deftp + +@deffn {Scheme Procedure} debootstrap-variant +This is a helper procedure that creates a @code{ganeti-os-variant} record. It +takes two parameters: a name and a @code{debootstrap-configuration} object. +@end deffn + +@deffn {Scheme Procedure} debootstrap-os +This is a helper procedure that creates a @code{ganeti-os} record. It takes +a list of variants created with @code{debootstrap-variant}. +@end deffn + +@deffn {Scheme Procedure} guix-variant +This is a helper procedure that creates a @code{ganeti-os-variant} record for +use with the Guix OS provider. It takes a name and a G-expression that returns +a ``file-like'' (@pxref{G-Expressions, file-like objects}) object containing a +Guix System configuration. +@end deffn + +@deffn {Scheme Procedure} guix-os +This is a helper procedure that creates a @code{ganeti-os} record. It +takes a list of variants produced by @code{guix-variant}. +@end deffn + +@defvr {Scheme Variable} %default-debootstrap-variants +This is a convenience variable to make the debootstrap provider work +``out of the box'' without users having to declare variants manually. It +contains a single debootstrap variant with the default configuration: + +@lisp +(list (debootstrap-variant + "default" + (debootstrap-configuration)))) +@end lisp +@end defvr + +@defvr {Scheme Variable} %default-guix-variants +This is a convenience variable to make the Guix OS provider work without +additional configuration. It creates a virtual machine that has an SSH +server, a serial console, and authorizes the Ganeti hosts SSH keys. + +@lisp +(list (guix-variant + "default" + (file-append ganeti-instance-guix + "/share/doc/ganeti-instance-guix/examples/dynamic.scm")))) +@end lisp +@end defvr + +Users can implement support for OS providers unbeknownst to Guix by extending +the @code{ganeti-os} and @code{ganeti-os-variant} records appropriately. +For example: + +@lisp +(ganeti-os + (name "custom") + (extension ".conf") + (variants + (list (ganeti-os-variant + (name "foo") + (configuration (plain-file "bar" "this is fine")))))) +@end lisp + +That creates @file{/etc/ganeti/instance-custom/variants/foo.conf} which points +to a file in the store with contents @code{this is fine}. It also creates +@file{/etc/ganeti/instance-custom/variants/variants.list} with contents @code{foo}. + +Obviously this may not work for all OS providers out there. If you find the +interface limiting, please reach out to @email{guix-devel@@gnu.org}. + +The rest of this section documents the various services that are included by +@code{ganeti-service-type}. + +@defvr {Scheme Variable} ganeti-noded-service-type +@command{ganeti-noded} is the daemon responsible for node-specific functions +within the Ganeti system. The value of this service must be a +@code{ganeti-noded-configuration} object. +@end defvr + +@deftp {Data Type} ganeti-noded-configuration +This is the configuration for the @code{ganeti-noded} service. + +@table @asis +@item @code{ganeti} (default: @code{ganeti}) +The @code{ganeti} package to use for this service. + +@item @code{port} (default: @code{1811}) +The TCP port on which the node daemon listens for network requests. + +@item @code{address} (default: @code{"0.0.0.0"}) +The network address that the daemon will bind to. The default address means +bind to all available addresses. + +@item @code{interface} (default: @code{#f}) +When this is set, it must be a specific network interface (e.g.@: @code{eth0}) +that the daemon will bind to. + +@item @code{max-clients} (default: @code{20}) +This sets a limit on the maximum number of simultaneous client connections +that the daemon will handle. Connections above this count are accepted, but +no responses will be sent until enough connections have closed. + +@item @code{ssl?} (default: @code{#t}) +Whether to use SSL/TLS to encrypt network communications. The certificate +is automatically provisioned by the cluster and can be rotated with +@command{gnt-cluster renew-crypto}. + +@item @code{ssl-key} (default: @file{"/var/lib/ganeti/server.pem"}) +This can be used to provide a specific encryption key for TLS communications. + +@item @code{ssl-cert} (default: @file{"/var/lib/ganeti/server.pem"}) +This can be used to provide a specific certificate for TLS communications. + +@item @code{debug?} (default: @code{#f}) +When true, the daemon performs additional logging for debugging purposes. +Note that this will leak encryption details to the log files, use with caution. + +@end table +@end deftp + +@defvr {Scheme Variable} ganeti-confd-service-type +@command{ganeti-confd} answers queries related to the configuration of a +Ganeti cluster. The purpose of this daemon is to have a highly available +and fast way to query cluster configuration values. It is automatically +active on all @dfn{master candidates}. The value of this service must be a +@code{ganeti-confd-configuration} object. + +@end defvr + +@deftp {Data Type} ganeti-confd-configuration +This is the configuration for the @code{ganeti-confd} service. + +@table @asis +@item @code{ganeti} (default: @code{ganeti}) +The @code{ganeti} package to use for this service. + +@item @code{port} (default: @code{1814}) +The UDP port on which to listen for network requests. + +@item @code{address} (default: @code{"0.0.0.0"}) +Network address that the daemon will bind to. + +@item @code{debug?} (default: @code{#f}) +When true, the daemon performs additional logging for debugging purposes. + +@end table +@end deftp + +@defvr {Scheme Variable} ganeti-wconfd-service-type +@command{ganeti-wconfd} is the daemon that has authoritative knowledge +about the cluster configuration and is the only entity that can accept +changes to it. All jobs that need to modify the configuration will do so +by sending appropriate requests to this daemon. It only runs on the +@dfn{master node} and will automatically disable itself on other nodes. + +The value of this service must be a +@code{ganeti-wconfd-configuration} object. +@end defvr + +@deftp {Data Type} ganeti-wconfd-configuration +This is the configuration for the @code{ganeti-wconfd} service. + +@table @asis +@item @code{ganeti} (default: @code{ganeti}) +The @code{ganeti} package to use for this service. + +@item @code{no-voting?} (default: @code{#f}) +The daemon will refuse to start if the majority of cluster nodes does not +agree that it is running on the master node. Set to @code{#t} to start +even if a quorum can not be reached (dangerous, use with caution). + +@item @code{debug?} (default: @code{#f}) +When true, the daemon performs additional logging for debugging purposes. + +@end table +@end deftp + +@defvr {Scheme Variable} ganeti-luxid-service-type +@command{ganeti-luxid} is a daemon used to answer queries related to the +configuration and the current live state of a Ganeti cluster. Additionally, +it is the authorative daemon for the Ganeti job queue. Jobs can be +submitted via this daemon and it schedules and starts them. + +It takes a @code{ganeti-luxid-configuration} object. +@end defvr + +@deftp {Data Type} ganeti-luxid-configuration +This is the configuration for the @code{ganeti-wconfd} service. + +@table @asis +@item @code{ganeti} (default: @code{ganeti}) +The @code{ganeti} package to use for this service. + +@item @code{no-voting?} (default: @code{#f}) +The daemon will refuse to start if it cannot verify that the majority of +cluster nodes believes that it is running on the master node. Set to +@code{#t} to ignore such checks and start anyway (this can be dangerous). + +@item @code{debug?} (default: @code{#f}) +When true, the daemon performs additional logging for debugging purposes. + +@end table +@end deftp + +@defvr {Scheme Variable} ganeti-rapi-service-type +@command{ganeti-rapi} provides a remote API for Ganeti clusters. It runs on +the master node and can be used to perform cluster actions programmatically +via a JSON-based RPC protocol. + +Most query operations are allowed without authentication (unless +@var{require-authentication?} is set), whereas write operations require +explicit authorization via the @file{/var/lib/ganeti/rapi/users} file. See +the @url{http://docs.ganeti.org/ganeti/master/html/rapi.html, Ganeti Remote +API documentation} for more information. + +The value of this service must be a @code{ganeti-rapi-configuration} object. +@end defvr + +@deftp {Data Type} ganeti-rapi-configuration +This is the configuration for the @code{ganeti-rapi} service. + +@table @asis +@item @code{ganeti} (default: @code{ganeti}) +The @code{ganeti} package to use for this service. + +@item @code{require-authentication?} (default: @code{#f}) +Whether to require authentication even for read-only operations. + +@item @code{port} (default: @code{5080}) +The TCP port on which to listen to API requests. + +@item @code{address} (default: @code{"0.0.0.0"}) +The network address that the service will bind to. By default it listens +on all configured addresses. + +@item @code{interface} (default: @code{#f}) +When set, it must specify a specific network interface such as @code{eth0} +that the daemon will bind to. + +@item @code{max-clients} (default: @code{20}) +The maximum number of simultaneous client requests to handle. Further +connections are allowed, but no responses are sent until enough connections +have closed. + +@item @code{ssl?} (default: @code{#f}) +Whether to use SSL/TLS encryption on the RAPI port. + +@item @code{ssl-key} (default: @file{"/var/lib/ganeti/server.pem"}) +This can be used to provide a specific encryption key for TLS communications. + +@item @code{ssl-cert} (default: @file{"/var/lib/ganeti/server.pem"}) +This can be used to provide a specific certificate for TLS communications. + +@item @code{debug?} (default: @code{#f}) +When true, the daemon performs additional logging for debugging purposes. +Note that this will leak encryption details to the log files, use with caution. + +@end table +@end deftp + +@defvr {Scheme Variable} ganeti-kvmd-service-type +@command{ganeti-kvmd} is responsible for determining whether a given KVM +instance was shut down by an administrator or a user. Normally Ganeti will +restart an instance that was not stopped through Ganeti itself. If the +cluster option @code{user_shutdown} is true, this daemon monitors the +@code{QMP} socket provided by QEMU and listens for shutdown events, and +marks the instance as @dfn{USER_down} instead of @dfn{ERROR_down} when +it shuts down gracefully by itself. + +It takes a @code{ganeti-kvmd-configuration} object. +@end defvr + +@deftp {Data Type} ganeti-kvmd-configuration + +@table @asis +@item @code{ganeti} (default: @code{ganeti}) +The @code{ganeti} package to use for this service. + +@item @code{debug?} (default: @code{#f}) +When true, the daemon performs additional logging for debugging purposes. + +@end table +@end deftp + +@defvr {Scheme Variable} ganeti-mond-service-type +@command{ganeti-mond} is an optional daemon that provides Ganeti monitoring +functionality. It is responsible for running data collectors and publish the +collected information through a HTTP interface. + +It takes a @code{ganeti-mond-configuration} object. +@end defvr + +@deftp {Data Type} ganeti-mond-configuration + +@table @asis +@item @code{ganeti} (default: @code{ganeti}) +The @code{ganeti} package to use for this service. + +@item @code{port} (default: @code{1815}) +The port on which the daemon will listen. + +@item @code{address} (default: @code{"0.0.0.0"}) +The network address that the daemon will bind to. By default it binds to all +available interfaces. + +@item @code{debug?} (default: @code{#f}) +When true, the daemon performs additional logging for debugging purposes. + +@end table +@end deftp + +@defvr {Scheme Variable} ganeti-metad-service-type +@command{ganeti-metad} is an optional daemon that can be used to provide +information about the cluster to instances or OS install scripts. It is +not included in @code{ganeti-service-type} because using it requires +additional configuration and support in OS providers. + +It takes a @code{ganeti-metad-configuration} object. +@end defvr + +@deftp {Data Type} ganeti-metad-configuration + +@table @asis +@item @code{ganeti} (default: @code{ganeti}) +The @code{ganeti} package to use for this service. + +@item @code{port} (default: @code{80}) +The port on which the daemon will listen. + +@item @code{address} (default: @code{#f}) +If set, the daemon will bind to this address only. If left unset, the behavior +depends on the cluster configuration. + +@item @code{debug?} (default: @code{#f}) +When true, the daemon performs additional logging for debugging purposes. + +@end table +@end deftp + +@defvr {Scheme Variable} ganeti-watcher-service-type +@command{ganeti-watcher} is a script designed to run periodically and ensure +the health of a cluster. It will automatically restart instances that have +stopped without Ganetis consent, and repairs DRBD links in case a node has +rebooted. It also archives old cluster jobs and restarts Ganeti daemons +that are not running. If the cluster parameter @code{ensure_node_health} +is set, the watcher will also shutdown instances and DRBD devices if the +node it is running on is declared offline by known master candidates. + +It can be paused on all nodes with @command{gnt-cluster watcher pause}. + +The service takes a @code{ganeti-watcher-configuration} object. +@end defvr + +@deftp {Data Type} ganeti-watcher-configuration + +@table @asis +@item @code{ganeti} (default: @code{ganeti}) +The @code{ganeti} package to use for this service. + +@item @code{schedule} (default: @code{'(next-second-from (next-minute (range 0 60 5)))}) +How often to run the script. The default is every five minutes. + +@item @code{rapi-ip} (default: @code{#f}) +This option needs to be specified only if the RAPI daemon is configured to use +a particular interface or address. By default the cluster address is used. + +@item @code{job-age} (default: @code{(* 6 3600)}) +Archive cluster jobs older than this age, specified in seconds. The default +is 6 hours. This keeps @command{gnt-job list} manageable. + +@item @code{verify-disks?} (default: @code{#t}) +If this is @code{#f}, the watcher will not try to repair broken DRBD links +automatically. Administrators will need to use @command{gnt-cluster verify-disks} +manually instead. + +@item @code{debug?} (default: @code{#f}) +When @code{#t}, the script performs additional logging for debugging purposes. + +@end table +@end deftp + +@defvr {Scheme Variable} ganeti-cleaner-service-type +@command{ganeti-cleaner} is a script designed to run periodically and remove +old files from the cluster. This service type controls two @dfn{cron jobs}: +one intended for the master node that permanently purges old cluster jobs, +and one intended for every node that removes expired X509 certificates, keys, +and outdated @command{ganeti-watcher} information. Like all Ganeti services, +it is safe to include even on non-master nodes as it will disable itself as +necessary. + +It takes a @code{ganeti-cleaner-configuration} object. +@end defvr + +@deftp {Data Type} ganeti-cleaner-configuration + +@table @asis +@item @code{ganeti} (default: @code{ganeti}) +The @code{ganeti} package to use for the @command{gnt-cleaner} command. + +@item @code{master-schedule} (default: @code{"45 1 * * *"}) +How often to run the master cleaning job. The default is once per day, at +01:45:00. + +@item @code{node-schedule} (default: @code{"45 2 * * *"}) +How often to run the node cleaning job. The default is once per day, at +02:45:00. + +@end table +@end deftp + @node Version Control Services @subsection Version Control Services diff --git a/gnu/local.mk b/gnu/local.mk index c36fa1ea5e..7f4ff1f695 100644 --- a/gnu/local.mk +++ b/gnu/local.mk @@ -586,6 +586,7 @@ GNU_SYSTEM_MODULES = \ %D%/services/docker.scm \ %D%/services/authentication.scm \ %D%/services/games.scm \ + %D%/services/ganeti.scm \ %D%/services/getmail.scm \ %D%/services/guix.scm \ %D%/services/hurd.scm \ @@ -662,6 +663,7 @@ GNU_SYSTEM_MODULES = \ %D%/tests/desktop.scm \ %D%/tests/dict.scm \ %D%/tests/docker.scm \ + %D%/tests/ganeti.scm \ %D%/tests/guix.scm \ %D%/tests/monitoring.scm \ %D%/tests/nfs.scm \ diff --git a/gnu/services/ganeti.scm b/gnu/services/ganeti.scm new file mode 100644 index 0000000000..80a61818f7 --- /dev/null +++ b/gnu/services/ganeti.scm @@ -0,0 +1,1109 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2020 Marius Bakke +;;; +;;; This file is part of GNU Guix. +;;; +;;; GNU Guix 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 of the License, or (at +;;; your option) any later version. +;;; +;;; GNU Guix 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 GNU Guix. If not, see . + +(define-module (gnu services ganeti) + #:use-module (gnu packages virtualization) + #:use-module (gnu services) + #:use-module (gnu services mcron) + #:use-module (gnu services shepherd) + #:use-module (guix gexp) + #:use-module (guix records) + + #:use-module (srfi srfi-1) + #:use-module (ice-9 match) + + #:export (ganeti-noded-configuration + ganeti-noded-configuration? + ganeti-noded-configuration-ganeti + ganeti-noded-configuration-port + ganeti-noded-configuration-address + ganeti-noded-configuration-interface + ganeti-noded-configuration-max-clients + ganeti-noded-configuration-ssl? + ganeti-noded-configuration-ssl-key + ganeti-noded-configuration-ssl-cert + ganeti-noded-configuration-debug? + ganeti-noded-service-type + + ganeti-confd-configuration + ganeti-confd-configuration? + ganeti-confd-configuration-ganeti + ganeti-confd-configuration-port + ganeti-confd-configuration-address + ganeti-confd-configuration-debug + ganeti-confd-service-type + + ganeti-wconfd-configuration + ganeti-wconfd-configuration? + ganeti-wconfd-configuration-ganeti + ganeti-wconfd-configuration-no-voting? + ganeti-wconfd-configuration-debug? + ganeti-wconfd-service-type + + ganeti-luxid-configuration + ganeti-luxid-configuration? + ganeti-luxid-configuration-ganeti + ganeti-luxid-configuration-no-voting? + ganeti-luxid-configuration-debug? + ganeti-luxid-service-type + + ganeti-rapi-configuration + ganeti-rapi-configuration? + ganeti-rapi-configuration-ganeti + ganeti-rapi-configuration-require-authentication? + ganeti-rapi-configuration-port + ganeti-rapi-configuration-address + ganeti-rapi-configuration-interface + ganeti-rapi-configuration-max-clients + ganeti-rapi-configuration-ssl? + ganeti-rapi-configuration-ssl-key + ganeti-rapi-configuration-ssl-cert + ganeti-rapi-configuration-debug? + ganeti-rapi-service-type + + ganeti-kvmd-configuration + ganeti-kvmd-configuration? + ganeti-kvmd-configuration-ganeti + ganeti-kvmd-configuration-debug? + ganeti-kvmd-service-type + + ganeti-mond-configuration + ganeti-mond-configuration? + ganeti-mond-configuration-ganeti + ganeti-mond-configuration-port + ganeti-mond-configuration-address + ganeti-mond-configuration-debug? + ganeti-mond-service-type + + ganeti-metad-configuration + ganeti-metad-configuration? + ganeti-metad-configuration-ganeti + ganeti-metad-configuration-port + ganeti-metad-configuration-address + ganeti-metad-configuration-debug? + ganeti-metad-service-type + + ganeti-watcher-configuration + ganeti-watcher-configuration? + ganeti-watcher-configuration-ganeti + ganeti-watcher-configuration-schedule + ganeti-watcher-configuration-rapi-ip + ganeti-watcher-configuration-job-age + ganeti-watcher-configuration-verify-disks? + ganeti-watcher-configuration-debug? + ganeti-watcher-service-type + + ganeti-cleaner-configuration + ganeti-cleaner-configuration? + ganeti-cleaner-configuration-ganeti + ganeti-cleaner-configuration-master-schedule + ganeti-cleaner-configuration-node-schedule + ganeti-cleaner-service-type + + ganeti-os + ganeti-os? + ganeti-os-name + ganeti-os-extension + ganeti-os-variants + + ganeti-os-variant + ganeti-os-variant? + ganeti-os-variant-name + ganeti-os-variant-configuration + + %debootstrap-interfaces-hook + %debootstrap-grub-hook + %default-debootstrap-hooks + %default-debootstrap-extra-pkgs + debootstrap-configuration + debootstrap-configuration? + debootstrap-configuration-hooks + debootstrap-configuration-proxy + debootstrap-configuration-mirror + debootstrap-configuration-arch + debootstrap-configuration-suite + debootstrap-configuration-extra-pkgs + debootstrap-configuration-components + debootstrap-configuration-generate-cache? + debootstrap-configuration-clean-cache + debootstrap-configuration-partition-style + debootstrap-configuration-partition-alignment + + debootstrap-variant + debootstrap-os + %default-debootstrap-variants + + guix-variant + guix-os + %default-guix-variants + + %default-ganeti-os + + ganeti-configuration + ganeti-configuration? + ganeti-configuration-noded-configuration + ganeti-configuration-confd-configuration + ganeti-configuration-wconfd-configuration + ganeti-configuration-luxid-configuration + ganeti-configuration-rapi-configuration + ganeti-configuration-kvmd-configuration + ganeti-configuration-mond-configuration + ganeti-configuration-metad-configuration + ganeti-configuration-watcher-configuration + ganeti-configuration-cleaner-configuration + ganeti-configuration-file-storage-paths + ganeti-configuration-os + ganeti-service-type)) + +;;; +;;; Service definitions for running a Ganeti cluster. +;;; +;;; Planned improvements: run daemons (except ganeti-noded) under unprivileged +;;; user accounts and/or containers. The account names must match the ones +;;; given to Ganetis configure script. metad needs "setcap" or root in order +;;; to bind on port 80. + +;; Set PATH so the various daemons are able to find the 'ip' executable, LVM, +;; Ceph, Gluster, etc, without having to add absolute references to everything. +(define %default-ganeti-environment-variables + (list (string-append "PATH=" + (string-join '("/run/setuid-programs" + "/run/current-system/profile/sbin" + "/run/current-system/profile/bin") + ":")))) + +(define-record-type* + ganeti-noded-configuration make-ganeti-noded-configuration + ganeti-noded-configuration? + (ganeti ganeti-noded-configuration-ganeti ; + (default ganeti)) + (port ganeti-noded-configuration-port ;integer + (default 1811)) + (address ganeti-noded-configuration-address ;string + (default "0.0.0.0")) + (interface ganeti-noded-configuration-interface ;string | #f + (default #f)) + (max-clients ganeti-noded-configuration-max-clients ;integer + (default 20)) + (ssl? ganeti-noded-configuration-ssl? ;Boolean + (default #t)) + (ssl-key ganeti-noded-configuration-ssl-key ;string + (default "/var/lib/ganeti/server.pem")) + (ssl-cert ganeti-noded-configuration-ssl-cert ;string + (default "/var/lib/ganeti/server.pem")) + (debug? ganeti-noded-configuration-debug? ;Boolean + (default #f))) + +(define ganeti-noded-service + (match-lambda + (($ ganeti port address interface max-clients + ssl? ssl-key ssl-cert debug?) + (list (shepherd-service + (documentation "Run the Ganeti node daemon.") + (provision '(ganeti-noded)) + (requirement '(user-processes networking)) + + ;; If the daemon stops, it is probably for a good reason; + ;; otherwise ganeti-watcher will restart it for us anyway. + (respawn? #f) + + (start #~(make-forkexec-constructor + (list #$(file-append ganeti "/sbin/ganeti-noded") + #$(string-append "--port=" (number->string port)) + #$(string-append "--bind=" address) + #$@(if interface + #~((string-append "--interface=" #$interface)) + #~()) + #$(string-append "--max-clients=" + (number->string max-clients)) + #$@(if ssl? + #~((string-append "--ssl-key=" #$ssl-key) + (string-append "--ssl-cert=" #$ssl-cert)) + #~("--no-ssl")) + #$@(if debug? + #~("--debug") + #~())) + #:environment-variables + '#$%default-ganeti-environment-variables + #:pid-file "/var/run/ganeti/ganeti-noded.pid")) + (stop #~(make-kill-destructor))))))) + +(define ganeti-noded-service-type + (service-type (name 'ganeti-noded) + (extensions + (list (service-extension shepherd-root-service-type + ganeti-noded-service))) + (default-value (ganeti-noded-configuration)) + (description + "@command{ganeti-noded} is the daemon which is responsible +for the node functions in the Ganeti system."))) + +(define-record-type* + ganeti-confd-configuration make-ganeti-confd-configuration + ganeti-confd-configuration? + (ganeti ganeti-confd-configuration-ganeti ; + (default ganeti)) + (port ganeti-confd-configuration-port ;integer + (default 1814)) + (address ganeti-confd-configuration-address ;string + (default "0.0.0.0")) + (debug? ganeti-confd-configuration-debug? ;Boolean + (default #f))) + +(define ganeti-confd-service + (match-lambda + (($ ganeti port address debug?) + (list (shepherd-service + (documentation "Run the Ganeti confd daemon.") + (provision '(ganeti-confd)) + (requirement '(user-processes networking)) + (respawn? #f) + (start #~(make-forkexec-constructor + (list #$(file-append ganeti "/sbin/ganeti-confd") + #$(string-append "--port=" (number->string port)) + #$(string-append "--bind=" address) + #$@(if debug? + #~("--debug") + #~())) + #:environment-variables + '#$%default-ganeti-environment-variables + #:pid-file "/var/run/ganeti/ganeti-confd.pid")) + (stop #~(make-kill-destructor))))))) + +(define ganeti-confd-service-type + (service-type (name 'ganeti-confd) + (extensions + (list (service-extension shepherd-root-service-type + ganeti-confd-service))) + (default-value (ganeti-confd-configuration)) + (description + "@command{ganeti-confd} is a daemon used to answer queries +related to the configuration of a Ganeti cluster."))) + +(define-record-type* + ganeti-wconfd-configuration make-ganeti-wconfd-configuration + ganeti-wconfd-configuration? + (ganeti ganeti-wconfd-configuration-ganeti ; + (default ganeti)) + (no-voting? ganeti-wconfd-configuration-no-voting? ;Boolean + (default #f)) + (debug? ganeti-wconfd-configuration-debug? ;Boolean + (default #f))) + +;; If this file exists, the wconfd daemon will be forcefully started even on +;; non-master nodes. It is used to accommodate a master-failover scenario. +(define %wconfd-force-node-hint + "/var/lib/ganeti/guix_wconfd_force_node_hint") + +(define (wconfd-wrapper ganeti args) + ;; Wrapper for the wconfd daemon that looks for the force-node hint. + (program-file + "wconfd-wrapper" + #~(begin + (let ((wconfd #$(file-append ganeti "/sbin/ganeti-wconfd")) + (force-node? (file-exists? #$%wconfd-force-node-hint))) + (if force-node? + (execl wconfd wconfd "--force-node" "--no-voting" "--yes-do-it" #$@args) + (execl wconfd wconfd #$@args)))))) + +(define shepherd-wconfd-force-start-action + ;; Shepherd action to create the force-node hint and start wconfd. + (shepherd-action + (name 'force-start) + (documentation + "Forcefully start wconfd even on non-master nodes (dangerous!).") + (procedure #~(lambda _ + (format #t "Forcefully starting the wconfd daemon...~%") + (action 'ganeti-wconfd 'enable) + (dynamic-wind + (lambda () + (false-if-exception + (call-with-output-file #$%wconfd-force-node-hint + (lambda (port) + (const #t))))) + (lambda () + (action 'ganeti-wconfd 'restart)) + (lambda () + (delete-file #$%wconfd-force-node-hint))) + #t)))) + +(define ganeti-wconfd-service + (match-lambda + (($ ganeti no-voting? debug?) + (list (shepherd-service + (documentation "Run the Ganeti wconfd daemon.") + (provision '(ganeti-wconfd)) + (requirement '(user-processes)) + + ;; Shepherd action to support a master-failover scenario. It is + ;; automatically invoked during 'gnt-cluster master-failover' (see + ;; related Ganeti patch) and not intended for interactive use. + (actions (list shepherd-wconfd-force-start-action)) + + ;; wconfd will disable itself when not running on the master + ;; node. Don't attempt to restart it. + (respawn? #f) + + (start + #~(make-forkexec-constructor + (list #$(wconfd-wrapper ganeti + (append + (if no-voting? + '("--no-voting" "--yes-do-it") + '()) + (if debug? + '("--debug") + '())))) + #:environment-variables + '#$%default-ganeti-environment-variables + #:pid-file "/var/run/ganeti/ganeti-wconfd.pid")) + (stop #~(make-kill-destructor))))))) + +(define ganeti-wconfd-service-type + (service-type (name 'ganeti-wconfd) + (extensions + (list (service-extension shepherd-root-service-type + ganeti-wconfd-service))) + (default-value (ganeti-wconfd-configuration)) + (description + "@command{ganeti-wconfd} is the daemon that has authoritative +knowledge about the configuration and is the only entity that can accept changes +to it. All jobs that need to modify the configuration will do so by sending +appropriate requests to this daemon."))) + +(define-record-type* + ganeti-luxid-configuration make-ganeti-luxid-configuration + ganeti-luxid-configuration? + (ganeti ganeti-luxid-configuration-ganeti ; + (default ganeti)) + (no-voting? ganeti-luxid-configuration-no-voting? ;Boolean + (default #f)) + (debug? ganeti-luxid-configuration-debug? ;Boolean + (default #f))) + +(define ganeti-luxid-service + (match-lambda + (($ ganeti no-voting? debug?) + (list (shepherd-service + (documentation "Run the Ganeti LUXI daemon.") + (provision '(ganeti-luxid)) + (requirement '(user-processes)) + + ;; This service will automatically disable itself when not + ;; running on the master node. Don't attempt to restart it. + (respawn? #f) + + (start #~(make-forkexec-constructor + (list #$(file-append ganeti "/sbin/ganeti-luxid") + #$@(if no-voting? + #~("--no-voting" "--yes-do-it") + #~()) + #$@(if debug? + #~("--debug") + #~())) + #:environment-variables + '#$%default-ganeti-environment-variables + #:pid-file "/var/run/ganeti/ganeti-luxid.pid")) + (stop #~(make-kill-destructor))))))) + +(define ganeti-luxid-service-type + (service-type (name 'ganeti-luxid) + (extensions + (list (service-extension shepherd-root-service-type + ganeti-luxid-service))) + (default-value (ganeti-luxid-configuration)) + (description + "@command{ganeti-luxid} is a daemon used to answer queries +related to the configuration and the current live state of a Ganeti cluster. +Additionally, it is the autorative daemon for the Ganeti job queue. Jobs can +be submitted via this daemon and it schedules and starts them."))) + +(define-record-type* + ganeti-rapi-configuration make-ganeti-rapi-configuration + ganeti-rapi-configuration? + (ganeti ganeti-rapi-configuration-ganeti ; + (default ganeti)) + (require-authentication? + ganeti-rapi-configuration-require-authentication? ;Boolean + (default #f)) + (port ganeti-rapi-configuration-port ;integer + (default 5080)) + (address ganeti-rapi-configuration-address ;string + (default "0.0.0.0")) + (interface ganeti-rapi-configuration-interface ;string | #f + (default #f)) + (max-clients ganeti-rapi-configuration-max-clients ;integer + (default 20)) + (ssl? ganeti-rapi-configuration-ssl? ;Boolean + (default #f)) + (ssl-key ganeti-rapi-configuration-ssl-key ;string + (default "/var/lib/ganeti/server.pem")) + (ssl-cert ganeti-rapi-configuration-ssl-cert ;string + (default "/var/lib/ganeti/server.pem")) + (debug? ganeti-rapi-configuration-debug? ;Boolean + (default #f))) + +(define ganeti-rapi-service + (match-lambda + (($ ganeti require-authentication? port address + interface max-clients ssl? ssl-key ssl-cert + debug?) + (list (shepherd-service + (documentation "Run the Ganeti RAPI daemon.") + (provision '(ganeti-rapi)) + (requirement '(user-processes networking)) + + ;; This service will automatically disable itself when not + ;; running on the master node. Don't attempt to restart it. + (respawn? #f) + + (start #~(make-forkexec-constructor + (list #$(file-append ganeti "/sbin/ganeti-rapi") + #$@(if require-authentication? + #~("--require-authentication") + #~()) + #$(string-append "--port=" (number->string port)) + #$(string-append "--bind=" address) + #$@(if interface + #~((string-append "--interface=" #$interface)) + #~()) + #$(string-append "--max-clients=" + (number->string max-clients)) + #$@(if ssl? + #~((string-append "--ssl-key=" #$ssl-key) + (string-append "--ssl-cert=" #$ssl-cert)) + #~("--no-ssl")) + #$@(if debug? + #~("--debug") + #~())) + #:environment-variables + '#$%default-ganeti-environment-variables + #:pid-file "/var/run/ganeti/ganeti-rapi.pid")) + (stop #~(make-kill-destructor))))))) + +(define ganeti-rapi-service-type + (service-type (name 'ganeti-rapi) + (extensions + (list (service-extension shepherd-root-service-type + ganeti-rapi-service))) + (default-value (ganeti-rapi-configuration)) + (description + "@command{ganeti-rapi} is the daemon providing a remote API +for Ganeti clusters."))) + +(define-record-type* + ganeti-kvmd-configuration make-ganeti-kvmd-configuration + ganeti-kvmd-configuration? + (ganeti ganeti-kvmd-configuration-ganeti ; + (default ganeti)) + (debug? ganeti-kvmd-configuration-debug? ;Boolean + (default #f))) + +(define ganeti-kvmd-service + (match-lambda + (($ ganeti debug?) + (list (shepherd-service + (documentation "Run the Ganeti KVM daemon.") + (provision '(ganeti-kvmd)) + (requirement '(user-processes)) + + ;; This service will automatically disable itself when not + ;; needed. Don't attempt to restart it. + (respawn? #f) + + (start #~(make-forkexec-constructor + (list #$(file-append ganeti "/sbin/ganeti-kvmd") + #$@(if debug? + #~("--debug") + #~())) + #:environment-variables + '#$%default-ganeti-environment-variables + #:pid-file "/var/run/ganeti/ganeti-kvmd.pid")) + (stop #~(make-kill-destructor))))))) + +(define ganeti-kvmd-service-type + (service-type (name 'ganeti-kvmd) + (extensions + (list (service-extension shepherd-root-service-type + ganeti-kvmd-service))) + (default-value (ganeti-kvmd-configuration)) + (description + "@command{ganeti-kvmd} is responsible for determining whether +a given KVM instance was shutdown by an administrator or a user. + +The KVM daemon monitors, using @code{inotify}, KVM instances through their QMP +sockets, which are provided by KVM. Using the QMP sockets, the KVM daemon +listens for particular shutdown, powerdown, and stop events which will determine +if a given instance was shutdown by the user or Ganeti, and this result is +communicated to Ganeti via a special file in the filesystem."))) + +(define-record-type* + ganeti-mond-configuration make-ganeti-mond-configuration + ganeti-mond-configuration? + (ganeti ganeti-mond-configuration-ganeti ; + (default ganeti)) + (port ganeti-mond-configuration-port ;integer + (default 1815)) + (address ganeti-mond-configuration-address ;string + (default "0.0.0.0")) + (debug? ganeti-mond-configuration-debug? ;Boolean + (default #f))) + +(define ganeti-mond-service + (match-lambda + (($ ganeti port address debug?) + (list (shepherd-service + (documentation "Run the Ganeti monitoring daemon.") + (provision '(ganeti-mond)) + (requirement '(user-processes networking)) + (respawn? #f) + (start #~(make-forkexec-constructor + (list #$(file-append ganeti "/sbin/ganeti-mond") + #$(string-append "--port=" (number->string port)) + #$(string-append "--bind=" address) + #$@(if debug? + #~("--debug") + #~())) + #:pid-file "/var/run/ganeti/ganeti-mond.pid")) + (stop #~(make-kill-destructor))))))) + +(define ganeti-mond-service-type + (service-type (name 'ganeti-mond) + (extensions + (list (service-extension shepherd-root-service-type + ganeti-mond-service))) + (default-value (ganeti-mond-configuration)) + (description + "@command{ganeti-mond} is a daemon providing monitoring +functionality. It is responsible for running the data collectors and to +provide the collected information through a HTTP interface."))) + +(define-record-type* + ganeti-metad-configuration make-ganeti-metad-configuration + ganeti-metad-configuration? + (ganeti ganeti-metad-configuration-ganeti ; + (default ganeti)) + (port ganeti-metad-configuration-port ;integer + (default 80)) + (address ganeti-metad-configuration-address ;string | #f + (default #f)) + (debug? ganeti-metad-configuration-debug? ;Boolean + (default #f))) + +(define ganeti-metad-service + (match-lambda + (($ ganeti port address debug?) + (list (shepherd-service + (documentation "Run the Ganeti metadata daemon.") + (provision '(ganeti-metad)) + (requirement '(user-processes networking)) + (respawn? #f) + (start #~(make-forkexec-constructor + (list #$(file-append ganeti "/sbin/ganeti-metad") + #$(string-append "--port=" (number->string port)) + #$@(if address + #~((string-append "--bind=" #$address)) + #~()) + #$@(if debug? + #~("--debug") + #~())) + #:pid-file "/var/run/ganeti/ganeti-metad.pid")) + (stop #~(make-kill-destructor))))))) + +(define ganeti-metad-service-type + (service-type (name 'ganeti-metad) + (extensions + (list (service-extension shepherd-root-service-type + ganeti-metad-service))) + (default-value (ganeti-metad-configuration)) + (description + "@command{ganeti-metad} is a daemon that can be used to pass +information to OS install scripts or instances."))) + +(define-record-type* + ganeti-watcher-configuration make-ganeti-watcher-configuration + ganeti-watcher-configuration? + (ganeti ganeti-watcher-configuration-ganeti ; + (default ganeti)) + (schedule ganeti-watcher-configuration-schedule ;list | string + (default '(next-second-from + ;; Run every five minutes. + (next-minute (range 0 60 5))))) + (rapi-ip ganeti-watcher-configuration-rapi-ip ;#f | string + (default #f)) + (job-age ganeti-watcher-configuration-job-age ;integer + (default (* 6 3600))) + (verify-disks? ganeti-watcher-configuration-verify-disks? ;Boolean + (default #t)) + (debug? ganeti-watcher-configuration-debug? ;Boolean + (default #f))) + +(define ganeti-watcher-command + (match-lambda + (($ ganeti _ rapi-ip job-age verify-disks? + debug?) + #~(lambda () + (system* #$(file-append ganeti "/sbin/ganeti-watcher") + #$@(if rapi-ip + #~(string-append "--rapi-ip=" #$rapi-ip) + #~()) + #$(string-append "--job-age=" (number->string job-age)) + #$@(if verify-disks? + #~() + #~("--no-verify-disks")) + #$@(if debug? + #~("--debug") + #~())))))) + +(define (ganeti-watcher-jobs config) + (match config + (($ _ schedule) + (list + #~(job #$@(match schedule + ((? string?) + #~(#$schedule)) + ((? list?) + #~('#$schedule))) + #$(ganeti-watcher-command config)))))) + +(define ganeti-watcher-service-type + (service-type (name 'ganeti-watcher) + (extensions + (list (service-extension mcron-service-type + ganeti-watcher-jobs))) + (default-value (ganeti-watcher-configuration)) + (description + "@command{ganeti-watcher} is a periodically run script that +performs a number of maintenance actions on the cluster. It will automatically +restart instances that are marked as ERROR_down, i.e., instances that should be +running, but are not; and it will also try to repair DRBD links in case a +secondary node has rebooted. In addition it is responsible for archiving old +cluster jobs, and it will restart any down Ganeti daemons that are appropriate +for the current node. If the cluster parameter @code{maintain_node_health} is +enabled, the watcher will also shutdown instances and DRBD devices if the node +is declared offline by known master candidates."))) + +(define-record-type* + ganeti-cleaner-configuration make-ganeti-cleaner-configuration + ganeti-cleaner-configuration? + (ganeti ganeti-cleaner-configuration-ganeti ; + (default ganeti)) + (master-schedule ganeti-cleaner-configuration-master-schedule ;list | string + ;; Run the master cleaner at 01:45 every day. + (default "45 1 * * *")) + (node-schedule ganeti-cleaner-configuration-node-schedule ;list | string + ;; Run the node cleaner at 02:45 every day. + (default "45 2 * * *"))) + +(define ganeti-cleaner-jobs + (match-lambda + (($ ganeti master-schedule node-schedule) + (list + #~(job #$@(match master-schedule + ((? string?) + #~(#$master-schedule)) + ((? list?) + #~('#$master-schedule))) + (lambda () + (system* #$(file-append ganeti "/sbin/ganeti-cleaner") + "master"))) + #~(job #$@(match node-schedule + ((? string?) + #~(#$node-schedule)) + ((? list?) + #~('#$node-schedule))) + (lambda () + (system* #$(file-append ganeti "/sbin/ganeti-cleaner") + "node"))))))) + +(define ganeti-cleaner-service-type + (service-type (name 'ganeti-cleaner) + (extensions + (list (service-extension mcron-service-type + ganeti-cleaner-jobs))) + (default-value (ganeti-cleaner-configuration)) + (description + "@command{ganeti-cleaner} is a script that removes old files +from the cluster. When called with @code{node} as argument it removes expired +X509 certificates and keys from @file{/var/run/ganeti/crypto}, as well as +outdated @command{ganeti-watcher} information. + +When called with @code{master} as argument, it instead removes files older +than 21 days from @file{/var/lib/ganeti/queue/archive}."))) + +(define-record-type* + ganeti-configuration make-ganeti-configuration + ganeti-configuration? + (ganeti ganeti-configuration-ganeti + (default ganeti)) + (noded-configuration ganeti-configuration-noded-configuration + (default (ganeti-noded-configuration))) + (confd-configuration ganeti-configuration-confd-configuration + (default (ganeti-confd-configuration))) + (wconfd-configuration ganeti-configuration-wconfd-configuration + (default (ganeti-wconfd-configuration))) + (luxid-configuration ganeti-configuration-luxid-configuration + (default (ganeti-luxid-configuration))) + (rapi-configuration ganeti-configuration-rapi-configuration + (default (ganeti-rapi-configuration))) + (kvmd-configuration ganeti-configuration-kvmd-configuration + (default (ganeti-kvmd-configuration))) + (mond-configuration ganeti-configuration-mond-configuration + (default (ganeti-mond-configuration))) + (metad-configuration ganeti-configuration-metad-configuration + (default (ganeti-metad-configuration))) + (watcher-configuration ganeti-configuration-watcher-configuration + (default (ganeti-watcher-configuration))) + (cleaner-configuration ganeti-configuration-cleaner-configuration + (default (ganeti-cleaner-configuration))) + (file-storage-paths ganeti-configuration-file-storage-paths ;list of strings | gexp + (default '())) + (os ganeti-configuration-os ;list of + (default '()))) + +(define (ganeti-activation config) + (with-imported-modules '((guix build utils)) + #~(begin + (use-modules (guix build utils)) + (for-each mkdir-p + '("/var/log/ganeti" + "/var/log/ganeti/kvm" + "/var/log/ganeti/os" + "/var/lib/ganeti/rapi" + "/var/lib/ganeti/queue" + "/var/lib/ganeti/queue/archive" + "/var/run/ganeti/bdev-cache" + "/var/run/ganeti/crypto" + "/var/run/ganeti/socket" + "/var/run/ganeti/instance-disks" + "/var/run/ganeti/instance-reason" + "/var/run/ganeti/livelocks"))))) + +(define ganeti-shepherd-services + (match-lambda + (($ _ noded confd wconfd luxid rapi kvmd mond metad) + (append (ganeti-noded-service noded) + (ganeti-confd-service confd) + (ganeti-wconfd-service wconfd) + (ganeti-luxid-service luxid) + (ganeti-rapi-service rapi) + (ganeti-kvmd-service kvmd) + (ganeti-mond-service mond) + (ganeti-metad-service metad))))) + +(define ganeti-mcron-jobs + (match-lambda + (($ _ _ _ _ _ _ _ _ _ watcher cleaner) + (append (ganeti-watcher-jobs watcher) + (ganeti-cleaner-jobs cleaner))))) + +(define-record-type* + ganeti-os make-ganeti-os ganeti-os? + (name ganeti-os-name) ;string + (extension ganeti-os-extension) ;string + (variants ganeti-os-variants ;list of + (default '()))) + +(define-record-type* + ganeti-os-variant make-ganeti-os-variant ganeti-os-variant? + (name ganeti-os-variant-name) ;string + (configuration ganeti-os-variant-configuration)) ; + +(define %debootstrap-interfaces-hook + (file-append ganeti-instance-debootstrap + "/share/doc/ganeti-instance-debootstrap/examples/interfaces")) + +;; The GRUB hook shipped with instance-debootstrap does not work with GRUB2. +;; For convenience, provide one that work with modern Debians here. +;; Note: it would be neat to reuse Guix' bootloader infrastructure instead. +(define %debootstrap-grub-hook + (plain-file "grub" + "#!/usr/bin/env bash +CLEANUP=( ) +cleanup() { + if [ ${#CLEANUP[*]} -gt 0 ]; then + LAST_ELEMENT=$((${#CLEANUP[*]}-1)) + REVERSE_INDEXES=$(seq ${LAST_ELEMENT} -1 0) + for i in $REVERSE_INDEXES; do + ${CLEANUP[$i]} + done + fi +} + +trap cleanup EXIT + +mount -t proc proc $TARGET/proc +CLEANUP+=(\"umount $TARGET/proc\") +mount -t sysfs sysfs $TARGET/sys +CLEANUP+=(\"umount $TARGET/sys\") +mount -o bind /dev $TARGET/dev +CLEANUP+=(\"umount $TARGET/dev\") + +echo ' +GRUB_TIMEOUT_STYLE=menu +GRUB_CMDLINE_LINUX_DEFAULT=\"console=ttyS0,115200 net.ifnames=0\" +GRUB_TERMINAL=\"serial\" +GRUB_SERIAL_COMMAND=\"serial --unit=0 --speed=115200\" +' >> $TARGET/etc/default/grub + +# This PATH is propagated into the chroot and necessary to make grub-install +# and related commands visible. +export PATH=\"/usr/sbin:/usr/bin:/sbin:/bin:$PATH\" + +chroot \"$TARGET\" grub-install $BLOCKDEV +chroot \"$TARGET\" update-grub + +cleanup +trap - EXIT +")) + +(define %default-debootstrap-hooks + `((10-interfaces . ,%debootstrap-interfaces-hook) + (90-grub . ,%debootstrap-grub-hook))) + +(define %default-debootstrap-extra-pkgs + ;; Packages suitable for a fully virtualized KVM guest. + '("acpi-support-base" "udev" "linux-image-amd64" "openssh-server" + "locales-all" "grub-pc")) + +(define-record-type* + debootstrap-configuration make-debootstrap-configuration + debootstrap-configuration? + (hooks debootstrap-configuration-hooks ;#f | gexp | '((name . gexp)) + (default %default-debootstrap-hooks)) + (proxy debootstrap-configuration-proxy (default #f)) ;#f | string + (mirror debootstrap-configuration-mirror ;#f | string + (default #f)) + (arch debootstrap-configuration-arch (default #f)) ;#f | string + (suite debootstrap-configuration-suite ;#f | string + (default "stable")) + (extra-pkgs debootstrap-configuration-extra-pkgs ;list of strings + (default %default-debootstrap-extra-pkgs)) + (components debootstrap-configuration-components ;list of strings + (default '())) + (generate-cache? debootstrap-configuration-generate-cache? ;Boolean + (default #t)) + (clean-cache debootstrap-configuration-clean-cache ;#f | integer + (default 14)) + (partition-style debootstrap-configuration-partition-style ;#f | symbol | string + (default 'msdos)) + (partition-alignment debootstrap-configuration-partition-alignment ;#f | integer + (default 2048))) + +(define (hooks->directory hooks) + (match hooks + ((? file-like?) + hooks) + ((? list?) + (let ((names (map car hooks)) + (files (map cdr hooks))) + (with-imported-modules '((guix build utils)) + (computed-file "hooks-union" + #~(begin + (use-modules (guix build utils) + (ice-9 match)) + (mkdir-p #$output) + (with-directory-excursion #$output + (for-each (match-lambda + ((name hook) + (let ((file-name (string-append + #$output "/" + (symbol->string name)))) + ;; Copy to the destination to ensure + ;; the file is executable. + (copy-file hook file-name) + (chmod file-name #o555)))) + '#$(zip names files)))))))) + (_ #f))) + +(define-gexp-compiler (debootstrap-configuration-compiler + (file ) system target) + (match file + (($ hooks proxy mirror arch suite extra-pkgs + components generate-cache? clean-cache + partition-style partition-alignment) + (let ((customize-dir (hooks->directory hooks))) + (gexp->derivation + "debootstrap-variant" + #~(call-with-output-file (ungexp output "out") + (lambda (port) + (display + (string-append + (ungexp-splicing + `(,@(if proxy + `("PROXY=" ,proxy "\n") + '()) + ,@(if mirror + `("MIRROR=" ,mirror "\n") + '()) + ,@(if arch + `("ARCH=" ,arch "\n") + '()) + ,@(if suite + `("SUITE=" ,suite "\n") + '()) + ,@(if (not (null? extra-pkgs)) + `("EXTRA_PKGS=" ,(string-join extra-pkgs ",") "\n") + '()) + ,@(if (not (null? components)) + `("COMPONENTS=" ,(string-join components ",") "\n") + '()) + ,@(if customize-dir + `("CUSTOMIZE_DIR=" ,customize-dir "\n") + '()) + ,@(if generate-cache? + '("GENERATE_CACHE=yes\n") + '("GENERATE_CACHE=no\n")) + ,@(if clean-cache + `("CLEAN_CACHE=" ,(number->string clean-cache) "\n") + '()) + ,@(if partition-style + (if (symbol? partition-style) + `("PARTITION_STYLE=" + ,(symbol->string partition-style) "\n") + `("PARTITION_STYLE=" ,partition-style "\n")) + '()) + ,@(if partition-alignment + `("PARTITION_ALIGNMENT=" + ,(number->string partition-alignment) "\n") + '())))) + port))) + #:local-build? #t))))) + +(define (ganeti-os->directory os) + "Return the derivation to build the configuration directory to be installed +in /etc/ganeti/instance-$os for OS." + (let* ((name (ganeti-os-name os)) + (extension (ganeti-os-extension os)) + (variants (ganeti-os-variants os)) + (names (map ganeti-os-variant-name variants)) + (configs (map ganeti-os-variant-configuration variants))) + (with-imported-modules '((guix build utils)) + (define builder + #~(begin + (use-modules (guix build utils) + (ice-9 format) + (ice-9 match) + (srfi srfi-1)) + (mkdir-p #$output) + (unless (null? '#$names) + (let ((variants-dir (string-append #$output "/variants"))) + (mkdir-p variants-dir) + (call-with-output-file (string-append variants-dir "/variants.list") + (lambda (port) + (format port "~a~%" + (string-join '#$names "\n")))) + (for-each (match-lambda + ((name file) + (symlink file + (string-append variants-dir "/" name + #$extension)))) + + '#$(zip names configs)))))) + + (computed-file (string-append name "-os") builder)))) + +(define (ganeti-directory file-storage-file os) + (let ((dirs (map ganeti-os->directory os)) + (names (map ganeti-os-name os))) + (define builder + #~(begin + (use-modules (ice-9 match)) + (mkdir #$output) + (when #$file-storage-file + (symlink #$file-storage-file + (string-append #$output "/file-storage-paths"))) + (for-each (match-lambda + ((name dest) + (symlink dest + (string-append #$output "/instance-" name)))) + '#$(zip names dirs)))) + (computed-file "etc-ganeti" builder))) + +(define (file-storage-file paths) + (match paths + ((? null?) #f) + ((? list?) (plain-file + "file-storage-paths" + (string-join paths "\n"))) + (_ paths))) + +(define (ganeti-etc-service config) + (list `("ganeti" ,(ganeti-directory + (file-storage-file + (ganeti-configuration-file-storage-paths config)) + (ganeti-configuration-os config))))) + +(define (debootstrap-os variants) + (ganeti-os + (name "debootstrap") + (extension ".conf") + (variants variants))) + +(define (debootstrap-variant name configuration) + (ganeti-os-variant + (name name) + (configuration configuration))) + +(define %default-debootstrap-variants + (list (debootstrap-variant + "default" + (debootstrap-configuration)))) + +(define (guix-os variants) + (ganeti-os + (name "guix") + (extension ".scm") + (variants variants))) + +(define (guix-variant name configuration) + (ganeti-os-variant + (name name) + (configuration configuration))) + +(define %default-guix-variants + (list (guix-variant + "default" + (file-append ganeti-instance-guix + "/share/doc/ganeti-instance-guix/examples/dynamic.scm")))) + +;; The OS configurations usually come with a default OS. To make them work +;; out of the box, follow suit. +(define %default-ganeti-os + (list (debootstrap-os %default-debootstrap-variants) + (guix-os %default-guix-variants))) + +(define ganeti-service-type + (service-type (name 'ganeti) + (extensions + (list (service-extension activation-service-type + ganeti-activation) + (service-extension shepherd-root-service-type + ganeti-shepherd-services) + (service-extension etc-service-type + ganeti-etc-service) + (service-extension profile-service-type + (compose list ganeti-configuration-ganeti)) + (service-extension mcron-service-type + ganeti-mcron-jobs))) + (default-value (ganeti-configuration (os %default-ganeti-os))) + (description + "Ganeti is a family of services that are designed to run +on a fleet of machines and facilitate deployment and maintenance of virtual +servers (@dfn{instances}). It can migrate instances between nodes, automatically +restart failed instances, evacuate nodes, and much more."))) diff --git a/gnu/tests/ganeti.scm b/gnu/tests/ganeti.scm new file mode 100644 index 0000000000..0615edcde4 --- /dev/null +++ b/gnu/tests/ganeti.scm @@ -0,0 +1,265 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2020 Marius Bakke . +;;; +;;; This file is part of GNU Guix. +;;; +;;; GNU Guix 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 of the License, or (at +;;; your option) any later version. +;;; +;;; GNU Guix 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 GNU Guix. If not, see . + +(define-module (gnu tests ganeti) + #:use-module (gnu) + #:use-module (gnu tests) + #:use-module (gnu system vm) + #:use-module (gnu services) + #:use-module (gnu services ganeti) + #:use-module (gnu services networking) + #:use-module (gnu services ssh) + #:use-module (gnu packages virtualization) + #:use-module (guix gexp) + #:use-module (ice-9 format) + #:export (%test-ganeti-kvm %test-ganeti-lxc)) + +(define %ganeti-os + (operating-system + (host-name "gnt1") + (timezone "Etc/UTC") + (locale "en_US.UTF-8") + + (bootloader (bootloader-configuration + (bootloader grub-bootloader) + (target "/dev/vda"))) + (file-systems (cons (file-system + (device (file-system-label "my-root")) + (mount-point "/") + (type "ext4")) + %base-file-systems)) + (firmware '()) + + ;; The hosts file must contain a nonlocal IP for host-name. + ;; In addition, the cluster name must resolve to an IP address that + ;; is not currently provisioned. + (hosts-file (plain-file "hosts" (format #f " +127.0.0.1 localhost +::1 localhost +10.0.2.2 gnt1.example.com gnt1 +192.168.254.254 ganeti.example.com +"))) + + (packages (append (list ganeti-instance-debootstrap ganeti-instance-guix) + %base-packages)) + (services + (append (list (static-networking-service "eth0" "10.0.2.2" + #:netmask "255.255.255.0" + #:gateway "10.0.2.1" + #:name-servers '("10.0.2.1")) + + (service openssh-service-type + (openssh-configuration + (permit-root-login 'without-password))) + + (service ganeti-service-type + (ganeti-configuration + (file-storage-paths '("/srv/ganeti/file-storage")) + (os %default-ganeti-os)))) + %base-services)))) + +(define* (run-ganeti-test hypervisor #:key + (master-netdev "eth0") + (hvparams '()) + (extra-packages '()) + (rapi-port 5080) + (noded-port 1811)) + "Run tests in %GANETI-OS." + (define os + (marionette-operating-system + (operating-system + (inherit %ganeti-os) + (packages (append extra-packages + (operating-system-packages %ganeti-os)))) + #:imported-modules '((gnu services herd) + (guix combinators)))) + + (define %forwarded-rapi-port 5080) + (define %forwarded-noded-port 1811) + + (define vm + (virtual-machine + (operating-system os) + ;; Some of the daemons are fairly memory-hungry. + (memory-size 512) + ;; Forward HTTP ports so we can access them from the "outside". + (port-forwardings `((,%forwarded-rapi-port . ,rapi-port) + (,%forwarded-noded-port . ,noded-port))))) + + (define test + (with-imported-modules '((gnu build marionette)) + #~(begin + (use-modules (srfi srfi-11) (srfi srfi-64) + (web uri) (web client) (web response) + (gnu build marionette)) + + (define marionette + (make-marionette (list #$vm))) + + (mkdir #$output) + (chdir #$output) + + (test-begin "ganeti") + + ;; Ganeti uses the Shepherd to start/stop daemons, so make sure + ;; it is ready before we begin. It takes a while because all + ;; Ganeti daemons fail to start initially. + (test-assert "shepherd is ready" + (wait-for-unix-socket "/var/run/shepherd/socket" marionette)) + + (test-eq "gnt-cluster init" + 0 + (marionette-eval + '(begin + (setenv + "PATH" + ;; Init needs to run 'ssh-keygen', 'ip', etc. + "/run/current-system/profile/sbin:/run/current-system/profile/bin") + (system* #$(file-append ganeti "/sbin/gnt-cluster") "init" + (string-append "--master-netdev=" #$master-netdev) + ;; TODO: Enable more disk backends. + "--enabled-disk-templates=file" + (string-append "--enabled-hypervisors=" + #$hypervisor) + (string-append "--hypervisor-parameters=" + #$hypervisor ":" + (string-join '#$hvparams "\n")) + ;; Set the default NIC mode to 'routed' to avoid having to + ;; configure a full bridge to placate 'gnt-cluster verify'. + "--nic-parameters=mode=routed,link=eth0" + "ganeti.example.com")) + marionette)) + + ;; Disable the watcher while doing daemon tests to prevent interference. + (test-eq "watcher pause" + 0 + (marionette-eval + '(begin + (system* #$(file-append ganeti "/sbin/gnt-cluster") + "watcher" "pause" "1h")) + marionette)) + + (test-assert "force-start wconfd" + ;; Check that the 'force-start' Shepherd action works, used in a + ;; master-failover scenario. + (marionette-eval + '(begin + (setenv "PATH" "/run/current-system/profile/bin") + (invoke "herd" "stop" "ganeti-wconfd") + (invoke "herd" "disable" "ganeti-wconfd") + (invoke "herd" "force-start" "ganeti-wconfd")) + marionette)) + + ;; Verify that the cluster is healthy. + (test-eq "gnt-cluster verify 1" + 0 + (marionette-eval + '(begin + (system* #$(file-append ganeti "/sbin/gnt-cluster") "verify")) + marionette)) + + ;; Try stopping and starting daemons with daemon-util like + ;; 'gnt-node add', 'gnt-cluster init', etc. + (test-eq "daemon-util stop-all" + 0 + (marionette-eval + '(begin + (system* #$(file-append ganeti "/lib/ganeti/daemon-util") + "stop-all")) + marionette)) + + (test-eq "daemon-util start-all" + 0 + (marionette-eval + '(begin + (system* #$(file-append ganeti "/lib/ganeti/daemon-util") + "start-all")) + marionette)) + + ;; Check that the cluster is still healthy after the daemon restarts. + (test-eq "gnt-cluster verify 2" + 0 + (marionette-eval + '(begin + (system* #$(file-append ganeti "/sbin/gnt-cluster") "verify")) + marionette)) + + (test-eq "watcher continue" + 0 + (marionette-eval + '(begin + (system* #$(file-append ganeti "/sbin/gnt-cluster") + "watcher" "continue")) + marionette)) + + ;; Try accessing the RAPI. This causes an expected failure: + ;; https://github.com/ganeti/ganeti/issues/1502 + ;; Run it anyway for easy testing of potential fixes. + (test-equal "http-get RAPI version" + '(200 "2") + (let-values + (((response text) + (http-get #$(simple-format + #f "http://localhost:~A/version" + %forwarded-rapi-port) + #:decode-body? #t))) + (list (response-code response) text))) + + (test-equal "gnt-os list" + "debootstrap+default\nguix+default\n" + (marionette-eval + '(begin + (use-modules (ice-9 popen)) + (let* ((port (open-pipe* + OPEN_READ + #$(file-append ganeti "/sbin/gnt-os") + "list" "--no-headers")) + (output (get-string-all port))) + (close-pipe port) + output)) + marionette)) + + (test-eq "gnt-cluster destroy" + 0 + (marionette-eval + '(begin + (system* #$(file-append ganeti "/sbin/gnt-cluster") + "destroy" "--yes-do-it")) + marionette)) + + (test-end) + (exit (= (test-runner-fail-count (test-runner-current)) 1))))) + + (gexp->derivation (string-append "ganeti-" hypervisor "-test") test)) + +(define %test-ganeti-kvm + (system-test + (name "ganeti-kvm") + (description "Provision a Ganeti cluster using the KVM hypervisor.") + (value (run-ganeti-test "kvm" + ;; Set kernel_path to an empty string to prevent + ;; 'gnt-cluster verify' from testing for its presence. + #:hvparams '("kernel_path=") + #:extra-packages (list qemu))))) + +(define %test-ganeti-lxc + (system-test + (name "ganeti-lxc") + (description "Provision a Ganeti cluster using LXC as the hypervisor.") + (value (run-ganeti-test "lxc" + #:extra-packages (list lxc))))) -- cgit v1.2.3 From 0482ea07f9d8ee53108ef6507d15fa7a70ac1a71 Mon Sep 17 00:00:00 2001 From: Marius Bakke Date: Fri, 17 Jul 2020 01:04:24 +0200 Subject: doc: Small fixups for the Ganeti documentation. * doc/guix.texi (Virtualization Services): Fix various inaccuracies and add markup the procedure parameters. --- doc/guix.texi | 30 ++++++++++++++---------------- 1 file changed, 14 insertions(+), 16 deletions(-) (limited to 'doc') diff --git a/doc/guix.texi b/doc/guix.texi index a6ee679b11..40c8f06bf0 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -24982,7 +24982,7 @@ the @code{--snapshot} flag using something along these lines: @quotation Note This service is considered experimental. Configuration options may be changed in a backwards-incompatible manner, and not all features have been thorougly -tested. Users of this service are encouraged to share their experience at +tested. Users of this service are encouraged to share their experience at @email{guix-devel@@gnu.org}. @end quotation @@ -25050,7 +25050,7 @@ Users are advised to read the administrators guide} to learn about the various cluster options and day-to-day operations. There is also a @url{https://guix.gnu.org/blog/2020/ganeti-on-guix/,blog post} -describing how to configure a small cluster. +describing how to configure and initialize a small cluster. @defvr {Scheme Variable} ganeti-service-type This is a service type that includes all the various services that Ganeti @@ -25058,6 +25058,8 @@ nodes should run. Its value is a @code{ganeti-configuration} object that defines the package to use for CLI operations, as well as configuration for the various daemons. +Allowed file storage paths and available guest operating systems are also +configured through this data type. @end defvr @deftp {Data Type} ganeti-configuration @@ -25124,8 +25126,8 @@ storage backend and OS variants. @end deftp @deftp {Data Type} ganeti-os -This data type is suitable for passing to the @code{os} configuration of -Ganeti. It takes the following parameters: +This data type is suitable for passing to the @code{os} parameter of +@code{ganeti-configuration}. It takes the following parameters: @table @asis @item @code{name} @@ -25175,16 +25177,14 @@ scripts that will run when the OS is installed. It can also be a list of @code{(name . file-like)} pairs. For example: @lisp - `((99-hello-world . ,(plain-file "#!/bin/sh\necho Hello, World"))) - @end lisp That will create a directory with one executable named @code{99-hello-world} and run it every time this variant is installed. If set to @code{#f}, hooks in @file{/etc/ganeti/instance-debootstrap/hooks} will be used, if any. @item @code{proxy} (default: @code{#f}) -HTTP proxy to use, if any. +Optional HTTP proxy to use. @item @code{mirror} (default: @code{#f}) The Debian mirror. Typically something like @code{http://ftp.no.debian.org/debian}. The default varies depending on the distribution. @@ -25213,24 +25213,24 @@ Alignment of the partition in sectors. @end table @end deftp -@deffn {Scheme Procedure} debootstrap-variant +@deffn {Scheme Procedure} debootstrap-variant @var{name} @var{configuration} This is a helper procedure that creates a @code{ganeti-os-variant} record. It takes two parameters: a name and a @code{debootstrap-configuration} object. @end deffn -@deffn {Scheme Procedure} debootstrap-os +@deffn {Scheme Procedure} debootstrap-os @var{variants}@dots{} This is a helper procedure that creates a @code{ganeti-os} record. It takes a list of variants created with @code{debootstrap-variant}. @end deffn -@deffn {Scheme Procedure} guix-variant +@deffn {Scheme Procedure} guix-variant @var{name} @var{configuration} This is a helper procedure that creates a @code{ganeti-os-variant} record for use with the Guix OS provider. It takes a name and a G-expression that returns a ``file-like'' (@pxref{G-Expressions, file-like objects}) object containing a Guix System configuration. @end deffn -@deffn {Scheme Procedure} guix-os +@deffn {Scheme Procedure} guix-os @var{variants}@dots{} This is a helper procedure that creates a @code{ganeti-os} record. It takes a list of variants produced by @code{guix-variant}. @end deffn @@ -25243,7 +25243,7 @@ contains a single debootstrap variant with the default configuration: @lisp (list (debootstrap-variant "default" - (debootstrap-configuration)))) + (debootstrap-configuration))) @end lisp @end defvr @@ -25256,7 +25256,7 @@ server, a serial console, and authorizes the Ganeti hosts SSH keys. (list (guix-variant "default" (file-append ganeti-instance-guix - "/share/doc/ganeti-instance-guix/examples/dynamic.scm")))) + "/share/doc/ganeti-instance-guix/examples/dynamic.scm"))) @end lisp @end defvr @@ -25524,9 +25524,7 @@ When true, the daemon performs additional logging for debugging purposes. @defvr {Scheme Variable} ganeti-metad-service-type @command{ganeti-metad} is an optional daemon that can be used to provide -information about the cluster to instances or OS install scripts. It is -not included in @code{ganeti-service-type} because using it requires -additional configuration and support in OS providers. +information about the cluster to instances or OS install scripts. It takes a @code{ganeti-metad-configuration} object. @end defvr -- cgit v1.2.3 From 55b90c90532cd50617fb3dd56173f96de1cbe0b3 Mon Sep 17 00:00:00 2001 From: Julien Lepiller Date: Sun, 28 Jun 2020 00:07:50 +0200 Subject: guix: Add maven-build-system. * guix/build-system/maven.scm: New file. * guix/build/maven-build-system.scm: New file. * Makefile.am (MODULES): Add them. * doc/guix.texi (Build Systems): Document the maven build system. --- Makefile.am | 2 + doc/guix.texi | 42 ++++++++ guix/build-system/maven.scm | 214 ++++++++++++++++++++++++++++++++++++++ guix/build/maven-build-system.scm | 163 +++++++++++++++++++++++++++++ 4 files changed, 421 insertions(+) create mode 100644 guix/build-system/maven.scm create mode 100644 guix/build/maven-build-system.scm (limited to 'doc') diff --git a/Makefile.am b/Makefile.am index c067e37c5f..31784adfff 100644 --- a/Makefile.am +++ b/Makefile.am @@ -132,6 +132,7 @@ MODULES = \ guix/build-system/haskell.scm \ guix/build-system/julia.scm \ guix/build-system/linux-module.scm \ + guix/build-system/maven.scm \ guix/build-system/node.scm \ guix/build-system/perl.scm \ guix/build-system/python.scm \ @@ -181,6 +182,7 @@ MODULES = \ guix/build/gnu-build-system.scm \ guix/build/gnu-dist.scm \ guix/build/guile-build-system.scm \ + guix/build/maven-build-system.scm \ guix/build/node-build-system.scm \ guix/build/perl-build-system.scm \ guix/build/python-build-system.scm \ diff --git a/doc/guix.texi b/doc/guix.texi index 40c8f06bf0..2041d10447 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -6811,6 +6811,48 @@ uuid, the package version, and a list of dependencies specified by their name and their uuid. @end defvr +@defvr {Scheme Variable} maven-build-system +This variable is exported by @code{(guix build-system maven)}. It implements +a build procedure for @uref{https://maven.apache.org, Maven} packages. Maven +is a dependency and lifecycle management tool for Java. A user of Maven +specifies dependencies and plugins in a @file{pom.xml} file that Maven reads. +When Maven does not have one of the dependencies or plugins in its repository, +it will download them and use them to build the package. + +The maven build system ensures that maven will not try to download any +dependency by running in offline mode. Maven will fail if a dependency is +missing. Before running Maven, the @file{pom.xml} (and subprojects) are +modified to specify the version of dependencies and plugins that match the +versions available in the guix build environment. Dependencies and plugins +must be installed in the fake maven repository at @file{lib/m2}, and are +symlinked into a proper repository before maven is run. Maven is instructed +to use that repository for the build and installs built artifacts there. +Changed files are copied to the @file{lib/m2} directory of the package output. + +You can specify a @file{pom.xml} file with the @code{#:pom-file} argument, +or let the build system use the default @file{pom.xml} file in the sources. + +In case you need to specify a dependency's version manually, you can use the +@code{#:local-packages} argument. It takes an association list where the key +is the groupId of the package and its value is an association list where the +key is the artifactId of the package and its value is the version you want to +override in the @file{pom.xml}. + +Some packages use dependencies or plugins that are not useful at runtime nor +at build time in Guix. You can alter the @file{pom.xml} file to remove them +using the @code{#:exclude} argument. Its value is an association list where +the key is the groupId of the plugin or dependency you want to remove, and +the value is a list of artifactId you want to remove. + +You can override the default @code{jdk} and @code{maven} packages with the +corresponding argument, @code{#:jdk} and @code{#:maven}. + +The @code{#:maven-plugins} argument is a list of maven plugins used during +the build, with the same format as the @code{inputs} fields of the package +declaration. Its default value is @code{%default-maven-plugins} which is +also exported. +@end defvr + @defvr {Scheme Variable} minify-build-system This variable is exported by @code{(guix build-system minify)}. It implements a minification procedure for simple JavaScript packages. diff --git a/guix/build-system/maven.scm b/guix/build-system/maven.scm new file mode 100644 index 0000000000..88ae1ce7bc --- /dev/null +++ b/guix/build-system/maven.scm @@ -0,0 +1,214 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2020 Julien Lepiller +;;; +;;; This file is part of GNU Guix. +;;; +;;; GNU Guix 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 of the License, or (at +;;; your option) any later version. +;;; +;;; GNU Guix 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 GNU Guix. If not, see . + +(define-module (guix build-system maven) + #:use-module (guix store) + #:use-module (guix utils) + #:use-module (guix derivations) + #:use-module (guix search-paths) + #:use-module (guix build-system) + #:use-module (guix build-system gnu) + #:use-module (guix packages) + #:use-module (ice-9 match) + #:use-module (srfi srfi-1) + #:export (%maven-build-system-modules + default-maven + %default-maven-plugins + %default-exclude + lower + maven-build + maven-build-system)) + +;; Commentary: +;; +;; Standard build procedure for Maven packages. This is implemented as an +;; extension of `gnu-build-system'. +;; +;; Code: + +(define %maven-build-system-modules + ;; Build-side modules imported by default. + `((guix build maven-build-system) + (guix build maven pom) + ,@%gnu-build-system-modules)) + +(define (default-maven) + "Return the default maven package." + + ;; Do not use `@' to avoid introducing circular dependencies. + (let ((module (resolve-interface '(gnu packages maven)))) + (module-ref module 'maven))) + +(define (default-maven-compiler-plugin) + "Return the default maven compiler plugin package." + ;; Do not use `@' to avoid introducing circular dependencies. + (let ((module (resolve-interface '(gnu packages maven)))) + (module-ref module 'maven-compiler-plugin))) + +(define (default-maven-jar-plugin) + "Return the default maven jar plugin package." + ;; Do not use `@' to avoid introducing circular dependencies. + (let ((module (resolve-interface '(gnu packages maven)))) + (module-ref module 'maven-jar-plugin))) + +(define (default-maven-resources-plugin) + "Return the default maven resources plugin package." + ;; Do not use `@' to avoid introducing circular dependencies. + (let ((module (resolve-interface '(gnu packages maven)))) + (module-ref module 'maven-resources-plugin))) + +(define (default-maven-surefire-plugin) + "Return the default maven surefire plugin package." + ;; Do not use `@' to avoid introducing circular dependencies. + (let ((module (resolve-interface '(gnu packages maven)))) + (module-ref module 'maven-surefire-plugin))) + +(define (default-java-surefire-junit4) + "Return the default surefire junit4 provider package." + ;; Do not use `@' to avoid introducing circular dependencies. + (let ((module (resolve-interface '(gnu packages maven)))) + (module-ref module 'java-surefire-junit4))) + +(define (default-maven-install-plugin) + "Return the default maven install plugin package." + ;; Do not use `@' to avoid introducing circular dependencies. + (let ((module (resolve-interface '(gnu packages maven)))) + (module-ref module 'maven-install-plugin))) + +(define (default-jdk) + "Return the default JDK package." + ;; Lazily resolve the binding to avoid a circular dependency. + (let ((jdk-mod (resolve-interface '(gnu packages java)))) + (module-ref jdk-mod 'icedtea))) + +(define %default-maven-plugins + `(("maven-compiler-plugin" ,(default-maven-compiler-plugin)) + ("maven-jar-plugin" ,(default-maven-jar-plugin)) + ("maven-resources-plugin" ,(default-maven-resources-plugin)) + ("maven-surefire-plugin" ,(default-maven-surefire-plugin)) + ("java-surefire-junit4" ,(default-java-surefire-junit4)) + ("maven-install-plugin" ,(default-maven-install-plugin)))) + +(define %default-exclude + `(("org.apache.maven.plugins" . + ("maven-release-plugin" "maven-site-plugin")))) + +(define* (lower name + #:key source inputs native-inputs outputs system target + (maven (default-maven)) + (jdk (default-jdk)) + (maven-plugins %default-maven-plugins) + (local-packages '()) + (exclude %default-exclude) + #:allow-other-keys + #:rest arguments) + "Return a bag for NAME." + (define private-keywords + '(#:source #:target #:jdk #:maven #:maven-plugins #:inputs #:native-inputs)) + + (and (not target) ;XXX: no cross-compilation + (bag + (name name) + (system system) + (host-inputs `(,@(if source + `(("source" ,source)) + '()) + ,@inputs + + ;; Keep the standard inputs of 'gnu-build-system'. + ,@(standard-packages))) + (build-inputs `(("maven" ,maven) + ("jdk" ,jdk "jdk") + ,@maven-plugins + ,@native-inputs)) + (outputs outputs) + (build maven-build) + (arguments (strip-keyword-arguments private-keywords arguments))))) + +(define* (maven-build store name inputs + #:key (guile #f) + (outputs '("out")) + (search-paths '()) + (out-of-source? #t) + (validate-runpath? #t) + (patch-shebangs? #t) + (strip-binaries? #t) + (exclude %default-exclude) + (local-packages '()) + (tests? #t) + (strip-flags ''("--strip-debug")) + (strip-directories ''("lib" "lib64" "libexec" + "bin" "sbin")) + (phases '(@ (guix build maven-build-system) + %standard-phases)) + (system (%current-system)) + (imported-modules %maven-build-system-modules) + (modules '((guix build maven-build-system) + (guix build maven pom) + (guix build utils)))) + "Build SOURCE using PATCHELF, and with INPUTS. This assumes that SOURCE +provides its own binaries." + (define builder + `(begin + (use-modules ,@modules) + (maven-build #:source ,(match (assoc-ref inputs "source") + (((? derivation? source)) + (derivation->output-path source)) + ((source) + source) + (source + source)) + #:system ,system + #:outputs %outputs + #:inputs %build-inputs + #:search-paths ',(map search-path-specification->sexp + search-paths) + #:phases ,phases + #:exclude (quote ,exclude) + #:local-packages (quote ,local-packages) + #:tests? ,tests? + #:out-of-source? ,out-of-source? + #:validate-runpath? ,validate-runpath? + #:patch-shebangs? ,patch-shebangs? + #:strip-binaries? ,strip-binaries? + #:strip-flags ,strip-flags + #:strip-directories ,strip-directories))) + + (define guile-for-build + (match guile + ((? package?) + (package-derivation store guile system #:graft? #f)) + (#f ; the default + (let* ((distro (resolve-interface '(gnu packages commencement))) + (guile (module-ref distro 'guile-final))) + (package-derivation store guile system #:graft? #f))))) + + (build-expression->derivation store name builder + #:system system + #:inputs inputs + #:modules imported-modules + #:outputs outputs + #:guile-for-build guile-for-build)) + +(define maven-build-system + (build-system + (name 'maven) + (description "The standard Maven build system") + (lower lower))) + +;;; maven.scm ends here diff --git a/guix/build/maven-build-system.scm b/guix/build/maven-build-system.scm new file mode 100644 index 0000000000..914298d584 --- /dev/null +++ b/guix/build/maven-build-system.scm @@ -0,0 +1,163 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2020 Julien Lepiller +;;; +;;; This file is part of GNU Guix. +;;; +;;; GNU Guix 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 of the License, or (at +;;; your option) any later version. +;;; +;;; GNU Guix 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 GNU Guix. If not, see . + +(define-module (guix build maven-build-system) + #:use-module ((guix build gnu-build-system) #:prefix gnu:) + #:use-module (guix build utils) + #:use-module (guix build maven pom) + #:use-module (ice-9 match) + #:export (%standard-phases + maven-build)) + +;; Commentary: +;; +;; Builder-side code of the standard maven build procedure. +;; +;; Code: + +(define* (set-home #:key outputs inputs #:allow-other-keys) + (let ((home (string-append (getcwd) "/build-home"))) + (setenv "HOME" home)) + (setenv "JAVA_HOME" (assoc-ref inputs "jdk")) + #t) + +(define* (configure #:key inputs #:allow-other-keys) + (let* ((m2-files (map + (lambda (input) + (match input + ((name . dir) + (let ((m2-dir (string-append dir "/lib/m2"))) + (if (file-exists? m2-dir) m2-dir #f))))) + inputs)) + (m2-files (filter (lambda (a) a) m2-files))) + (for-each + (lambda (m2-dir) + (for-each + (lambda (file) + (let ((dir (string-append (getenv "HOME") "/.m2/repository/" + (dirname file)))) + (mkdir-p dir) + (symlink (string-append m2-dir "/" file) + (string-append dir "/" (basename file))))) + (with-directory-excursion m2-dir + (find-files "." ".*.(jar|pom)$")))) + m2-files)) + (invoke "mvn" "-v") + #t) + +(define (add-local-package local-packages group artifact version) + (define (alist-set lst key val) + (match lst + ('() (list (cons key val))) + (((k . v) lst ...) + (if (equal? k key) + (cons (cons key val) lst) + (cons (cons k v) (alist-set lst key val)))))) + (alist-set local-packages group + (alist-set (or (assoc-ref local-packages group) '()) artifact + version))) + +(define (fix-pom pom-file inputs local-packages excludes) + (chmod pom-file #o644) + (format #t "fixing ~a~%" pom-file) + (fix-pom-dependencies pom-file (map cdr inputs) + #:with-plugins? #t #:with-build-dependencies? #t + #:local-packages local-packages + #:excludes excludes) + (let* ((pom (get-pom pom-file)) + (java-inputs (map cdr inputs)) + (artifact (pom-artifactid pom)) + (group (pom-groupid pom java-inputs local-packages)) + (version (pom-version pom java-inputs local-packages))) + (let loop ((modules (pom-ref pom "modules")) + (local-packages + (add-local-package local-packages group artifact version))) + (pk 'local-packages local-packages) + (match modules + (#f local-packages) + ('() local-packages) + (((? string? _) modules ...) + (loop modules local-packages)) + (((_ module) modules ...) + (loop + modules + (fix-pom (string-append (dirname pom-file) "/" module "/pom.xml") + inputs local-packages excludes))))))) + +(define* (fix-pom-files #:key inputs local-packages exclude #:allow-other-keys) + (fix-pom "pom.xml" inputs local-packages exclude)) + +(define* (build #:key outputs #:allow-other-keys) + "Build the given package." + (invoke "mvn" "package" + ;; offline mode: don't download dependencies + "-o" + ;, set directory where dependencies are installed + (string-append "-Duser.home=" (getenv "HOME"))) + #t) + +(define* (check #:key tests? #:allow-other-keys) + "Check the given package." + (when tests? + (invoke "mvn" "test" + (string-append "-Duser.home=" (getenv "HOME")) + "-e")) + #t) + +(define* (install #:key outputs #:allow-other-keys) + "Install the given package." + (let* ((out (assoc-ref outputs "out")) + (java (string-append out "/lib/m2"))) + (invoke "mvn" "install" "-o" "-e" + "-DskipTests" + (string-append "-Duser.home=" (getenv "HOME"))) + ;; Go through the repository to find files that can be installed + (with-directory-excursion (string-append (getenv "HOME") "/.m2/repository") + (let ((installable + (filter (lambda (file) + (not (eq? 'symlink (stat:type (lstat file))))) + (find-files "." ".")))) + (mkdir-p java) + (for-each + (lambda (file) + (mkdir-p (string-append java "/" (dirname file))) + (copy-file file (string-append java "/" file))) + installable))) + ;; Remove some files that are not required and introduce timestamps + (for-each delete-file (find-files out "maven-metadata-local.xml")) + (for-each delete-file (find-files out "_remote.repositories"))) + #t) + +(define %standard-phases + ;; Everything is as with the GNU Build System except for the `configure' + ;; , `build', `check' and `install' phases. + (modify-phases gnu:%standard-phases + (delete 'bootstrap) + (add-before 'configure 'set-home set-home) + (replace 'configure configure) + (add-after 'configure 'fix-pom-files fix-pom-files) + (replace 'build build) + (replace 'check check) + (replace 'install install))) + +(define* (maven-build #:key inputs (phases %standard-phases) + #:allow-other-keys #:rest args) + "Build the given package, applying all of PHASES in order." + (apply gnu:gnu-build #:inputs inputs #:phases phases args)) + +;;; maven-build-system.scm ends here -- cgit v1.2.3 From 22b3a95f6eb375c9ca89af9eeee8ec9903abd557 Mon Sep 17 00:00:00 2001 From: Christopher Baines Date: Fri, 17 Jul 2020 09:43:11 +0100 Subject: build-system/maven: Make default-maven-plugins a procedure. This allows compiling the module without the (gnu packages maven) module being available. * guix/build-system/maven.scm (%default-maven-plugins): Rename to default-maven-plugins, and convert to a procedure. * doc/guix.texi (maven-build-system): Update. --- doc/guix.texi | 2 +- guix/build-system/maven.scm | 6 +++--- 2 files changed, 4 insertions(+), 4 deletions(-) (limited to 'doc') diff --git a/doc/guix.texi b/doc/guix.texi index 2041d10447..2c5c017eea 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -6849,7 +6849,7 @@ corresponding argument, @code{#:jdk} and @code{#:maven}. The @code{#:maven-plugins} argument is a list of maven plugins used during the build, with the same format as the @code{inputs} fields of the package -declaration. Its default value is @code{%default-maven-plugins} which is +declaration. Its default value is @code{(default-maven-plugins)} which is also exported. @end defvr diff --git a/guix/build-system/maven.scm b/guix/build-system/maven.scm index 88ae1ce7bc..2dceefccc1 100644 --- a/guix/build-system/maven.scm +++ b/guix/build-system/maven.scm @@ -28,7 +28,7 @@ #:use-module (srfi srfi-1) #:export (%maven-build-system-modules default-maven - %default-maven-plugins + default-maven-plugins %default-exclude lower maven-build @@ -96,7 +96,7 @@ (let ((jdk-mod (resolve-interface '(gnu packages java)))) (module-ref jdk-mod 'icedtea))) -(define %default-maven-plugins +(define (default-maven-plugins) `(("maven-compiler-plugin" ,(default-maven-compiler-plugin)) ("maven-jar-plugin" ,(default-maven-jar-plugin)) ("maven-resources-plugin" ,(default-maven-resources-plugin)) @@ -112,7 +112,7 @@ #:key source inputs native-inputs outputs system target (maven (default-maven)) (jdk (default-jdk)) - (maven-plugins %default-maven-plugins) + (maven-plugins (default-maven-plugins)) (local-packages '()) (exclude %default-exclude) #:allow-other-keys -- cgit v1.2.3 From 41daf1286575f3a1998493c893f6d5a9c5b62de8 Mon Sep 17 00:00:00 2001 From: Marius Bakke Date: Sun, 19 Jul 2020 09:59:57 +0200 Subject: services: ganeti: Use TLS on the remote API by default. * gnu/services/ganeti.scm (): Set SSL? to #t. * gnu/tests/ganeti.scm (%ganeti-os): Set SSL? to #f. * doc/guix.texi (Virtualization Services): Adjust accordingly. --- doc/guix.texi | 2 +- gnu/services/ganeti.scm | 2 +- gnu/tests/ganeti.scm | 5 +++++ 3 files changed, 7 insertions(+), 2 deletions(-) (limited to 'doc') diff --git a/doc/guix.texi b/doc/guix.texi index 2c5c017eea..df37349c4a 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -25497,7 +25497,7 @@ The maximum number of simultaneous client requests to handle. Further connections are allowed, but no responses are sent until enough connections have closed. -@item @code{ssl?} (default: @code{#f}) +@item @code{ssl?} (default: @code{#t}) Whether to use SSL/TLS encryption on the RAPI port. @item @code{ssl-key} (default: @file{"/var/lib/ganeti/server.pem"}) diff --git a/gnu/services/ganeti.scm b/gnu/services/ganeti.scm index 80a61818f7..f7d1aeb8da 100644 --- a/gnu/services/ganeti.scm +++ b/gnu/services/ganeti.scm @@ -450,7 +450,7 @@ be submitted via this daemon and it schedules and starts them."))) (max-clients ganeti-rapi-configuration-max-clients ;integer (default 20)) (ssl? ganeti-rapi-configuration-ssl? ;Boolean - (default #f)) + (default #t)) (ssl-key ganeti-rapi-configuration-ssl-key ;string (default "/var/lib/ganeti/server.pem")) (ssl-cert ganeti-rapi-configuration-ssl-cert ;string diff --git a/gnu/tests/ganeti.scm b/gnu/tests/ganeti.scm index 0615edcde4..ff853a7149 100644 --- a/gnu/tests/ganeti.scm +++ b/gnu/tests/ganeti.scm @@ -70,6 +70,11 @@ (service ganeti-service-type (ganeti-configuration (file-storage-paths '("/srv/ganeti/file-storage")) + (rapi-configuration + (ganeti-rapi-configuration + ;; Disable TLS so we can test the RAPI without + ;; pulling in GnuTLS. + (ssl? #f))) (os %default-ganeti-os)))) %base-services)))) -- cgit v1.2.3 From eccdd80e080ae4ea22fdc32d09b0cf12efe702cc Mon Sep 17 00:00:00 2001 From: Marius Bakke Date: Sun, 19 Jul 2020 10:03:51 +0200 Subject: doc: Fix Ganeti blog post URL. * doc/guix.texi (Virtualization Services): Adjust Ganeti blog post URL. --- doc/guix.texi | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'doc') diff --git a/doc/guix.texi b/doc/guix.texi index df37349c4a..26ef937604 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -25091,7 +25091,7 @@ Users are advised to read the @url{http://docs.ganeti.org/ganeti/master/html/admin.html,Ganeti administrators guide} to learn about the various cluster options and day-to-day operations. There is also a -@url{https://guix.gnu.org/blog/2020/ganeti-on-guix/,blog post} +@url{https://guix.gnu.org/blog/2020/running-a-ganeti-cluster-on-guix/,blog post} describing how to configure and initialize a small cluster. @defvr {Scheme Variable} ganeti-service-type -- cgit v1.2.3 From e8088f0b06c2193f2cce04a48aa1350229442a9f Mon Sep 17 00:00:00 2001 From: Lars-Dominik Braun Date: Mon, 20 Jul 2020 11:28:51 +0200 Subject: ssh: Speed up RPCs by using #:nodelay. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Partly fixes . * guix/ssh.scm (open-ssh-session): Enable #:nodelay. * m4/guix.m4 (GUIX_CHECK_GUILE_SSH): Add feature check for this new parameter. * doc/guix.texi (Requirements): Adjust. Co-authored-by: Ludovic Courtès --- doc/guix.texi | 4 ++-- guix/ssh.scm | 6 +++++- m4/guix.m4 | 6 ++++-- 3 files changed, 11 insertions(+), 5 deletions(-) (limited to 'doc') diff --git a/doc/guix.texi b/doc/guix.texi index 26ef937604..da5a2e2214 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -791,11 +791,11 @@ The following dependencies are optional: @itemize @item -@c Note: We need at least 0.12.0 for 'userauth-gssapi!'. +@c Note: We need at least 0.13.0 for #:nodelay. Support for build offloading (@pxref{Daemon Offload Setup}) and @command{guix copy} (@pxref{Invoking guix copy}) depends on @uref{https://github.com/artyom-poptsov/guile-ssh, Guile-SSH}, -version 0.12.0 or later. +version 0.13.0 or later. @item When @url{https://www.nongnu.org/lzip/lzlib.html, lzlib} is available, lzlib diff --git a/guix/ssh.scm b/guix/ssh.scm index 2d7ca7d01d..b9e6ff8564 100644 --- a/guix/ssh.scm +++ b/guix/ssh.scm @@ -129,7 +129,11 @@ Throw an error on failure." ;; We need lightweight compression when ;; exchanging full archives. #:compression compression - #:compression-level 3))) + #:compression-level 3 + + ;; Speed up RPCs by creating sockets with + ;; TCP_NODELAY. + #:nodelay #t))) ;; Honor ~/.ssh/config. (session-parse-config! session) diff --git a/m4/guix.m4 b/m4/guix.m4 index 7c27ae74df..cce03045db 100644 --- a/m4/guix.m4 +++ b/m4/guix.m4 @@ -142,14 +142,16 @@ dnl GUIX_CHECK_GUILE_SSH dnl dnl Check whether a recent-enough Guile-SSH is available. AC_DEFUN([GUIX_CHECK_GUILE_SSH], [ - dnl Check whether 'userauth-gssapi!' (introduced in 0.12.0) is present. + dnl Check whether '#:nodelay' paramater to 'make-session' (introduced in + dnl 0.13.0) is present. AC_CACHE_CHECK([whether Guile-SSH is available and recent enough], [guix_cv_have_recent_guile_ssh], [GUILE_CHECK([retval], [(and (@ (ssh channel) channel-send-eof) (@ (ssh popen) open-remote-pipe) (@ (ssh dist node) node-eval) - (@ (ssh auth) userauth-gssapi!))]) + (@ (ssh auth) userauth-gssapi!) + ((@ (ssh session) make-session) #:nodelay #t))]) if test "$retval" = 0; then guix_cv_have_recent_guile_ssh="yes" else -- cgit v1.2.3 From ad5cb62d4afab2b4a808121fe81c5b8db053d7fe Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Tue, 21 Jul 2020 12:28:20 +0200 Subject: doc: Mention the 'savannah' updater. * doc/guix.texi (Invoking guix refresh): Mention 'savannah' updater. --- doc/guix.texi | 2 ++ 1 file changed, 2 insertions(+) (limited to 'doc') diff --git a/doc/guix.texi b/doc/guix.texi index da5a2e2214..8696a9b554 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -10047,6 +10047,8 @@ list of updaters). Currently, @var{updater} may be one of: @table @code @item gnu the updater for GNU packages; +@item savannah +the updater for packages hosted at @uref{https://savannah.gnu.org, Savannah}; @item gnome the updater for GNOME packages; @item kde -- cgit v1.2.3 From 4656180d5de1fef2846bea9af27ae509f32376ba Mon Sep 17 00:00:00 2001 From: Oleg Pykhalov Date: Wed, 22 Jul 2020 09:47:16 +0300 Subject: services: nix: Fix sandbox. * gnu/tests/package-management.scm: New file. * gnu/local.mk: Add this. * gnu/services/nix.scm (): New record. (nix-activation): Generate Nix config file which fixes sandbox. (nix-service-type): Add default value. (nix-shepherd-service): Allow provide Nix package. * doc/guix.texi (Miscellaneous Services)[Nix service]: Document record. --- doc/guix.texi | 21 +++++++ gnu/local.mk | 1 + gnu/services/nix.scm | 91 +++++++++++++++++---------- gnu/tests/package-management.scm | 130 +++++++++++++++++++++++++++++++++++++++ 4 files changed, 211 insertions(+), 32 deletions(-) create mode 100644 gnu/tests/package-management.scm (limited to 'doc') diff --git a/doc/guix.texi b/doc/guix.texi index 8696a9b554..feef91b59c 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -27599,6 +27599,27 @@ $ source /run/current-system/profile/etc/profile.d/nix.sh @end defvr +@deftp {Data Type} nix-configuration +This data type represents the configuration of the Nix daemon. + +@table @asis +@item @code{nix} (default: @code{nix}) +The Nix package to use. + +@item @code{sandbox} (default: @code{#t}) +Specifies whether builds are sandboxed by default. + +@item @code{build-sandbox-items} (default: @code{'()}) +This is a list of strings or objects appended to the +@code{build-sandbox-items} field of the configuration file. + +@item @code{extra-config} (default: @code{'()}) +This is a list of strings or objects appended to the configuration file. +It is used to pass extra text to be added verbatim to the configuration +file. +@end table +@end deftp + @node Setuid Programs @section Setuid Programs diff --git a/gnu/local.mk b/gnu/local.mk index a1bd6a644a..3eee908752 100644 --- a/gnu/local.mk +++ b/gnu/local.mk @@ -674,6 +674,7 @@ GNU_SYSTEM_MODULES = \ %D%/tests/mail.scm \ %D%/tests/messaging.scm \ %D%/tests/networking.scm \ + %D%/tests/package-management.scm \ %D%/tests/reconfigure.scm \ %D%/tests/rsync.scm \ %D%/tests/security-token.scm \ diff --git a/gnu/services/nix.scm b/gnu/services/nix.scm index 3c0065207d..75b2df02dc 100644 --- a/gnu/services/nix.scm +++ b/gnu/services/nix.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2019 Oleg Pykhalov +;;; Copyright © 2019, 2020 Oleg Pykhalov ;;; ;;; This file is part of GNU Guix. ;;; @@ -31,7 +31,9 @@ #:use-module (guix store) #:use-module (srfi srfi-1) #:use-module (srfi srfi-26) + #:use-module (ice-9 match) #:use-module (ice-9 format) + #:use-module (guix modules) #:export (nix-service-type)) ;;; Commentary: @@ -40,10 +42,17 @@ ;;; ;;; Code: - -;;; -;;; Accounts -;;; +(define-record-type* + nix-configuration make-nix-configuration + nix-configuration? + (package nix-configuration-package ;package + (default nix)) + (sandbox nix-configuration-sandbox ;boolean + (default #t)) + (build-sandbox-items nix-configuration-build-sandbox-items ;list of strings + (default '())) + (extra-config nix-configuration-extra-options ;list of strings + (default '()))) ;; Copied from gnu/services/base.scm (define* (nix-build-accounts count #:key @@ -74,32 +83,50 @@ GID." (id 40000)) (nix-build-accounts 10 #:group "nixbld"))) -(define (nix-activation _) - "Return the activation gexp." - (with-imported-modules '((guix build utils)) - #~(begin - (use-modules (guix build utils) - (srfi srfi-26)) - (for-each (cut mkdir-p <>) '("/nix/store" "/nix/var/log" - "/nix/var/nix/gcroots/per-user" - "/nix/var/nix/profiles/per-user")) - (chown "/nix/store" - (passwd:uid (getpw "root")) (group:gid (getpw "nixbld01"))) - (chmod "/nix/store" #o775) - (for-each (cut chmod <> #o777) '("/nix/var/nix/profiles" - "/nix/var/nix/profiles/per-user"))))) +(define nix-activation + ;; Return the activation gexp. + (match-lambda + (($ package sandbox build-sandbox-items extra-config) + (with-imported-modules (source-module-closure + '((guix build store-copy))) + #~(begin + (use-modules (guix build utils) + (ice-9 format) + (srfi srfi-1) + (srfi srfi-26)) + (for-each (cut mkdir-p <>) '("/nix/store" "/nix/var/log" + "/nix/var/nix/gcroots/per-user" + "/nix/var/nix/profiles/per-user")) + (chown "/nix/store" + (passwd:uid (getpw "root")) (group:gid (getpw "nixbld01"))) + (chmod "/nix/store" #o775) + (for-each (cut chmod <> #o777) '("/nix/var/nix/profiles" + "/nix/var/nix/profiles/per-user")) + (mkdir-p "/etc/nix") + (with-output-to-file "/etc/nix/nix.conf" + (lambda _ + (format #t "sandbox = ~a~%" (if #$sandbox "true" "false")) + ;; config.nix captures store file names. + (format #t "build-sandbox-paths = ~{~a ~}~%" + (append (append-map (cut call-with-input-file <> read) + '#$(map references-file + (list package))) + '#$build-sandbox-items)) + (for-each (cut display <>) '#$extra-config)))))))) -(define (nix-shepherd-service _) - "Return a for Nix." - (list - (shepherd-service - (provision '(nix-daemon)) - (documentation "Run nix-daemon.") - (requirement '()) - (start #~(make-forkexec-constructor - (list (string-append #$nix "/bin/nix-daemon")))) - (respawn? #f) - (stop #~(make-kill-destructor))))) +(define nix-shepherd-service + ;; Return a for Nix. + (match-lambda + (($ package _ ...) + (list + (shepherd-service + (provision '(nix-daemon)) + (documentation "Run nix-daemon.") + (requirement '()) + (start #~(make-forkexec-constructor + (list (string-append #$package "/bin/nix-daemon")))) + (respawn? #f) + (stop #~(make-kill-destructor))))))) (define nix-service-type (service-type @@ -108,7 +135,7 @@ GID." (list (service-extension shepherd-root-service-type nix-shepherd-service) (service-extension account-service-type nix-accounts) (service-extension activation-service-type nix-activation))) - (default-value '()) - (description "Run the Nix daemon."))) + (description "Run the Nix daemon.") + (default-value (nix-configuration)))) ;;; nix.scm ends here diff --git a/gnu/tests/package-management.scm b/gnu/tests/package-management.scm new file mode 100644 index 0000000000..087eaf923e --- /dev/null +++ b/gnu/tests/package-management.scm @@ -0,0 +1,130 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2020 Oleg Pykhalov +;;; +;;; This file is part of GNU Guix. +;;; +;;; GNU Guix 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 of the License, or (at +;;; your option) any later version. +;;; +;;; GNU Guix 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 GNU Guix. If not, see . + +(define-module (gnu tests package-management) + #:use-module (gnu packages base) + #:use-module (gnu packages package-management) + #:use-module (gnu services) + #:use-module (gnu services networking) + #:use-module (gnu services nix) + #:use-module (gnu system) + #:use-module (gnu system vm) + #:use-module (gnu tests) + #:use-module (guix gexp) + #:use-module (guix packages) + #:export (%test-nix)) + +;;; Commentary: +;;; +;;; This module provides a test definition for the nix-daemon +;;; +;;; Code: + +(define* (run-nix-test name test-os) + "Run tests in TEST-OS, which has nix-daemon running." + (define os + (marionette-operating-system + test-os + #:imported-modules '((gnu services herd)))) + + (define vm + (virtual-machine + (operating-system os) + (port-forwardings '((8080 . 80))) + (memory-size 1024))) + + (define test + (with-imported-modules '((gnu build marionette)) + #~(begin + (use-modules (srfi srfi-11) + (srfi srfi-64) + (gnu build marionette) + (web client) + (web response)) + + (define marionette + (make-marionette (list #$vm))) + + (mkdir #$output) + (chdir #$output) + + (test-begin #$name) + + ;; XXX: Shepherd reads the config file *before* binding its control + ;; socket, so /var/run/shepherd/socket might not exist yet when the + ;; 'marionette' service is started. + (test-assert "shepherd socket ready" + (marionette-eval + `(begin + (use-modules (gnu services herd)) + (let loop ((i 10)) + (cond ((file-exists? (%shepherd-socket-file)) + #t) + ((> i 0) + (sleep 1) + (loop (- i 1))) + (else + 'failure)))) + marionette)) + + (test-assert "Nix daemon running" + (marionette-eval + '(begin + ;; Wait for nix-daemon to be up and running. + (start-service 'nix-daemon) + (with-output-to-file "guix-test.nix" + (lambda () + (display "\ +with import ; + +derivation { + system = builtins.currentSystem; + name = \"guix-test\"; + builder = shell; + args = [\"-c\" \"mkdir $out\\necho FOO > $out/foo\"]; + PATH = coreutils; +} +"))) + (zero? (system* (string-append #$nix "/bin/nix-build") + "--substituters" "" "--debug" "--no-out-link" + "guix-test.nix"))) + marionette)) + + (test-end) + + (exit (= (test-runner-fail-count (test-runner-current)) 0))))) + + (gexp->derivation (string-append name "-test") test)) + +(define %nix-os + ;; Return operating system under test. + (let ((base-os + (simple-operating-system + (service nix-service-type) + (service dhcp-client-service-type)))) + (operating-system + (inherit base-os) + (packages (cons nix (operating-system-packages base-os)))))) + +(define %test-nix + (system-test + (name "nix") + (description "Connect to a running nix-daemon") + (value (run-nix-test name %nix-os)))) + +;;; package-management.scm ends here -- cgit v1.2.3 From 63c799c1c585214cce4bfe3b9f8493255afa561e Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Wed, 22 Jul 2020 15:04:21 +0200 Subject: doc: Recommend running 'guix git authenticate' when cloning the repo. * doc/contributing.texi (Building from Git): Adjust instruction and recommend 'guix git authenticate'. --- doc/contributing.texi | 35 ++++++++++++++++------------------- 1 file changed, 16 insertions(+), 19 deletions(-) (limited to 'doc') diff --git a/doc/contributing.texi b/doc/contributing.texi index 4049073b96..f5d73e78aa 100644 --- a/doc/contributing.texi +++ b/doc/contributing.texi @@ -42,30 +42,27 @@ git clone https://git.savannah.gnu.org/git/guix.git @cindex authentication, of a Guix checkout How do you ensure that you obtained a genuine copy of the repository? -Guix itself provides a tool to @dfn{authenticate} your checkout, but you -must first make sure this tool is genuine in order to ``bootstrap'' the -trust chain. To do that, run: +To do that, run @command{guix git authenticate}, passing if the commit +and OpenPGP fingerprint of the @dfn{channel introduction} +(@pxref{Invoking guix git authenticate}): -@c XXX: Adjust instructions when there's a known tag to start from. +@c The commit and fingerprint below must match those of the channel +@c introduction in '%default-channels'. @example -git verify-commit `git log --format=%H build-aux/git-authenticate.scm` -@end example - -The output must look something like: - -@example -gpg: Signature made Fri 27 Dec 2019 01:27:41 PM CET -gpg: using RSA key 3CE464558A84FDC69DB40CFB090B11993D9AEBB5 -@dots{} -gpg: Signature made Fri 27 Dec 2019 01:25:22 PM CET -gpg: using RSA key 3CE464558A84FDC69DB40CFB090B11993D9AEBB5 -@dots{} +guix git authenticate 9edb3f66fd807b096b48283debdcddccfea34bad \ + "BBB0 2DDF 2CEA F6A8 0D1D E643 A2A0 6DF2 A33A 54FA" @end example @noindent -... meaning that changes to this file are all signed with key -@code{3CE464558A84FDC69DB40CFB090B11993D9AEBB5} (you may need to fetch -this key from a key server, if you have not done it yet). +This command completes with exit code zero on success; it prints an +error message and exits with a non-zero code otherwise. + +As you can see, there is a chicken-and-egg problem: you first need to +have Guix installed. Typically you would install Guix System +(@pxref{System Installation}) or Guix on top of another distro +(@pxref{Binary Installation}); in either case, you would verify the +OpenPGP signature on the installation medium. This ``bootstraps'' the +trust chain. The easiest way to set up a development environment for Guix is, of course, by using Guix! The following command starts a new shell where -- cgit v1.2.3 From 9e0d896bf3208a6dffa9b2798185dbf976bad9a8 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Wed, 22 Jul 2020 22:15:04 +0200 Subject: doc: Tweak mcron example. * doc/guix.texi (Scheduled Job Execution): In example, move '%min-level' definition after 'use-modules'. --- doc/guix.texi | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) (limited to 'doc') diff --git a/doc/guix.texi b/doc/guix.texi index feef91b59c..b0eba017a6 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -13843,12 +13843,14 @@ illustrates that. (with-imported-modules (source-module-closure '((guix build utils))) #~(begin - (define %min-level 20) (use-modules (guix build utils) (ice-9 popen) (ice-9 regex) (ice-9 textual-ports) (srfi srfi-2)) + + (define %min-level 20) + (setenv "LC_ALL" "C") ;ensure English output (and-let* ((input-pipe (open-pipe* OPEN_READ -- cgit v1.2.3 From 8e31736b0a60919cc1bfc5dc22c395b09243484a Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Thu, 16 Jul 2020 00:01:17 +0200 Subject: guix system: 'reconfigure' disallows downgrades by default. This is similar to what 9744cc7b4636fafb772c94adb8f05961b5b39f16 did for 'guix pull'. * guix/scripts/system/reconfigure.scm (ensure-forward-reconfigure) (warn-about-backward-reconfigure, channel-relations) (check-forward-update): New procedures. * guix/scripts/system.scm (perform-action): Add #:validate-reconfigure. Call 'check-forward-update' when ACTION is 'reconfigure. (%options, show-help): Add "--allow-downgrades". (%default-options): Add 'validate-reconfigure' key. (process-action): Pass #:validate-reconfigure to 'perform-action'. * doc/guix.texi (Invoking guix system): Document 'guix system describe' more prominently, and document '--allow-downgrades'. --- doc/guix.texi | 35 +++++++++++-- guix/scripts/system.scm | 15 +++++- guix/scripts/system/reconfigure.scm | 97 ++++++++++++++++++++++++++++++++++++- 3 files changed, 141 insertions(+), 6 deletions(-) (limited to 'doc') diff --git a/doc/guix.texi b/doc/guix.texi index b0eba017a6..fb1c66dcf4 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -28388,11 +28388,16 @@ an older system generation at boot time should you need it. Upon completion, the new system is deployed under @file{/run/current-system}. This directory contains @dfn{provenance meta-data}: the list of channels in use (@pxref{Channels}) and -@var{file} itself, when available. This information is useful should -you later want to inspect how this particular generation was built. +@var{file} itself, when available. You can view it by running: -In fact, assuming @var{file} is self-contained, you can later rebuild -generation @var{n} of your operating system with: +@example +guix system describe +@end example + +This information is useful should you later want to inspect how this +particular generation was built. In fact, assuming @var{file} is +self-contained, you can later rebuild generation @var{n} of your +operating system with: @example guix time-machine \ @@ -28406,6 +28411,12 @@ system is not just a binary artifact: @emph{it carries its own source}. @xref{Service Reference, @code{provenance-service-type}}, for more information on provenance tracking. +By default, @command{reconfigure} @emph{prevents you from downgrading +your system}, which could (re)introduce security vulnerabilities and +also cause problems with ``stateful'' services such as database +management systems. You can override that behavior by passing +@option{--allow-downgrades}. + @item switch-generation @cindex generations Switch to an existing system generation. This action atomically @@ -28732,6 +28743,22 @@ appear in the @code{operating-system} declaration actually exist needed at boot time are listed in @code{initrd-modules} (@pxref{Initial RAM Disk}). Passing this option skips these tests altogether. +@item --allow-downgrades +Instruct @command{guix system reconfigure} to allow system downgrades. + +By default, @command{reconfigure} prevents you from downgrading your +system. It achieves that by comparing the provenance info of your +system (shown by @command{guix system describe}) with that of your +@command{guix} command (shown by @command{guix describe}). If the +commits for @command{guix} are not descendants of those used for your +system, @command{guix system reconfigure} errors out. Passing +@option{--allow-downgrades} allows you to bypass these checks. + +@quotation Note +Make sure you understand its security implications before using +@option{--allow-downgrades}. +@end quotation + @cindex on-error @cindex on-error strategy @cindex error strategy diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm index f2b4367094..79bfcd7db2 100644 --- a/guix/scripts/system.scm +++ b/guix/scripts/system.scm @@ -736,6 +736,7 @@ and TARGET arguments." (define* (perform-action action os #:key + (validate-reconfigure ensure-forward-reconfigure) save-provenance? skip-safety-checks? install-bootloader? @@ -778,7 +779,8 @@ static checks." (operating-system-bootcfg os menu-entries))) (when (eq? action 'reconfigure) - (maybe-suggest-running-guix-pull)) + (maybe-suggest-running-guix-pull) + (check-forward-update validate-reconfigure)) ;; Check whether the declared file systems exist. This is better than ;; instantiating a broken configuration. Assume that we can only check if @@ -926,6 +928,9 @@ Some ACTIONS support additional ARGS.\n")) (display (G_ " -e, --expression=EXPR consider the operating-system EXPR evaluates to instead of reading FILE, when applicable")) + (display (G_ " + --allow-downgrades for 'reconfigure', allow downgrades to earlier + channel revisions")) (display (G_ " --on-error=STRATEGY apply STRATEGY (one of nothing-special, backtrace, @@ -981,6 +986,11 @@ Some ACTIONS support additional ARGS.\n")) (option '(#\d "derivation") #f #f (lambda (opt name arg result) (alist-cons 'derivations-only? #t result))) + (option '("allow-downgrades") #f #f + (lambda (opt name arg result) + (alist-cons 'validate-reconfigure + warn-about-backward-reconfigure + result))) (option '("on-error") #t #f (lambda (opt name arg result) (alist-cons 'on-error (string->symbol arg) @@ -1053,6 +1063,7 @@ Some ACTIONS support additional ARGS.\n")) (graft? . #t) (debug . 0) (verbosity . #f) ;default + (validate-reconfigure . ,ensure-forward-reconfigure) (file-system-type . "ext4") (image-size . guess) (install-bootloader? . #t))) @@ -1138,6 +1149,8 @@ resulting from command-line parsing." #:use-substitutes? (assoc-ref opts 'substitutes?) #:skip-safety-checks? (assoc-ref opts 'skip-safety-checks?) + #:validate-reconfigure + (assoc-ref opts 'validate-reconfigure) #:file-system-type (assoc-ref opts 'file-system-type) #:image-size (assoc-ref opts 'image-size) #:full-boot? (assoc-ref opts 'full-boot?) diff --git a/guix/scripts/system/reconfigure.scm b/guix/scripts/system/reconfigure.scm index 7885c33457..9013e035f7 100644 --- a/guix/scripts/system/reconfigure.scm +++ b/guix/scripts/system/reconfigure.scm @@ -34,9 +34,18 @@ #:use-module (guix monads) #:use-module (guix store) #:use-module ((guix self) #:select (make-config.scm)) + #:autoload (guix describe) (current-profile) + #:use-module (guix channels) + #:autoload (guix git) (update-cached-checkout) + #:use-module (guix i18n) + #:use-module (guix diagnostics) + #:use-module ((guix utils) #:select (&fix-hint)) #:use-module (ice-9 match) #:use-module (srfi srfi-1) #:use-module (srfi srfi-11) + #:use-module (srfi srfi-34) + #:use-module (srfi srfi-35) + #:use-module ((guix config) #:select (%guix-package-name)) #:export (switch-system-program switch-to-system @@ -44,7 +53,11 @@ upgrade-shepherd-services install-bootloader-program - install-bootloader)) + install-bootloader + + check-forward-update + ensure-forward-reconfigure + warn-about-backward-reconfigure)) ;;; Commentary: ;;; @@ -266,3 +279,85 @@ additional configurations specified by MENU-ENTRIES can be selected." bootcfg-file device target)))))) + + +;;; +;;; Downgrade detection. +;;; + +(define (ensure-forward-reconfigure channel start commit relation) + "Raise an error if RELATION is not 'ancestor, meaning that START is not an +ancestor of COMMIT, unless CHANNEL specifies a commit." + (match relation + ('ancestor #t) + ('self #t) + (_ + (raise (make-compound-condition + (condition + (&message (message + (format #f (G_ "\ +aborting reconfiguration because commit ~a of channel '~a' is not a descendant of ~a") + commit (channel-name channel) + start))) + (&fix-hint + (hint (G_ "Use @option{--allow-downgrades} to force +this downgrade."))))))))) + +(define (warn-about-backward-reconfigure channel start commit relation) + "Warn about non-forward updates of CHANNEL from START to COMMIT, without +aborting." + (match relation + ((or 'ancestor 'self) + #t) + ('descendant + (warning (G_ "rolling back channel '~a' from ~a to ~a~%") + (channel-name channel) start commit)) + ('unrelated + (warning (G_ "moving channel '~a' from ~a to unrelated commit ~a~%") + (channel-name channel) start commit)))) + +(define (channel-relations old new) + "Return a list of channel/relation pairs, where each relation is a symbol as +returned by 'commit-relation' denoting how commits of channels in OLD relate +to commits of channels in NEW." + (filter-map (lambda (old) + (let ((new (find (lambda (channel) + (eq? (channel-name channel) + (channel-name old))) + new))) + (and new + (let-values (((checkout commit relation) + (update-cached-checkout + (channel-url new) + #:ref + `(commit . ,(channel-commit new)) + #:starting-commit + (channel-commit old) + #:check-out? #f))) + (list new + (channel-commit old) (channel-commit new) + relation))))) + old)) + +(define* (check-forward-update #:optional + (validate-reconfigure ensure-forward-reconfigure)) + "Call VALIDATE-RECONFIGURE passing it, for each channel, the channel, the +currently-deployed commit (as returned by 'guix system describe') and the +target commit (as returned by 'guix describe')." + ;; TODO: Make that functionality available to 'guix deploy'. + (define new + (or (and=> (current-profile) profile-channels) + '())) + + (define old + (system-provenance "/run/current-system")) + + (when (null? old) + (warning (G_ "cannot determine provenance for /run/current-system~%"))) + (when (and (null? new) (not (getenv "GUIX_UNINSTALLED"))) + (warning (G_ "cannot determine provenance of ~a~%") %guix-package-name)) + + (for-each (match-lambda + ((channel old new relation) + (validate-reconfigure channel old new relation))) + (channel-relations old new))) -- cgit v1.2.3