From 4695472f8a2ff054da8137df1605b27b3d2bafb7 Mon Sep 17 00:00:00 2001 From: Tobias Geerinckx-Rice Date: Tue, 5 Sep 2017 18:53:38 +0200 Subject: doc: Fix typo in copyright header. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * doc/guix.texi: Move stray ‘@*’ to where it belongs. --- 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 70a9e36f4d..0a18f71da1 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -38,8 +38,8 @@ Copyright @copyright{} 2017 Thomas Danckaert@* Copyright @copyright{} 2017 humanitiesNerd@* Copyright @copyright{} 2017 Christopher Allan Webber@* Copyright @copyright{} 2017 Marius Bakke@* -Copyright @copyright{} 2017 Hartmut Goebel -Copyright @copyright{} 2017 Maxim Cournoyer@* +Copyright @copyright{} 2017 Hartmut Goebel@* +Copyright @copyright{} 2017 Maxim Cournoyer 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 352a5b639b2adfa343f5a786529bb112636757ea Mon Sep 17 00:00:00 2001 From: Tobias Geerinckx-Rice Date: Tue, 5 Sep 2017 18:54:08 +0200 Subject: services: web: Fix nginx-service-type's ‘file’ procedure. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * gnu/services/web.scm (nginx-activation, nginx-shepherd-service): Replace references to non-existent ‘config-file’ with ‘file’. * doc/guix.texi (Web Services): Likewise. --- doc/guix.texi | 12 ++++++------ gnu/services/web.scm | 8 ++++---- 2 files changed, 10 insertions(+), 10 deletions(-) (limited to 'doc') diff --git a/doc/guix.texi b/doc/guix.texi index 0a18f71da1..3e9593d0cb 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -39,7 +39,8 @@ Copyright @copyright{} 2017 humanitiesNerd@* Copyright @copyright{} 2017 Christopher Allan Webber@* Copyright @copyright{} 2017 Marius Bakke@* Copyright @copyright{} 2017 Hartmut Goebel@* -Copyright @copyright{} 2017 Maxim Cournoyer +Copyright @copyright{} 2017 Maxim Cournoyer@* +Copyright @copyright{} 2017 Tobias Geerinckx-Rice Permission is granted to copy, distribute and/or modify this document under the terms of the GNU Free Documentation License, Version 1.3 or @@ -14139,13 +14140,12 @@ requests with two servers. "server2.example.com"))))))) @end example -@item @code{config-file} (default: @code{#f}) -If the @var{config-file} is provided, this will be used, rather than +@item @code{file} (default: @code{#f}) +If a configuration @var{file} is provided, this will be used, rather than generating a configuration file from the provided @code{log-directory}, @code{run-directory}, @code{server-list} and @code{upstream-list}. For -proper operation, these arguments should match what is in -@var{config-file} to ensure that the directories are created when the -service is activated. +proper operation, these arguments should match what is in @var{file} to +ensure that the directories are created when the service is activated. This can be useful if you have an existing configuration file, or it's not possible to do what is required through the other parts of the diff --git a/gnu/services/web.scm b/gnu/services/web.scm index 18278502e4..4aa6fd501c 100644 --- a/gnu/services/web.scm +++ b/gnu/services/web.scm @@ -262,7 +262,7 @@ of index files." (define nginx-activation (match-lambda (($ nginx log-directory run-directory server-blocks - upstream-blocks config-file) + upstream-blocks file) #~(begin (use-modules (guix build utils)) @@ -281,7 +281,7 @@ of index files." (mkdir-p (string-append #$run-directory "/logs")) ;; Check configuration file syntax. (system* (string-append #$nginx "/sbin/nginx") - "-c" #$(or config-file + "-c" #$(or file (default-nginx-config nginx log-directory run-directory server-blocks upstream-blocks)) "-t"))))) @@ -289,14 +289,14 @@ of index files." (define nginx-shepherd-service (match-lambda (($ nginx log-directory run-directory server-blocks - upstream-blocks config-file) + upstream-blocks file) (let* ((nginx-binary (file-append nginx "/sbin/nginx")) (nginx-action (lambda args #~(lambda _ (zero? (system* #$nginx-binary "-c" - #$(or config-file + #$(or file (default-nginx-config nginx log-directory run-directory server-blocks upstream-blocks)) #$@args)))))) -- cgit v1.2.3 From fb25508856b5dc646b1a9771c70eaa071cee6742 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Thu, 7 Sep 2017 11:30:44 +0200 Subject: size: Default to '--sort=self'. * guix/scripts/size.scm (%default-options): Change default value for 'profile Date: Thu, 7 Sep 2017 22:23:34 +0200 Subject: doc: Update elogind URL. * doc/guix.texi (Desktop Services): Update elogind 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 68f0aa2aa8..6d2bf9ea30 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -11659,7 +11659,7 @@ and policy files. For example, to allow avahi-daemon to use the system bus, @deffn {Scheme Procedure} elogind-service [#:config @var{config}] Return a service that runs the @code{elogind} login and -seat management daemon. @uref{https://github.com/andywingo/elogind, +seat management daemon. @uref{https://github.com/elogind/elogind, Elogind} exposes a D-Bus interface that can be used to know which users are logged in, know what kind of sessions they have open, suspend the system, inhibit system suspend, reboot the system, and other tasks. -- cgit v1.2.3 From fb1cba687e2f4d8d19660085941fc9d56e77b4c7 Mon Sep 17 00:00:00 2001 From: Oleg Pykhalov Date: Tue, 5 Sep 2017 14:04:14 +0300 Subject: doc: Replace server-list with server-blocks. * doc/guix.texi (Web Services): Replace 'server-list' with 'server-blocks'. Signed-off-by: Christopher Baines --- doc/guix.texi | 14 +++++++------- 1 file changed, 7 insertions(+), 7 deletions(-) (limited to 'doc') diff --git a/doc/guix.texi b/doc/guix.texi index 6d2bf9ea30..be11520b3a 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -14037,7 +14037,7 @@ A simple example configuration is given below. @example (service nginx-service-type (nginx-configuration - (server-list + (server-blocks (list (nginx-server-configuration (server-name '("www.example.com")) (root "/srv/http/www.example.com") @@ -14085,7 +14085,7 @@ The directory to which NGinx will write log files. The directory in which NGinx will create a pid file, and write temporary files. -@item @code{server-list} (default: @code{'()}) +@item @code{server-blocks} (default: @code{'()}) A list of @dfn{server blocks} to create in the generated configuration file, the elements should be of type @code{}. @@ -14096,7 +14096,7 @@ HTTPS. @example (service nginx-service-type (nginx-configuration - (server-list + (server-blocks (list (nginx-server-configuration (server-name '("www.example.com")) (root "/srv/http/www.example.com") @@ -14121,7 +14121,7 @@ requests with two servers. (service nginx-service-type (nginx-configuration - (server-list + (server-blocks (list (nginx-server-configuration (server-name '("www.example.com")) (root "/srv/http/www.example.com") @@ -14143,9 +14143,9 @@ requests with two servers. @item @code{file} (default: @code{#f}) If a configuration @var{file} is provided, this will be used, rather than generating a configuration file from the provided @code{log-directory}, -@code{run-directory}, @code{server-list} and @code{upstream-list}. For -proper operation, these arguments should match what is in @var{file} to -ensure that the directories are created when the service is activated. +@code{run-directory}, @code{server-blocks} and @code{upstream-list}. For +proper operation, these arguments should match what is in @var{file} to ensure +that the directories are created when the service is activated. This can be useful if you have an existing configuration file, or it's not possible to do what is required through the other parts of the -- cgit v1.2.3 From c2a59a92bb18360f26d251c8b1b121b40b1bc806 Mon Sep 17 00:00:00 2001 From: Christopher Baines Date: Sun, 10 Sep 2017 11:48:34 +0100 Subject: doc: Replace upstream-list with upstream-blocks. This fixes the documentation to match the implementation. * doc/guix.texi (Web Services): Replace 'upstream-list' with 'upstream-blocks'. --- doc/guix.texi | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) (limited to 'doc') diff --git a/doc/guix.texi b/doc/guix.texi index be11520b3a..0399c39814 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -14105,12 +14105,12 @@ HTTPS. (ssl-certificate-key #f)))))) @end example -@item @code{upstream-list} (default: @code{'()}) +@item @code{upstream-blocks} (default: @code{'()}) A list of @dfn{upstream blocks} to create in the generated configuration file, the elements should be of type @code{}. -Configuring upstreams through the @code{upstream-list} can be useful +Configuring upstreams through the @code{upstream-blocks} can be useful when combined with @code{locations} in the @code{} records. The following example creates a server configuration with one location configuration, that @@ -14133,7 +14133,7 @@ requests with two servers. (nginx-location-configuration (uri "/path1") (body '("proxy_pass http://server-proxy;")))))))) - (upstream-list + (upstream-blocks (list (nginx-upstream-configuration (name "server-proxy") (servers (list "server1.example.com" @@ -14143,7 +14143,7 @@ requests with two servers. @item @code{file} (default: @code{#f}) If a configuration @var{file} is provided, this will be used, rather than generating a configuration file from the provided @code{log-directory}, -@code{run-directory}, @code{server-blocks} and @code{upstream-list}. For +@code{run-directory}, @code{server-blocks} and @code{upstream-blocks}. For proper operation, these arguments should match what is in @var{file} to ensure that the directories are created when the service is activated. -- cgit v1.2.3 From a9468b422b6df2349a3f4d1451c9302c3d77011b Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Fri, 1 Sep 2017 00:15:31 +0200 Subject: substitute: Download from unauthorized sources that provide the right content. This allows substitutes to be downloaded from unauthorized servers, as long as they advertise the same hash and references as one of the authorized servers. * guix/scripts/substitute.scm (assert-valid-narinfo): Remove. (valid-narinfo?): Add #:verbose?. Handle each case of 'signature-case'. (equivalent-narinfo?): New procedure. (lookup-narinfos/diverse): Add 'authorized?' parameter and honor it. [select-hit]: New procedure. (lookup-narinfo): Add 'authorized?' parameter and pass it. (process-query): Adjust callers accordingly. (process-substitution): Remove call to 'assert-valid-narinfo'. Check whether 'lookup-narinfo' returns true and call 'leave' if not. * tests/substitute.scm (%main-substitute-directory) (%alternate-substitute-directory): New variables. (call-with-narinfo): Make 'narinfo-directory' a parameter. Call 'mkdir-p' to create it. Change unwind handler to check whether CACHE-DIRECTORY exists before deleting it. (with-narinfo*): New macro. ("substitute, no signature") ("substitute, invalid hash") ("substitute, unauthorized key"): Change expected error message to "no valid substitute". ("substitute, unauthorized narinfo comes first") ("substitute, unsigned narinfo comes first") ("substitute, first narinfo is unsigned and has wrong hash") ("substitute, first narinfo is unsigned and has wrong refs") ("substitute, unsigned narinfo comes first") ("substitute, two invalid narinfos"): New tests. * doc/guix.texi (Substitutes): Explain the new behavior. --- doc/guix.texi | 28 ++++++- guix/scripts/substitute.scm | 134 ++++++++++++++++++++----------- tests/substitute.scm | 190 +++++++++++++++++++++++++++++++++++++++++--- 3 files changed, 290 insertions(+), 62 deletions(-) (limited to 'doc') diff --git a/doc/guix.texi b/doc/guix.texi index 0399c39814..c5b277d027 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -2143,6 +2143,8 @@ your system has unpatched security vulnerabilities. @cindex security @cindex digital signatures @cindex substitutes, authorization thereof +@cindex access control list (ACL), for substitutes +@cindex ACL (access control list), for substitutes To allow Guix to download substitutes from @code{hydra.gnu.org} or a mirror thereof, you must add its public key to the access control list (ACL) of archive @@ -2191,9 +2193,29 @@ The following files would be downloaded: This indicates that substitutes from @code{hydra.gnu.org} are usable and will be downloaded, when possible, for future builds. -Guix ignores substitutes that are not signed, or that are not signed by -one of the keys listed in the ACL. It also detects and raises an error -when attempting to use a substitute that has been tampered with. +Guix detects and raises an error when attempting to use a substitute +that has been tampered with. Likewise, it ignores substitutes that are +not signed, or that are not signed by one of the keys listed in the ACL. + +There is one exception though: if an unauthorized server provides +substitutes that are @emph{bit-for-bit identical} to those provided by +an authorized server, then the unauthorized server becomes eligible for +downloads. For example, assume we have chosen two substitute servers +with this option: + +@example +--substitute-urls="https://a.example.org https://b.example.org" +@end example + +@noindent +@cindex reproducible builds +If the ACL contains only the key for @code{b.example.org}, and if +@code{a.example.org} happens to serve the @emph{exact same} substitutes, +then Guix will download substitutes from @code{a.example.org} because it +comes first in the list and can be considered a mirror of +@code{b.example.org}. In practice, independent build machines usually +produce the same binaries, thanks to bit-reproducible builds (see +below). @vindex http_proxy Substitutes are downloaded over HTTP or HTTPS. diff --git a/guix/scripts/substitute.scm b/guix/scripts/substitute.scm index 592c497322..dd49cf15f3 100755 --- a/guix/scripts/substitute.scm +++ b/guix/scripts/substitute.scm @@ -78,7 +78,6 @@ narinfo-signature narinfo-hash->sha256 - assert-valid-narinfo lookup-narinfos lookup-narinfos/diverse @@ -407,38 +406,41 @@ No authentication and authorization checks are performed here!" (let ((above-signature (string-take contents index))) (sha256 (string->utf8 above-signature))))))) -(define* (assert-valid-narinfo narinfo - #:optional (acl (current-acl)) - #:key verbose?) - "Raise an exception if NARINFO lacks a signature, has an invalid signature, -or is signed by an unauthorized key." - (let ((hash (narinfo-sha256 narinfo))) - (if (not hash) - (if %allow-unauthenticated-substitutes? - narinfo - (leave (G_ "substitute at '~a' lacks a signature~%") - (uri->string (narinfo-uri narinfo)))) - (let ((signature (narinfo-signature narinfo))) - (unless %allow-unauthenticated-substitutes? - (assert-valid-signature narinfo signature hash acl) - (when verbose? - (format (current-error-port) - (G_ "Found valid signature for ~a~%") - (narinfo-path narinfo)) - (format (current-error-port) - (G_ "From ~a~%") - (uri->string (narinfo-uri narinfo))))) - narinfo)))) - -(define* (valid-narinfo? narinfo #:optional (acl (current-acl))) +(define* (valid-narinfo? narinfo #:optional (acl (current-acl)) + #:key verbose?) "Return #t if NARINFO's signature is not valid." (or %allow-unauthenticated-substitutes? (let ((hash (narinfo-sha256 narinfo)) - (signature (narinfo-signature narinfo))) + (signature (narinfo-signature narinfo)) + (uri (uri->string (narinfo-uri narinfo)))) (and hash signature (signature-case (signature hash acl) (valid-signature #t) - (else #f)))))) + (invalid-signature + (when verbose? + (format (current-error-port) + "invalid signature for substitute at '~a'~%" + uri)) + #f) + (hash-mismatch + (when verbose? + (format (current-error-port) + "hash mismatch for substitute at '~a'~%" + uri)) + #f) + (unauthorized-key + (when verbose? + (format (current-error-port) + "substitute at '~a' is signed by an \ +unauthorized party~%" + uri)) + #f) + (corrupt-signature + (when verbose? + (format (current-error-port) + "corrupt signature for substitute at '~a'~%" + uri)) + #f)))))) (define (write-narinfo narinfo port) "Write NARINFO to PORT." @@ -708,30 +710,68 @@ information is available locally." (let ((missing (fetch-narinfos cache missing))) (append cached (or missing '())))))) -(define (lookup-narinfos/diverse caches paths) +(define (equivalent-narinfo? narinfo1 narinfo2) + "Return true if NARINFO1 and NARINFO2 are equivalent--i.e., if they describe +the same store item. This ignores unnecessary metadata such as the Nar URL." + (and (string=? (narinfo-hash narinfo1) + (narinfo-hash narinfo2)) + + ;; The following is not needed if all we want is to download a valid + ;; nar, but it's necessary if we want valid narinfo. + (string=? (narinfo-path narinfo1) + (narinfo-path narinfo2)) + (equal? (narinfo-references narinfo1) + (narinfo-references narinfo2)) + + (= (narinfo-size narinfo1) + (narinfo-size narinfo2)))) + +(define (lookup-narinfos/diverse caches paths authorized?) "Look up narinfos for PATHS on all of CACHES, a list of URLS, in that order. -That is, when a cache lacks a narinfo, look it up in the next cache, and so -on. Return a list of narinfos for PATHS or a subset thereof." +That is, when a cache lacks an AUTHORIZED? narinfo, look it up in the next +cache, and so on. + +Return a list of narinfos for PATHS or a subset thereof. The returned +narinfos are either AUTHORIZED?, or they claim a hash that matches an +AUTHORIZED? narinfo." + (define (select-hit result) + (lambda (path) + (match (vhash-fold* cons '() path result) + ((one) + one) + ((several ..1) + (let ((authorized (find authorized? (reverse several)))) + (and authorized + (find (cut equivalent-narinfo? <> authorized) + several))))))) + (let loop ((caches caches) (paths paths) - (result '())) + (result vlist-null) ;path->narinfo vhash + (hits '())) ;paths (match paths (() ;we're done - result) + ;; Now iterate on all the HITS, and return exactly one match for each + ;; hit: the first narinfo that is authorized, or that has the same hash + ;; as an authorized narinfo, in the order of CACHES. + (filter-map (select-hit result) hits)) (_ (match caches ((cache rest ...) (let* ((narinfos (lookup-narinfos cache paths)) - (hits (map narinfo-path narinfos)) - (missing (lset-difference string=? paths hits))) ;XXX: perf - (loop rest missing (append narinfos result)))) + (definite (map narinfo-path (filter authorized? narinfos))) + (missing (lset-difference string=? paths definite))) ;XXX: perf + (loop rest missing + (fold vhash-cons result + (map narinfo-path narinfos) narinfos) + (append definite hits)))) (() ;that's it - result)))))) + (filter-map (select-hit result) hits))))))) -(define (lookup-narinfo caches path) +(define (lookup-narinfo caches path authorized?) "Return the narinfo for PATH in CACHES, or #f when no substitute for PATH was found." - (match (lookup-narinfos/diverse caches (list path)) + (match (lookup-narinfos/diverse caches (list path) authorized?) ((answer) answer) (_ #f))) @@ -868,15 +908,15 @@ authorized substitutes." (match (string-tokenize command) (("have" paths ..1) ;; Return the subset of PATHS available in CACHE-URLS. - (let ((substitutable (lookup-narinfos/diverse cache-urls paths))) + (let ((substitutable (lookup-narinfos/diverse cache-urls paths valid?))) (for-each (lambda (narinfo) (format #t "~a~%" (narinfo-path narinfo))) - (filter valid? substitutable)) + substitutable) (newline))) (("info" paths ..1) ;; Reply info about PATHS if it's in CACHE-URLS. - (let ((substitutable (lookup-narinfos/diverse cache-urls paths))) - (for-each display-narinfo-data (filter valid? substitutable)) + (let ((substitutable (lookup-narinfos/diverse cache-urls paths valid?))) + (for-each display-narinfo-data substitutable) (newline))) (wtf (error "unknown `--query' command" wtf)))) @@ -885,10 +925,12 @@ authorized substitutes." #:key cache-urls acl) "Substitute STORE-ITEM (a store file name) from CACHE-URLS, and write it to DESTINATION as a nar file. Verify the substitute against ACL." - (let* ((narinfo (lookup-narinfo cache-urls store-item)) - (uri (narinfo-uri narinfo))) - ;; Make sure it is signed and everything. - (assert-valid-narinfo narinfo acl) + (let* ((narinfo (lookup-narinfo cache-urls store-item + (cut valid-narinfo? <> acl))) + (uri (and=> narinfo narinfo-uri))) + (unless uri + (leave (G_ "no valid substitute for '~a'~%") + store-item)) ;; Tell the daemon what the expected hash of the Nar itself is. (format #t "~a~%" (narinfo-hash narinfo)) diff --git a/tests/substitute.scm b/tests/substitute.scm index b1d0fe9316..0ad6247954 100644 --- a/tests/substitute.scm +++ b/tests/substitute.scm @@ -1,6 +1,6 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2014 Nikita Karetnikov -;;; Copyright © 2014, 2015 Ludovic Courtès +;;; Copyright © 2014, 2015, 2017 Ludovic Courtès ;;; ;;; This file is part of GNU Guix. ;;; @@ -28,7 +28,9 @@ #:use-module (guix base32) #:use-module ((guix store) #:select (%store-prefix)) #:use-module ((guix ui) #:select (guix-warning-port)) - #:use-module ((guix build utils) #:select (delete-file-recursively)) + #:use-module ((guix build utils) + #:select (mkdir-p delete-file-recursively)) + #:use-module (guix tests http) #:use-module (rnrs bytevectors) #:use-module (rnrs io ports) #:use-module (web uri) @@ -112,6 +114,15 @@ version identifier.." +(define %main-substitute-directory + ;; The place where 'call-with-narinfo' stores its data by default. + (uri-path (string->uri (getenv "GUIX_BINARY_SUBSTITUTE_URL")))) + +(define %alternate-substitute-directory + ;; Another place. + (string-append (dirname %main-substitute-directory) + "/substituter-alt-data")) + (define %narinfo ;; Skeleton of the narinfo used below. (string-append "StorePath: " (%store-prefix) @@ -125,14 +136,14 @@ References: bar baz Deriver: " (%store-prefix) "/foo.drv System: mips64el-linux\n")) -(define (call-with-narinfo narinfo thunk) - "Call THUNK in a context where $GUIX_BINARY_SUBSTITUTE_URL is populated with +(define* (call-with-narinfo narinfo thunk + #:optional + (narinfo-directory %main-substitute-directory)) + "Call THUNK in a context where the directory at URL is populated with a file for NARINFO." - (let ((narinfo-directory (and=> (string->uri (getenv - "GUIX_BINARY_SUBSTITUTE_URL")) - uri-path)) - (cache-directory (string-append (getenv "XDG_CACHE_HOME") - "/guix/substitute/"))) + (mkdir-p narinfo-directory) + (let ((cache-directory (string-append (getenv "XDG_CACHE_HOME") + "/guix/substitute/"))) (dynamic-wind (lambda () (when (file-exists? cache-directory) @@ -161,11 +172,15 @@ a file for NARINFO." #f)) thunk (lambda () - (delete-file-recursively cache-directory))))) + (when (file-exists? cache-directory) + (delete-file-recursively cache-directory)))))) (define-syntax-rule (with-narinfo narinfo body ...) (call-with-narinfo narinfo (lambda () body ...))) +(define-syntax-rule (with-narinfo* narinfo directory body ...) + (call-with-narinfo narinfo (lambda () body ...) directory)) + ;; Transmit these options to 'guix substitute'. (substitute-urls (list (getenv "GUIX_BINARY_SUBSTITUTE_URL"))) @@ -227,7 +242,7 @@ a file for NARINFO." (guix-substitute "--query")))))))) (test-quit "substitute, no signature" - "lacks a signature" + "no valid substitute" (with-narinfo %narinfo (guix-substitute "--substitute" (string-append (%store-prefix) @@ -235,7 +250,7 @@ a file for NARINFO." "foo"))) (test-quit "substitute, invalid hash" - "hash" + "no valid substitute" ;; The hash in the signature differs from the hash of %NARINFO. (with-narinfo (string-append %narinfo "Signature: " (signature-field "different body") @@ -246,7 +261,7 @@ a file for NARINFO." "foo"))) (test-quit "substitute, unauthorized key" - "unauthorized" + "no valid substitute" (with-narinfo (string-append %narinfo "Signature: " (signature-field %narinfo @@ -272,9 +287,158 @@ a file for NARINFO." (lambda () (false-if-exception (delete-file "substitute-retrieved")))))) +(test-equal "substitute, unauthorized narinfo comes first" + "Substitutable data." + (with-narinfo* + (string-append %narinfo "Signature: " + (signature-field + %narinfo + #:public-key %wrong-public-key)) + %alternate-substitute-directory + + (with-narinfo* (string-append %narinfo "Signature: " + (signature-field %narinfo)) + %main-substitute-directory + + (dynamic-wind + (const #t) + (lambda () + ;; Remove this file so that the substitute can only be retrieved + ;; from %ALTERNATE-SUBSTITUTE-DIRECTORY. + (delete-file (string-append %main-substitute-directory + "/example.nar")) + + (parameterize ((substitute-urls + (map (cut string-append "file://" <>) + (list %alternate-substitute-directory + %main-substitute-directory)))) + (guix-substitute "--substitute" + (string-append (%store-prefix) + "/aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa-foo") + "substitute-retrieved")) + (call-with-input-file "substitute-retrieved" get-string-all)) + (lambda () + (false-if-exception (delete-file "substitute-retrieved"))))))) + +(test-equal "substitute, unsigned narinfo comes first" + "Substitutable data." + (with-narinfo* %narinfo ;not signed! + %alternate-substitute-directory + + (with-narinfo* (string-append %narinfo "Signature: " + (signature-field %narinfo)) + %main-substitute-directory + + (dynamic-wind + (const #t) + (lambda () + ;; Remove this file so that the substitute can only be retrieved + ;; from %ALTERNATE-SUBSTITUTE-DIRECTORY. + (delete-file (string-append %main-substitute-directory + "/example.nar")) + + (parameterize ((substitute-urls + (map (cut string-append "file://" <>) + (list %alternate-substitute-directory + %main-substitute-directory)))) + (guix-substitute "--substitute" + (string-append (%store-prefix) + "/aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa-foo") + "substitute-retrieved")) + (call-with-input-file "substitute-retrieved" get-string-all)) + (lambda () + (false-if-exception (delete-file "substitute-retrieved"))))))) + +(test-equal "substitute, first narinfo is unsigned and has wrong hash" + "Substitutable data." + (with-narinfo* (regexp-substitute #f + (string-match "NarHash: [[:graph:]]+" + %narinfo) + 'pre + "NarHash: sha256:" + (bytevector->nix-base32-string + (make-bytevector 32)) + 'post) + %alternate-substitute-directory + + (with-narinfo* (string-append %narinfo "Signature: " + (signature-field %narinfo)) + %main-substitute-directory + + (dynamic-wind + (const #t) + (lambda () + ;; This time remove the file so that the substitute can only be + ;; retrieved from %MAIN-SUBSTITUTE-DIRECTORY. + (delete-file (string-append %alternate-substitute-directory + "/example.nar")) + + (parameterize ((substitute-urls + (map (cut string-append "file://" <>) + (list %alternate-substitute-directory + %main-substitute-directory)))) + (guix-substitute "--substitute" + (string-append (%store-prefix) + "/aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa-foo") + "substitute-retrieved")) + (call-with-input-file "substitute-retrieved" get-string-all)) + (lambda () + (false-if-exception (delete-file "substitute-retrieved"))))))) + +(test-equal "substitute, first narinfo is unsigned and has wrong refs" + "Substitutable data." + (with-narinfo* (regexp-substitute #f + (string-match "References: ([^\n]+)\n" + %narinfo) + 'pre "References: " 1 + " wrong set of references\n" + 'post) + %alternate-substitute-directory + + (with-narinfo* (string-append %narinfo "Signature: " + (signature-field %narinfo)) + %main-substitute-directory + + (dynamic-wind + (const #t) + (lambda () + ;; This time remove the file so that the substitute can only be + ;; retrieved from %MAIN-SUBSTITUTE-DIRECTORY. + (delete-file (string-append %alternate-substitute-directory + "/example.nar")) + + (parameterize ((substitute-urls + (map (cut string-append "file://" <>) + (list %alternate-substitute-directory + %main-substitute-directory)))) + (guix-substitute "--substitute" + (string-append (%store-prefix) + "/aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa-foo") + "substitute-retrieved")) + (call-with-input-file "substitute-retrieved" get-string-all)) + (lambda () + (false-if-exception (delete-file "substitute-retrieved"))))))) + +(test-quit "substitute, two invalid narinfos" + "no valid substitute" + (with-narinfo* %narinfo ;not signed + %alternate-substitute-directory + + (with-narinfo* (string-append %narinfo "Signature: " ;unauthorized + (signature-field + %narinfo + #:public-key %wrong-public-key)) + %main-substitute-directory + + (guix-substitute "--substitute" + (string-append (%store-prefix) + "/aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa-foo") + "substitute-retrieved")))) + (test-end "substitute") ;;; Local Variables: ;;; eval: (put 'with-narinfo 'scheme-indent-function 1) +;;; eval: (put 'with-narinfo* 'scheme-indent-function 2) ;;; eval: (put 'test-quit 'scheme-indent-function 2) ;;; End: -- cgit v1.2.3 From 960c40de21650368021b20c78b79101bce022b51 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Tue, 12 Sep 2017 22:35:12 +0200 Subject: doc: Use Screen and OpenSSH in the bare-bones example. * gnu/system/examples/bare-bones.tmpl (packages): Remove TCPDUMP; add SCREEN and OPENSSH. * doc/guix.texi (Using the Configuration System): Adjust explanation accordingly. --- doc/guix.texi | 5 +++-- gnu/system/examples/bare-bones.tmpl | 4 ++-- 2 files changed, 5 insertions(+), 4 deletions(-) (limited to 'doc') diff --git a/doc/guix.texi b/doc/guix.texi index c5b277d027..0633691228 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -8186,8 +8186,9 @@ environment variable---in addition to the per-user profiles provides all the tools one would expect for basic user and administrator tasks---including the GNU Core Utilities, the GNU Networking Utilities, the GNU Zile lightweight text editor, @command{find}, @command{grep}, -etc. The example above adds tcpdump to those, taken from the @code{(gnu -packages admin)} module (@pxref{Package Modules}). The +etc. The example above adds GNU@tie{}Screen and OpenSSH to those, +taken from the @code{(gnu packages screen)} and @code{(gnu packages ssh)} +modules (@pxref{Package Modules}). The @code{(list package output)} syntax can be used to add a specific output of a package: diff --git a/gnu/system/examples/bare-bones.tmpl b/gnu/system/examples/bare-bones.tmpl index 459d241885..7e0c8fbee0 100644 --- a/gnu/system/examples/bare-bones.tmpl +++ b/gnu/system/examples/bare-bones.tmpl @@ -3,7 +3,7 @@ (use-modules (gnu)) (use-service-modules networking ssh) -(use-package-modules admin) +(use-package-modules screen ssh) (operating-system (host-name "komputilo") @@ -40,7 +40,7 @@ %base-user-accounts)) ;; Globally-installed packages. - (packages (cons tcpdump %base-packages)) + (packages (cons* screen openssh %base-packages)) ;; Add services to the baseline: a DHCP client and ;; an SSH server. -- cgit v1.2.3 From 9bb98bcf7b69951b6ce9b9564031893063740795 Mon Sep 17 00:00:00 2001 From: Jan Nieuwenhuizen Date: Tue, 12 Sep 2017 23:27:35 +0200 Subject: doc: Fix typo in cuirrass config example. * doc/guix.texi (Continuous Integration): Add missing quote in example spec. --- 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 0633691228..97960e9e04 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -27,7 +27,7 @@ Copyright @copyright{} 2016 Chris Marusich@* Copyright @copyright{} 2016, 2017 Efraim Flashner@* Copyright @copyright{} 2016 John Darrington@* Copyright @copyright{} 2016 ng0@* -Copyright @copyright{} 2016 Jan Nieuwenhuizen@* +Copyright @copyright{} 2016, 2017 Jan Nieuwenhuizen@* Copyright @copyright{} 2016 Julien Lepiller@* Copyright @copyright{} 2016 Alex ter Weele@* Copyright @copyright{} 2017 Clément Lassieur@* @@ -15246,7 +15246,7 @@ packages, as prescribed in the @file{gnu-system.scm} example spec: (#:branch . "master")))) (service cuirass-service-type (cuirass-configuration - (specifications #~(list #$spec))))) + (specifications #~(list '#$spec))))) @end example While information related to build jobs is located directly in the -- cgit v1.2.3 From 1c05aab4732e2805d3fd21900ab53618915b7480 Mon Sep 17 00:00:00 2001 From: Jan Nieuwenhuizen Date: Tue, 12 Sep 2017 23:43:29 +0200 Subject: gnu: cuirrass: Default port to 8081. * gnu/services/cuirass.scm (): Default port to 8081. Fixes conflict with guix-publish default. * doc/guix.texi (Continuous Integration): Update. --- doc/guix.texi | 2 +- gnu/services/cuirass.scm | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) (limited to 'doc') diff --git a/doc/guix.texi b/doc/guix.texi index 97960e9e04..c9505f41d7 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -15277,7 +15277,7 @@ Cuirass jobs. Location of sqlite database which contains the build results and previously added specifications. -@item @code{port} (default: @code{8080}) +@item @code{port} (default: @code{8081}) Port number used by the HTTP server. @item @code{specifications} (default: @code{#~'()}) diff --git a/gnu/services/cuirass.scm b/gnu/services/cuirass.scm index 73a30b2402..2ad5952202 100644 --- a/gnu/services/cuirass.scm +++ b/gnu/services/cuirass.scm @@ -60,7 +60,7 @@ (database cuirass-configuration-database ;string (file-name) (default "/var/run/cuirass/cuirass.db")) (port cuirass-configuration-port ;integer (port) - (default 8080)) + (default 8081)) (specifications cuirass-configuration-specifications) ;gexp that evaluates to specification-alist (use-substitutes? cuirass-configuration-use-substitutes? ;boolean -- cgit v1.2.3 From b714395a39fffc60f75408504a23dfe27ad13fc2 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Wed, 13 Sep 2017 16:01:36 +0200 Subject: services: Add a description and location for each service type. * gnu/services.scm ()[description, location]: New field. * doc/guix.texi (Service Types and Services): Document 'description'. --- doc/guix.texi | 4 ++++ gnu/services.scm | 13 ++++++++++++- 2 files changed, 16 insertions(+), 1 deletion(-) (limited to 'doc') diff --git a/doc/guix.texi b/doc/guix.texi index c9505f41d7..b2eed51bd0 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -18020,6 +18020,10 @@ Udev extensions are composed into a list of rules, but the udev service value is itself a @code{} record. So here, we extend that record by appending the list of rules it contains to the list of contributed rules. + +@item description +This is a string giving an overview of the service type. The string can +contain Texinfo markup (@pxref{Overview,,, texinfo, GNU Texinfo}). @end table There can be only one instance of an extensible service type such as diff --git a/gnu/services.scm b/gnu/services.scm index 8ef1ae7c77..83a163b766 100644 --- a/gnu/services.scm +++ b/gnu/services.scm @@ -49,6 +49,9 @@ service-type-compose service-type-extend service-type-default-value + service-type-description + service-type-location + service service? @@ -145,7 +148,15 @@ ;; Optional default value for instances of this type. (default-value service-type-default-value ;Any - (default &no-default-value))) + (default &no-default-value)) + + ;; Meta-data. + (description service-type-description ;string + (default #f)) + (location service-type-location ; + (default (and=> (current-source-location) + source-properties->location)) + (innate))) (define (write-service-type type port) (format port "#" -- cgit v1.2.3 From 0649321d91406bb5c19419fac931c202867d7416 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Wed, 13 Sep 2017 16:07:30 +0200 Subject: guix system: Add 'search' command. * guix/scripts/system.scm (resolve-subcommand): New procedure. (process-command): Handle 'search'. (guix-system): Likewise. (show-help): Augment. * guix/scripts/system/search.scm: New file. * po/guix/POTFILES.in: Add it. * Makefile.am (MODULES): Add it. * guix/ui.scm (%text-width): Export. * doc/guix.texi (Invoking guix system): Document it. (Service Types and Services): Mention 'guix system search'. * tests/guix-system.sh: Test it. --- Makefile.am | 1 + doc/guix.texi | 40 +++++++++++- guix/scripts/system.scm | 13 +++- guix/scripts/system/search.scm | 144 +++++++++++++++++++++++++++++++++++++++++ guix/ui.scm | 1 + po/guix/POTFILES.in | 1 + tests/guix-system.sh | 6 +- 7 files changed, 202 insertions(+), 4 deletions(-) create mode 100644 guix/scripts/system/search.scm (limited to 'doc') diff --git a/Makefile.am b/Makefile.am index aca18526f7..a2fb313916 100644 --- a/Makefile.am +++ b/Makefile.am @@ -164,6 +164,7 @@ MODULES = \ guix/scripts/authenticate.scm \ guix/scripts/refresh.scm \ guix/scripts/system.scm \ + guix/scripts/system/search.scm \ guix/scripts/lint.scm \ guix/scripts/challenge.scm \ guix/scripts/import/cran.scm \ diff --git a/doc/guix.texi b/doc/guix.texi index b2eed51bd0..ebeef50709 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -17391,6 +17391,42 @@ operating system is instantiated. Currently the following values are supported: @table @code +@item search +Display available service type definitions that match the given regular +expressions, sorted by relevance: + +@example +$ guix system search console font +name: console-fonts +location: gnu/services/base.scm:729:2 +extends: shepherd-root +description: Install the given fonts on the specified ttys (fonts are ++ per virtual console on GNU/Linux). The value of this service is a list ++ of tty/font pairs like: ++ ++ '(("tty1" . "LatGrkCyr-8x16")) +relevance: 20 + +name: mingetty +location: gnu/services/base.scm:1048:2 +extends: shepherd-root +description: Provide console login using the `mingetty' program. +relevance: 2 + +name: login +location: gnu/services/base.scm:775:2 +extends: pam +description: Provide a console log-in service as specified by its ++ configuration value, a `login-configuration' object. +relevance: 2 + +@dots{} +@end example + +As for @command{guix package --search}, the result is written in +@code{recutils} format, which makes it easy to filter the output +(@pxref{Top, GNU recutils databases,, recutils, GNU recutils manual}). + @item reconfigure Build the operating system described in @var{file}, activate it, and switch to it@footnote{This action (and the related actions @@ -18023,7 +18059,9 @@ list of contributed rules. @item description This is a string giving an overview of the service type. The string can -contain Texinfo markup (@pxref{Overview,,, texinfo, GNU Texinfo}). +contain Texinfo markup (@pxref{Overview,,, texinfo, GNU Texinfo}). The +@command{guix system search} command searches these strings and displays +them (@pxref{Invoking guix system}). @end table There can be only one instance of an extensible service type such as diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm index ea35fcdbc9..567d8bb643 100644 --- a/guix/scripts/system.scm +++ b/guix/scripts/system.scm @@ -73,7 +73,6 @@ "Read the operating-system declaration from FILE and return it." (load* file %user-module)) - ;;; ;;; Installation. @@ -751,6 +750,8 @@ Some ACTIONS support additional ARGS.\n")) (newline) (display (G_ "The valid values for ACTION are:\n")) (newline) + (display (G_ "\ + search search for existing service types\n")) (display (G_ "\ reconfigure switch to a new operating system configuration\n")) (display (G_ "\ @@ -937,6 +938,12 @@ resulting from command-line parsing." #:gc-root (assoc-ref opts 'gc-root))))) #:system system)))) +(define (resolve-subcommand name) + (let ((module (resolve-interface + `(guix scripts system ,(string->symbol name)))) + (proc (string->symbol (string-append "guix-system-" name)))) + (module-ref module proc))) + (define (process-command command args opts) "Process COMMAND, one of the 'guix system' sub-commands. ARGS is its argument list and OPTS is the option alist." @@ -949,6 +956,8 @@ argument list and OPTS is the option alist." ((pattern) pattern) (x (leave (G_ "wrong number of arguments~%")))))) (list-generations pattern))) + ((search) + (apply (resolve-subcommand "search") args)) ;; The following commands need to use the store, but they do not need an ;; operating system configuration file. ((switch-generation) @@ -978,7 +987,7 @@ argument list and OPTS is the option alist." (case action ((build container vm vm-image disk-image reconfigure init extension-graph shepherd-graph list-generations roll-back - switch-generation) + switch-generation search) (alist-cons 'action action result)) (else (leave (G_ "~a: unknown action~%") action)))))) diff --git a/guix/scripts/system/search.scm b/guix/scripts/system/search.scm new file mode 100644 index 0000000000..b4f790c9bf --- /dev/null +++ b/guix/scripts/system/search.scm @@ -0,0 +1,144 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2017 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 system search) + #:use-module (guix ui) + #:use-module (guix utils) + #:use-module (gnu services) + #:use-module (srfi srfi-1) + #:use-module (srfi srfi-11) + #:use-module (srfi srfi-26) + #:use-module (ice-9 regex) + #:use-module (ice-9 match) + #:export (service-type->recutils + find-service-types + guix-system-search)) + +;;; Commentary: +;;; +;;; Implement the 'guix system search' command, which searches among the +;;; available service types. +;;; +;;; Code: + +(define service-type-name* + (compose symbol->string service-type-name)) + +(define* (service-type->recutils type port + #:optional (width (%text-width)) + #:key (extra-fields '())) + "Write to PORT a recutils record of TYPE, arranging to fit within WIDTH +columns." + (define width* + ;; The available number of columns once we've taken into account space for + ;; the initial "+ " prefix. + (if (> width 2) (- width 2) width)) + + (define (extensions->recutils extensions) + (let ((list (string-join (map (compose service-type-name* + service-extension-target) + extensions)))) + (string->recutils + (fill-paragraph list width* + (string-length "extends: "))))) + + ;; Note: Don't i18n field names so that people can post-process it. + (format port "name: ~a~%" (service-type-name type)) + (format port "location: ~a~%" + (or (and=> (service-type-location type) location->string) + (G_ "unknown"))) + + (format port "extends: ~a~%" + (extensions->recutils (service-type-extensions type))) + + (when (service-type-description type) + (format port "~a~%" + (string->recutils + (string-trim-right + (parameterize ((%text-width width*)) + (texi->plain-text + (string-append "description: " + (or (and=> (service-type-description type) P_) + "")))) + #\newline)))) + + (for-each (match-lambda + ((field . value) + (let ((field (symbol->string field))) + (format port "~a: ~a~%" + field + (fill-paragraph (object->string value) width* + (string-length field)))))) + extra-fields) + (newline port)) + +(define (service-type-description-string type) + "Return the rendered and localised description of TYPE, a service type." + (and=> (service-type-description type) + (compose texi->plain-text P_))) + +(define %service-type-metrics + ;; Metrics used to estimate the relevance of a search result. + `((,service-type-name* . 3) + (,service-type-description-string . 2) + (,(lambda (type) + (match (and=> (service-type-location type) location-file) + ((? string? file) + (basename file ".scm")) + (#f + ""))) + . 1))) + +(define (find-service-types regexps) + "Return two values: the list of service types whose name or description +matches at least one of REGEXPS sorted by relevance, and the list of relevance +scores." + (let ((matches (fold-service-types + (lambda (type result) + (match (relevance type regexps + %service-type-metrics) + ((? zero?) + result) + (score + (cons (list type score) result)))) + '()))) + (unzip2 (sort matches + (lambda (m1 m2) + (match m1 + ((type1 score1) + (match m2 + ((type2 score2) + (if (= score1 score2) + (string>? (service-type-name* type1) + (service-type-name* type2)) + (> score1 score2))))))))))) + + +(define (guix-system-search . args) + (with-error-handling + (let ((regexps (map (cut make-regexp* <> regexp/icase) args))) + (leave-on-EPIPE + (let-values (((services scores) + (find-service-types regexps))) + (for-each (lambda (service score) + (service-type->recutils service + (current-output-port) + #:extra-fields + `((relevance . ,score)))) + services + scores)))))) diff --git a/guix/ui.scm b/guix/ui.scm index a51877c04d..6dfc8c7a5b 100644 --- a/guix/ui.scm +++ b/guix/ui.scm @@ -79,6 +79,7 @@ read/eval-package-expression location->string fill-paragraph + %text-width texi->plain-text package-description-string package-synopsis-string diff --git a/po/guix/POTFILES.in b/po/guix/POTFILES.in index b8e0aca877..e3f767cc67 100644 --- a/po/guix/POTFILES.in +++ b/po/guix/POTFILES.in @@ -19,6 +19,7 @@ guix/scripts/pull.scm guix/scripts/substitute.scm guix/scripts/authenticate.scm guix/scripts/system.scm +guix/scripts/system/search.scm guix/scripts/lint.scm guix/scripts/publish.scm guix/scripts/edit.scm diff --git a/tests/guix-system.sh b/tests/guix-system.sh index de6db0928c..d575795ea0 100644 --- a/tests/guix-system.sh +++ b/tests/guix-system.sh @@ -1,5 +1,5 @@ # GNU Guix --- Functional package management for GNU -# Copyright © 2014, 2015, 2016 Ludovic Courtès +# Copyright © 2014, 2015, 2016, 2017 Ludovic Courtès # # This file is part of GNU Guix. # @@ -215,3 +215,7 @@ EOF # In both cases 'my-torrc' should be properly resolved. guix system build "$tmpdir/config.scm" -n (cd "$tmpdir"; guix system build "config.scm" -n) + +# Searching. +guix system search tor | grep "^name: tor" +guix system search anonym network | grep "^name: tor" -- cgit v1.2.3 From 07c101e2215c43616c2bb28b1cb0743ecfdc7c87 Mon Sep 17 00:00:00 2001 From: Peter Mikkelsen Date: Wed, 13 Sep 2017 14:37:39 +0200 Subject: build-system: Add 'meson-build-system'. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * Makefile.am (MODULES): Add 'guix/build-system/meson.scm' and 'guix/build/meson-build-system.scm'. * guix/build-system/meson.scm: New file. * guix/build/meson-build-system.scm: New file. * doc/guix.texi (Build Systems): Add 'meson-build-system'. Signed-off-by: Ludovic Courtès --- Makefile.am | 2 + doc/guix.texi | 55 ++++++++++++ guix/build-system/meson.scm | 178 ++++++++++++++++++++++++++++++++++++++ guix/build/meson-build-system.scm | 150 ++++++++++++++++++++++++++++++++ 4 files changed, 385 insertions(+) create mode 100644 guix/build-system/meson.scm create mode 100644 guix/build/meson-build-system.scm (limited to 'doc') diff --git a/Makefile.am b/Makefile.am index a2fb313916..e35bdac306 100644 --- a/Makefile.am +++ b/Makefile.am @@ -79,6 +79,7 @@ MODULES = \ guix/build-system/dub.scm \ guix/build-system/emacs.scm \ guix/build-system/font.scm \ + guix/build-system/meson.scm \ guix/build-system/minify.scm \ guix/build-system/asdf.scm \ guix/build-system/glib-or-gtk.scm \ @@ -106,6 +107,7 @@ MODULES = \ guix/build/cmake-build-system.scm \ guix/build/dub-build-system.scm \ guix/build/emacs-build-system.scm \ + guix/build/meson-build-system.scm \ guix/build/minify-build-system.scm \ guix/build/font-build-system.scm \ guix/build/asdf-build-system.scm \ diff --git a/doc/guix.texi b/doc/guix.texi index ebeef50709..1356a357cc 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -3811,6 +3811,61 @@ need to be copied into place. It copies font files to standard locations in the output directory. @end defvr +@defvr {Scheme Variable} meson-build-system +This variable is exported by @code{(guix build-system meson)}. It +implements the build procedure for packages that use +@url{http://mesonbuild.com, Meson} as their build system. + +It adds both Meson and @uref{https://ninja-build.org/, Ninja} to the set +of inputs, and they can be changed with the parameters @code{#:meson} +and @code{#:ninja} if needed. The default Meson is +@code{meson-for-build}, which is special because it doesn't clear the +@code{RUNPATH} of binaries and libraries when they are installed. + +This build system is an extension of @var{gnu-build-system}, but with the +following phases changed to some specific for Meson: + +@table @code + +@item configure +The phase runs @code{meson} with the flags specified in +@code{#:configure-flags}. The flag @code{--build-type} is always set to +@code{plain} unless something else is specified in @code{#:build-type}. + +@item build +The phase runs @code{ninja} to build the package in parallel by default, but +this can be changed with @code{#:parallel-build?}. + +@item check +The phase runs @code{ninja} with the target specified in @code{#:test-target}, +which is @code{"test"} by default. + +@item install +The phase runs @code{ninja install} and can not be changed. +@end table + +Apart from that, the build system also adds the following phases: + +@table @code + +@item fix-runpath +This phase tries to locate the local directories in the package being build, +which has libraries that some of the binaries need. If any are found, they will +be added to the programs @code{RUNPATH}. It is needed because +@code{meson-for-build} keeps the @code{RUNPATH} of binaries and libraries from +when they are build, but often that is not the @code{RUNPATH} we want. +Therefor it is also shrinked to the minimum needed by the program. + +@item glib-or-gtk-wrap +This phase is the phase provided by @code{glib-or-gtk-build-system}, and it +is not enabled by default. It can be enabled with @code{#:glib-or-gtk?}. + +@item glib-or-gtk-compile-schemas +This phase is the phase provided by @code{glib-or-gtk-build-system}, and it +is not enabled by default. It can be enabled with @code{#:glib-or-gtk?}. +@end table +@end defvr + Lastly, for packages that do not need anything as sophisticated, a ``trivial'' build system is provided. It is trivial in the sense that it provides basically no support: it does not pull any implicit inputs, diff --git a/guix/build-system/meson.scm b/guix/build-system/meson.scm new file mode 100644 index 0000000000..d66ec760a4 --- /dev/null +++ b/guix/build-system/meson.scm @@ -0,0 +1,178 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2017 Peter Mikkelsen +;;; +;;; 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 meson) + #: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 build-system glib-or-gtk) + #:use-module (guix packages) + #:use-module (ice-9 match) + #:export (%meson-build-system-modules + meson-build-system)) + +;; Commentary: +;; +;; Standard build procedure for packages using Meson. This is implemented as an +;; extension of `gnu-build-system', with the option to turn on the glib/gtk +;; phases from `glib-or-gtk-build-system'. +;; +;; Code: + +(define %meson-build-system-modules + ;; Build-side modules imported by default. + `((guix build meson-build-system) + (guix build rpath) + ;; The modules from glib-or-gtk contains the modules from gnu-build-system, + ;; so there is no need to import that too. + ,@%glib-or-gtk-build-system-modules)) + +(define (default-ninja) + "Return the default ninja package." + ;; Lazily resolve the binding to avoid a circular dependency. + (let ((module (resolve-interface '(gnu packages ninja)))) + (module-ref module 'ninja))) + +(define (default-meson) + "Return the default meson package." + ;; Lazily resolve the binding to avoid a circular dependency. + (let ((module (resolve-interface '(gnu packages build-tools)))) + (module-ref module 'meson-for-build))) + +(define (default-patchelf) + "Return the default patchelf package." + ;; Lazily resolve the binding to avoid a circular dependency. + (let ((module (resolve-interface '(gnu packages elf)))) + (module-ref module 'patchelf))) + +(define* (lower name + #:key source inputs native-inputs outputs system target + (meson (default-meson)) + (ninja (default-ninja)) + (glib-or-gtk #f) + #:allow-other-keys + #:rest arguments) + "Return a bag for NAME." + (define private-keywords + `(#:source #:meson #:ninja #:inputs #:native-inputs #:outputs #:target)) + + (and (not target) ;; TODO: add support for cross-compilation. + (bag + (name name) + (system system) + (build-inputs `(("meson" ,meson) + ("ninja" ,ninja) + ;; Add patchelf for (guix build rpath) to work. + ("patchelf" ,(default-patchelf)) + ,@native-inputs)) + (host-inputs `(,@(if source + `(("source" ,source)) + '()) + ,@inputs + ;; Keep the standard inputs of 'gnu-build-system'. + ,@(standard-packages))) + (outputs outputs) + (build meson-build) + (arguments (strip-keyword-arguments private-keywords arguments))))) + +(define* (meson-build store name inputs + #:key (guile #f) + (outputs '("out")) + (configure-flags ''()) + (search-paths '()) + (build-type "plain") + (tests? #t) + (test-target "test") + (glib-or-gtk? #f) + (parallel-build? #t) + (parallel-tests? #f) + (validate-runpath? #t) + (patch-shebangs? #t) + (strip-binaries? #t) + (strip-flags ''("--strip-debug")) + (strip-directories ''("lib" "lib64" "libexec" + "bin" "sbin")) + (elf-directories ''("lib" "lib64" "libexec" + "bin" "sbin")) + (phases '(@ (guix build meson-build-system) + %standard-phases)) + (system (%current-system)) + (imported-modules %meson-build-system-modules) + (modules '((guix build meson-build-system) + (guix build utils)))) + "Build SOURCE using MESON, and with INPUTS, assuming that SOURCE +has a 'meson.build' file." + (define builder + `(let ((build-phases (if ,glib-or-gtk? + ,phases + (modify-phases ,phases + (delete 'glib-or-gtk-compile-schemas) + (delete 'glib-or-gtk-wrap))))) + (use-modules ,@modules) + (meson-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 build-phases + #:configure-flags ,configure-flags + #:build-type ,build-type + #:tests? ,tests? + #:test-target ,test-target + #:parallel-build? ,parallel-build? + #:parallel-tests? ,parallel-tests? + #:validate-runpath? ,validate-runpath? + #:patch-shebangs? ,patch-shebangs? + #:strip-binaries? ,strip-binaries? + #:strip-flags ,strip-flags + #:strip-directories ,strip-directories + #:elf-directories ,elf-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 meson-build-system + (build-system + (name 'meson) + (description "The standard Meson build system") + (lower lower))) + +;;; meson.scm ends here diff --git a/guix/build/meson-build-system.scm b/guix/build/meson-build-system.scm new file mode 100644 index 0000000000..2b92240c52 --- /dev/null +++ b/guix/build/meson-build-system.scm @@ -0,0 +1,150 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2017 Peter Mikkelsen +;;; +;;; 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 meson-build-system) + #:use-module ((guix build gnu-build-system) #:prefix gnu:) + #:use-module ((guix build glib-or-gtk-build-system) #:prefix glib-or-gtk:) + #:use-module (guix build utils) + #:use-module (guix build rpath) + #:use-module (guix build gremlin) + #:use-module (guix elf) + #:use-module (ice-9 match) + #:use-module (rnrs io ports) + #:use-module (srfi srfi-1) + #:export (%standard-phases + meson-build)) + +;; Commentary: +;; +;; Builder-side code of the standard meson build procedure. +;; +;; Code: + +(define* (configure #:key outputs configure-flags build-type + #:allow-other-keys) + "Configure the given package." + (let* ((out (assoc-ref outputs "out")) + (source-dir (getcwd)) + (build-dir "../build") + (prefix (assoc-ref outputs "out")) + (args `(,(string-append "--prefix=" prefix) + ,(string-append "--buildtype=" build-type) + ,@configure-flags + ,source-dir))) + (mkdir build-dir) + (chdir build-dir) + (zero? (apply system* "meson" args)))) + +(define* (build #:key parallel-build? + #:allow-other-keys) + "Build a given meson package." + (zero? (apply system* "ninja" + (if parallel-build? + `("-j" ,(number->string (parallel-job-count))) + '("-j" "1"))))) + +(define* (check #:key test-target parallel-tests? tests? + #:allow-other-keys) + (setenv "MESON_TESTTHREADS" + (if parallel-tests? + (number->string (parallel-job-count)) + "1")) + (if tests? + (zero? (system* "ninja" test-target)) + (begin + (format #t "test suite not run~%") + #t))) + +(define* (install #:rest args) + (zero? (system* "ninja" "install"))) + +(define* (fix-runpath #:key (elf-directories '("lib" "lib64" "libexec" + "bin" "sbin")) + outputs #:allow-other-keys) + "Try to make sure all ELF files in ELF-DIRECTORIES are able to find their +local dependencies in their RUNPATH, by searching for the needed libraries in +the directories of the package, and adding them to the RUNPATH if needed. +Also shrink the RUNPATH to what is needed, +since a lot of directories are left over from the build phase of meson, +for example libraries only needed for the tests." + + ;; Find the directories (if any) that contains DEP-NAME. The directories + ;; searched are the ones that ELF-FILES are in. + (define (find-deps dep-name elf-files) + (map dirname (filter (lambda (file) + (string=? dep-name (basename file))) + elf-files))) + + ;; Return a list of libraries that FILE needs. + (define (file-needed file) + (let* ((elf (call-with-input-file file + (compose parse-elf get-bytevector-all))) + (dyninfo (elf-dynamic-info elf))) + (if dyninfo + (elf-dynamic-info-needed dyninfo) + '()))) + + + ;; If FILE needs any libs that are part of ELF-FILES, the RUNPATH + ;; is modified accordingly. + (define (handle-file file elf-files) + (let* ((dep-dirs (concatenate (map (lambda (dep-name) + (find-deps dep-name elf-files)) + (file-needed file))))) + (unless (null? dep-dirs) + (augment-rpath file (string-join dep-dirs ":"))))) + + (define handle-output + (match-lambda + ((output . directory) + (let* ((elf-dirnames (map (lambda (subdir) + (string-append directory "/" subdir)) + elf-directories)) + (existing-elf-dirs (filter (lambda (dir) + (and (file-exists? dir) + (file-is-directory? dir))) + elf-dirnames)) + (elf-pred (lambda (name stat) + (elf-file? name))) + (elf-list (concatenate (map (lambda (dir) + (find-files dir elf-pred)) + existing-elf-dirs)))) + (for-each (lambda (elf-file) + (system* "patchelf" "--shrink-rpath" elf-file) + (handle-file elf-file elf-list)) + elf-list))))) + (for-each handle-output outputs) + #t) + +(define %standard-phases + ;; The standard-phases of glib-or-gtk contains a superset of the phases + ;; from the gnu-build-system. If the glib-or-gtk? key is #f (the default) + ;; then the extra phases will be removed again in (guix build-system meson). + (modify-phases glib-or-gtk:%standard-phases + (replace 'configure configure) + (replace 'build build) + (replace 'check check) + (replace 'install install) + (add-after 'strip 'fix-runpath fix-runpath))) + +(define* (meson-build #:key inputs 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)) + +;;; meson-build-system.scm ends here -- cgit v1.2.3 From 5a183a1e2b970c6820b4b151abc4e848e8e05deb Mon Sep 17 00:00:00 2001 From: Jan Nieuwenhuizen Date: Mon, 18 Sep 2017 11:12:43 +0200 Subject: doc: Add "Sending a Patch Series" subsection. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Searching for `git send-email' took you to the end of `Submitting Patches' section which said You may use your email client or the ‘git send-email’ command. without further warning or remark. * doc/contributing.texi (Sending a Patch Series): Move information about debbugs bug 15361 to subsection. Add git-send-email index entries. (Submitting Patches): Reference it. --- doc/contributing.texi | 29 ++++++++++++++++++++--------- 1 file changed, 20 insertions(+), 9 deletions(-) (limited to 'doc') diff --git a/doc/contributing.texi b/doc/contributing.texi index 00edd47710..323b01628d 100644 --- a/doc/contributing.texi +++ b/doc/contributing.texi @@ -298,11 +298,7 @@ This mailing list is backed by a Debbugs instance accessible at of submissions. Each message sent to that mailing list gets a new tracking number assigned; people can then follow up on the submission by sending email to @code{@var{NNN}@@debbugs.gnu.org}, where @var{NNN} is -the tracking number. When sending a patch series, please first send one -message to @email{guix-patches@@gnu.org}, and then send subsequent -patches to @email{@var{NNN}@@debbugs.gnu.org} to make sure they are kept -together. See @uref{https://debbugs.gnu.org/Advanced.html, the Debbugs -documentation}, for more information. +the tracking number (@pxref{Sending a Patch Series}). Please write commit logs in the ChangeLog format (@pxref{Change Logs,,, standards, GNU Coding Standards}); you can check the commit history for @@ -434,7 +430,22 @@ Please follow our code formatting rules, possibly running the When posting a patch to the mailing list, use @samp{[PATCH] @dots{}} as a subject. You may use your email client or the @command{git -send-email} command. We prefer to get patches in plain text messages, -either inline or as MIME attachments. You are advised to pay attention if -your email client changes anything like line breaks or indentation which -could potentially break the patches. +send-email} command (@pxref{Sending a Patch Series}). We prefer to get +patches in plain text messages, either inline or as MIME attachments. +You are advised to pay attention if your email client changes anything +like line breaks or indentation which could potentially break the +patches. + +@unnumberedsubsec Sending a Patch Series +@anchor{Sending a Patch Series} +@cindex patch series +@cindex @code{git send-email} +@cindex @code{git-send-email} + +When sending a patch series (e.g., using @code{git send-email}), please +first send one message to @email{guix-patches@@gnu.org}, and then send +subsequent patches to @email{@var{NNN}@@debbugs.gnu.org} to make sure +they are kept together. See +@uref{https://debbugs.gnu.org/Advanced.html, the Debbugs documentation} +for more information. +@c Debbugs bug: https://debbugs.gnu.org/db/15/15361.html -- cgit v1.2.3 From 4619b59cb49c5356eaea4650dee3d4de929e082a Mon Sep 17 00:00:00 2001 From: Jan Nieuwenhuizen Date: Mon, 18 Sep 2017 17:25:58 +0200 Subject: doc: Add a note about closing bug threads. * doc/contributing.texi (Submitting Patches): Add a note about closing bug threads by mailing to NNN-done@debbugs.gnu.org. Suggested-by: Nicolas Goaziou --- doc/contributing.texi | 3 +++ 1 file changed, 3 insertions(+) (limited to 'doc') diff --git a/doc/contributing.texi b/doc/contributing.texi index 323b01628d..1b1875fa0c 100644 --- a/doc/contributing.texi +++ b/doc/contributing.texi @@ -436,6 +436,9 @@ You are advised to pay attention if your email client changes anything like line breaks or indentation which could potentially break the patches. +When a bug is resolved, please close the thread by sending an email to +@email{@var{NNN}-done@@debbugs.gnu.org}. + @unnumberedsubsec Sending a Patch Series @anchor{Sending a Patch Series} @cindex patch series -- cgit v1.2.3 From 6ab63268e4a100340995fc16cb4afc34c0edae09 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Tue, 19 Sep 2017 13:46:34 +0200 Subject: doc: Mention 'mkfs.fat' for the ESP. Suggested by Hartmut Goebel . * doc/guix.texi (Preparing for Installation): Mention 'mkfs.fat'. --- doc/guix.texi | 7 ++++++- 1 file changed, 6 insertions(+), 1 deletion(-) (limited to 'doc') diff --git a/doc/guix.texi b/doc/guix.texi index 1356a357cc..601cf51b37 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -7930,7 +7930,12 @@ Once you are done partitioning the target hard disk drive, you have to create a file system on the relevant partition(s)@footnote{Currently GuixSD only supports ext4 and btrfs file systems. In particular, code that reads partition UUIDs and labels only works for these file system -types.}. +types.}. For the ESP, if you have one and assuming it is +@file{/dev/sda2}, run: + +@example +mkfs.fat -F32 /dev/sda2 +@end example Preferably, assign partitions a label so that you can easily and reliably refer to them in @code{file-system} declarations (@pxref{File -- cgit v1.2.3