guix/guix
3
4
Fork 0
mirror of git://git.savannah.gnu.org/guix.git synced 2023-12-14 03:33:07 +01:00
Code Issues Releases Wiki Activity

Use substitute servers on the local network.

Browse source 
* guix/scripts/discover.scm: New file.
* Makefile.am (MODULES): Add it.
* nix/nix-daemon/guix-daemon.cc (options): Add "discover" option,
(parse-opt): parse it,
(main): start "guix discover" process when the option is set.
* guix/scripts/substitute.scm (%local-substitute-urls): New variable,
(substitute-urls): add it.
* gnu/services/base.scm (<guix-configuration>): Add "discover?"
field,
(guix-shepherd-service): honor it.
* doc/guix.texi (Invoking guix-daemon): Document "discover" option,
(Base Services): ditto.
This commit is contained in:
Mathieu Othacehe 2020-11-24 14:05:21 +01:00
parent 276e494b2a
commit 79f9dee3c4
No known key found for this signature in database
GPG key ID: 8354763531769CA6
6 changed files with 244 additions and 3 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

1
Makefile.am
View file

@ -257,6 +257,7 @@ MODULES = \
guix/import/texlive.scm \
guix/import/utils.scm \
guix/scripts.scm \
guix/scripts/discover.scm \
guix/scripts/download.scm \
guix/scripts/perform-download.scm \
guix/scripts/build.scm \

26
doc/guix.texi
View file

@ -1579,6 +1579,28 @@ Unless @option{--lose-logs} is used, all the build logs are kept in the
@var{localstatedir}. To save space, the daemon automatically compresses
them with Bzip2 by default.
@item --discover[=yes|no]
Whether to discover substitute servers on the local network using mDNS
and DNS-SD.
This feature is still experimental. However, here are a few
considerations.
@enumerate
@item
It might be faster/less expensive than fetching from remote servers;
@item
There are no security risks, only genuine substitutes will be used
(@pxref{Substitute Authentication});
@item
An attacker advertising @command{guix publish} on your LAN cannot serve
you malicious binaries, but they can learn what software you’re
installing;
@item
Servers may serve substitute over HTTP, unencrypted, so anyone on the
LAN can see what software you’re installing.
@end enumerate
@item --disable-deduplication
@cindex deduplication
Disable automatic file ``deduplication'' in the store.
@ -15016,6 +15038,10 @@ disables the timeout.
The type of compression used for build logs---one of @code{gzip},
@code{bzip2}, or @code{none}.
@item @code{discover} (default: @code{#f})
Whether to discover substitute servers on the local network using mDNS
and DNS-SD.
@item @code{extra-options} (default: @code{'()})
List of extra command-line options for @command{guix-daemon}.

9
gnu/services/base.scm
View file

@ -1530,6 +1530,8 @@ archive' public keys, with GUIX."
(default 0))
(log-compression guix-configuration-log-compression
(default 'bzip2))
(discover? guix-configuration-discover?
(default #f))
(extra-options guix-configuration-extra-options ;list of strings
(default '()))
(log-file guix-configuration-log-file ;string
@ -1571,8 +1573,8 @@ proxy of 'guix-daemon'...~%")
(match-record config <guix-configuration>
(guix build-group build-accounts authorize-key? authorized-keys
use-substitutes? substitute-urls max-silent-time timeout
log-compression extra-options log-file http-proxy tmpdir
chroot-directories)
log-compression discover? extra-options log-file
http-proxy tmpdir chroot-directories)
(list (shepherd-service
(documentation "Run the Guix daemon.")
(provision '(guix-daemon))
@ -1606,6 +1608,9 @@ proxy of 'guix-daemon'...~%")
#$@(if use-substitutes?
'()
'("--no-substitutes"))
#$@(if discover?
'("--discover=yes")
'())
"--substitute-urls" #$(string-join substitute-urls)
#$@extra-options

158
guix/scripts/discover.scm Normal file
View file

@ -0,0 +1,158 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2020 Mathieu Othacehe <othacehe@gnu.org>
;;;
;;; 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 <http://www.gnu.org/licenses/>.
(define-module (guix scripts discover)
#:use-module (guix avahi)
#:use-module (guix config)
#:use-module (guix scripts)
#:use-module (guix ui)
#:use-module (guix build syscalls)
#:use-module (guix build utils)
#:use-module (guix scripts publish)
#:use-module (ice-9 rdelim)
#:use-module (srfi srfi-37)
#:export (read-substitute-urls
guix-discover))
(define (show-help)
(format #t (G_ "Usage: guix discover [OPTION]...
Discover Guix related services using Avahi.\n"))
(display (G_ "
-c, --cache=DIRECTORY cache discovery results in DIRECTORY"))
(display (G_ "
-h, --help display this help and exit"))
(display (G_ "
-V, --version display version information and exit"))
(newline)
(show-bug-report-information))
(define %options
(list (option '(#\c "cache") #t #f
(lambda (opt name arg result)
(alist-cons 'cache arg result)))
(option '(#\h "help") #f #f
(lambda _
(show-help)
(exit 0)))
(option '(#\V "version") #f #f
(lambda _
(show-version-and-exit "guix discover")))))
(define %default-options
`((cache . ,%state-directory)))
;;;
;;; Publish servers.
;;;
(define %publish-services
;; Set of discovered publish services.
(make-hash-table))
(define (publish-file cache-directory)
"Return the name of the file storing the discovered publish services inside
CACHE-DIRECTORY."
(let ((directory (string-append cache-directory "/discover")))
(string-append directory "/publish")))
(define %publish-file
(make-parameter (publish-file %state-directory)))
(define* (write-publish-file #:key (file (%publish-file)))
"Dump the content of %PUBLISH-SERVICES hash table into FILE. Use a write
lock on FILE to synchronize with any potential readers."
(with-file-lock file
(call-with-output-file file
(lambda (port)
(hash-for-each
(lambda (name service)
(format port "http://~a:~a~%"
(avahi-service-address service)
(avahi-service-port service)))
%publish-services)))
(chmod file #o644)))
(define (call-with-read-file-lock file thunk)
"Call THUNK with a read lock on FILE."
(let ((port #f))
(dynamic-wind
(lambda ()
(set! port
(let ((port (open-file file "r0")))
(fcntl-flock port 'read-lock)
port)))
thunk
(lambda ()
(when port
(unlock-file port))))))
(define-syntax-rule (with-read-file-lock file exp ...)
"Wait to acquire a read lock on FILE and evaluate EXP in that context."
(call-with-read-file-lock file (lambda () exp ...)))
(define* (read-substitute-urls #:key (file (%publish-file)))
"Read substitute urls list from FILE and return it. Use a read lock on FILE
to synchronize with the writer."
(with-read-file-lock file
(call-with-input-file file
(lambda (port)
(let loop ((url (read-line port))
(urls '()))
(if (eof-object? url)
urls
(loop (read-line port) (cons url urls))))))))
;;;
;;; Entry point.
;;;
(define %services
;; List of services we want to discover.
(list publish-service-type))
(define (service-proc action service)
(let ((name (avahi-service-name service))
(type (avahi-service-type service)))
(when (string=? type publish-service-type)
(case action
((new-service)
(hash-set! %publish-services name service))
((remove-service)
(hash-remove! %publish-services name)))
(write-publish-file))))
(define-command (guix-discover . args)
(category internal)
(synopsis "discover Guix related services using Avahi")
(with-error-handling
(let* ((opts (args-fold* args %options
(lambda (opt name arg result)
(leave (G_ "~A: unrecognized option~%") name))
(lambda (arg result)
(leave (G_ "~A: extraneous argument~%") arg))
%default-options))
(cache (assoc-ref opts 'cache))
(publish-file (publish-file cache)))
(parameterize ((%publish-file publish-file))
(mkdir-p (dirname publish-file))
(avahi-browse-service-thread service-proc
#:types %services)))))

32
guix/scripts/substitute.scm
View file

@ -27,6 +27,7 @@
#:use-module (guix config)
#:use-module (guix records)
#:use-module ((guix serialization) #:select (restore-file))
#:use-module (guix scripts discover)
#:use-module (gcrypt hash)
#:use-module (guix base32)
#:use-module (guix base64)
@ -1078,9 +1079,38 @@ found."
;; daemon.
'("http://ci.guix.gnu.org"))))
;; In order to prevent using large number of discovered local substitute
;; servers, limit the local substitute urls list size.
(define %max-substitute-urls 50)
(define* (randomize-substitute-urls urls
#:key
(max %max-substitute-urls))
"Return a list containing MAX urls from URLS, picked randomly. If URLS list
is shorter than MAX elements, then it is directly returned."
(define (random-item list)
(list-ref list (random (length list))))
(if (<= (length urls) max)
urls
(let loop ((res '())
(urls urls))
(if (eq? (length res) max)
res
(let ((url (random-item urls)))
(loop (cons url res) (delete url urls)))))))
(define %local-substitute-urls
;; If the following option is passed to the daemon, use the substitutes list
;; provided by "guix discover" process.
(if (find-daemon-option "discover")
(randomize-substitute-urls (read-substitute-urls))
'()))
(define substitute-urls
;; List of substitute URLs.
(make-parameter %default-substitute-urls))
(make-parameter (append %local-substitute-urls
%default-substitute-urls)))
(define (client-terminal-columns)
"Return the number of columns in the client's terminal, if it is known, or a

21
nix/nix-daemon/guix-daemon.cc
View file

@ -89,6 +89,7 @@ builds derivations on behalf of its clients.");
#define GUIX_OPT_TIMEOUT 18
#define GUIX_OPT_MAX_SILENT_TIME 19
#define GUIX_OPT_LOG_COMPRESSION 20
#define GUIX_OPT_DISCOVER 21
static const struct argp_option options[] =
{
@ -129,6 +130,8 @@ static const struct argp_option options[] =
n_("disable compression of the build logs") },
{ "log-compression", GUIX_OPT_LOG_COMPRESSION, "TYPE", 0,
n_("use the specified compression type for build logs") },
{ "discover", GUIX_OPT_DISCOVER, "yes/no", OPTION_ARG_OPTIONAL,
n_("use substitute servers discovered on the local network") },
/* '--disable-deduplication' was known as '--disable-store-optimization'
up to Guix 0.7 included, so keep the alias around. */
@ -167,6 +170,8 @@ to live outputs") },
/* List of '--listen' options. */
static std::list<std::string> listen_options;
static bool useDiscover = false;
/* Convert ARG to a Boolean value, or throw an error if it does not denote a
Boolean. */
static bool
@ -261,6 +266,10 @@ parse_opt (int key, char *arg, struct argp_state *state)
case GUIX_OPT_NO_BUILD_HOOK:
settings.useBuildHook = false;
break;
case GUIX_OPT_DISCOVER:
useDiscover = string_to_bool (arg);
settings.set("discover", arg);
break;
case GUIX_OPT_DEBUG:
verbosity = lvlDebug;
break;
@ -506,6 +515,18 @@ using `--build-users-group' is highly recommended\n"));
format ("extra chroot directories: '%1%'") % chroot_dirs);
}
if (useDiscover)
{
Strings args;
args.push_back("guix");
args.push_back("discover");
startProcess([&]() {
execv(settings.guixProgram.c_str(), stringsToCharPtrs(args).data());
});
}
printMsg (lvlDebug,
format ("automatic deduplication set to %1%")
% settings.autoOptimiseStore);