diff options
| -rw-r--r-- | Makefile.am | 1 | ||||
| -rw-r--r-- | doc/guix.texi | 75 | ||||
| -rw-r--r-- | guix/scripts/weather.scm | 234 |
3 files changed, 309 insertions, 1 deletions
diff --git a/Makefile.am b/Makefile.am index 4d1512f8ce..5888bc0266 100644 --- a/Makefile.am +++ b/Makefile.am @@ -171,6 +171,7 @@ MODULES = \ guix/scripts/import/texlive.scm \ guix/scripts/environment.scm \ guix/scripts/publish.scm \ + guix/scripts/weather.scm \ guix/scripts/edit.scm \ guix/scripts/size.scm \ guix/scripts/graph.scm \ diff --git a/doc/guix.texi b/doc/guix.texi index dfa1e22fcc..932b118f7d 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -158,6 +158,7 @@ Utilities * Invoking guix challenge:: Challenging substitute servers. * Invoking guix copy:: Copying to and from a remote store. * Invoking guix container:: Process isolation. +* Invoking guix weather:: Assessing substitute availability. Invoking @command{guix build} @@ -2201,6 +2202,9 @@ authenticates substitute information itself, as explained above, which is what we care about (whereas X.509 certificates are about authenticating bindings between domain names and public keys.) +You can get statistics on the substitutes provided by a server using the +@command{guix weather} command (@pxref{Invoking guix weather}). + The substitute mechanism can be disabled globally by running @code{guix-daemon} with @code{--no-substitutes} (@pxref{Invoking guix-daemon}). It can also be disabled temporarily by passing the @@ -4933,6 +4937,7 @@ the Scheme programming interface of Guix in a convenient way. * Invoking guix challenge:: Challenging substitute servers. * Invoking guix copy:: Copying to and from a remote store. * Invoking guix container:: Process isolation. +* Invoking guix weather:: Assessing substitute availability. @end menu @node Invoking guix build @@ -6869,7 +6874,8 @@ serves them. This ``on-the-fly'' mode is convenient in that it requires no setup and is immediately available. However, when serving lots of clients, we recommend using the @option{--cache} option, which enables caching of the archives before they are sent to clients---see below for -details. +details. The @command{guix weather} command provides a handy way to +check what a server provides (@pxref{Invoking guix weather}). As a bonus, @command{guix publish} also serves as a content-addressed mirror for source files referenced in @code{origin} records @@ -7269,6 +7275,73 @@ must be PID 1 of the container or one of its child processes. @end table +@node Invoking guix weather +@section Invoking @command{guix weather} + +Occasionally you're grumpy because substitutes are lacking and you end +up building packages by yourself (@pxref{Substitutes}). The +@command{guix weather} command reports on substitute availability on the +specified servers so you can have an idea of whether you'll be grumpy +today. It can sometimes be useful info as a user, but it is primarily +useful to people running @command{guix publish} (@pxref{Invoking guix +publish}). + +@cindex statistics, for substitutes +@cindex availability of substitutes +@cindex substitute availability +@cindex weather, substitute availability +Here's a sample run: + +@example +$ guix weather --substitute-urls=https://guix.example.org +computing 5,872 package derivations for x86_64-linux... +looking for 6,128 store items on https://guix.example.org.. +updating list of substitutes from 'https://guix.example.org'... 100.0% +https://guix.example.org + 43.4% substitutes available (2,658 out of 6,128) + 7,032.5 MiB of nars (compressed) + 19,824.2 MiB on disk (uncompressed) + 0.030 seconds per request (182.9 seconds in total) + 33.5 requests per second +@end example + +As you can see, it reports the fraction of all the packages for which +substitutes are available on the server---regardless of whether +substitutes are enabled, and regardless of whether this server's signing +key is authorized. It also reports the size of the compressed archives +(``nars'') provided by the server, the size the corresponding store +items occupy in the store (assuming deduplication is turned off), and +the server's throughput. + +To achieve that, @command{guix weather} queries over HTTP(S) meta-data +(@dfn{narinfos}) for all the relevant store items. Like @command{guix +challenge}, it ignores signatures on those substitutes, which is +innocuous since the command only gathers statistics and cannot install +those substitutes. + +Among other things, it is possible to query specific system types and +specific package sets. The available options are listed below. + +@table @code +@item --substitute-urls=@var{urls} +@var{urls} is the space-separated list of substitute server URLs to +query. When this option is omitted, the default set of substitute +servers is queried. + +@item --system=@var{system} +@itemx -s @var{system} +Query substitutes for @var{system}---e.g., @code{aarch64-linux}. This +option can be repeated, in which case @command{guix weather} will query +substitutes for several system types. + +@item --manifest=@var{file} +Instead of querying substitutes for all the packages, only ask for those +specified in @var{file}. @var{file} must contain a @dfn{manifest}, as +with the @code{-m} option of @command{guix package} (@pxref{Invoking +guix package}). +@end table + + @c ********************************************************************* @node GNU Distribution @chapter GNU Distribution diff --git a/guix/scripts/weather.scm b/guix/scripts/weather.scm new file mode 100644 index 0000000000..9cbeedd288 --- /dev/null +++ b/guix/scripts/weather.scm @@ -0,0 +1,234 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2017 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2017 Ricardo Wurmus <rekado@elephly.net> +;;; +;;; 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 weather) + #:use-module (guix ui) + #:use-module (guix scripts) + #:use-module (guix packages) + #:use-module (guix profiles) + #:use-module (guix derivations) + #:use-module (guix monads) + #:use-module (guix store) + #:use-module (guix grafts) + #:use-module (guix build syscalls) + #:use-module (guix scripts substitute) + #:use-module (gnu packages) + #:use-module (web uri) + #:use-module (srfi srfi-1) + #:use-module (srfi srfi-19) + #:use-module (srfi srfi-26) + #:use-module (srfi srfi-37) + #:use-module (ice-9 match) + #:use-module (ice-9 format) + #:export (guix-weather)) + +(define (all-packages) + "Return the list of public packages we are going to query." + (fold-packages (lambda (package result) + (match (package-replacement package) + ((? package? replacement) + (cons* replacement package result)) + (#f + (cons package result)))) + '())) + +(define* (package-outputs packages + #:optional (system (%current-system))) + "Return the list of outputs of all of PACKAGES for the given SYSTEM." + (let ((packages (filter (cut supported-package? <> system) packages))) + + (define update-progress! + (let ((total (length packages)) + (done 0) + (width (max 10 (- (terminal-columns) 10)))) + (lambda () + (set! done (+ 1 done)) + (let* ((ratio (/ done total 1.)) + (done (inexact->exact (round (* width ratio)))) + (left (- width done))) + (format (current-error-port) "~5,1f% [~a~a]\r" + (* ratio 100.) + (make-string done #\#) + (make-string left #\space)) + (when (>= done total) + (newline (current-error-port))) + (force-output (current-error-port)))))) + + (format (current-error-port) + (G_ "computing ~h package derivations for ~a...~%") + (length packages) system) + + (foldm %store-monad + (lambda (package result) + (mlet %store-monad ((drv (package->derivation package system + #:graft? #f))) + (update-progress!) + (match (derivation->output-paths drv) + (((names . items) ...) + (return (append items result)))))) + '() + packages))) + +(cond-expand + (guile-2.2 + ;; Guile 2.2.2 has a bug whereby 'time-monotonic' objects have seconds and + ;; nanoseconds swapped (fixed in Guile commit 886ac3e). Work around it. + (define time-monotonic time-tai)) + (else #t)) + +(define (call-with-time thunk kont) + "Call THUNK and pass KONT the elapsed time followed by THUNK's return +values." + (let* ((start (current-time time-monotonic)) + (result (call-with-values thunk list)) + (end (current-time time-monotonic))) + (apply kont (time-difference end start) result))) + +(define-syntax-rule (let/time ((time result exp)) body ...) + (call-with-time (lambda () exp) (lambda (time result) body ...))) + +(define (report-server-coverage server items) + "Report the subset of ITEMS available as substitutes on SERVER." + (define MiB (* (expt 2 20) 1.)) + + (format #t (G_ "looking for ~h store items on ~a...~%") + (length items) server) + + (let/time ((time narinfos (lookup-narinfos server items))) + (format #t "~a~%" server) + (let ((obtained (length narinfos)) + (requested (length items)) + (sizes (filter-map narinfo-file-size narinfos)) + (time (+ (time-second time) + (/ (time-nanosecond time) 1e9)))) + (format #t (G_ " ~2,1f% substitutes available (~h out of ~h)~%") + (* 100. (/ obtained requested 1.)) + obtained requested) + (let ((total (/ (reduce + 0 sizes) MiB))) + (match (length sizes) + ((? zero?) + (format #t (G_ " unknown substitute sizes~%"))) + (len + (if (= len obtained) + (format #t (G_ " ~,1h MiB of nars (compressed)~%") total) + (format #t (G_ " at least ~,1h MiB of nars (compressed)~%") + total))))) + (format #t (G_ " ~,1h MiB on disk (uncompressed)~%") + (/ (reduce + 0 (map narinfo-size narinfos)) MiB)) + (format #t (G_ " ~,3h seconds per request (~,1h seconds in total)~%") + (/ time requested 1.) time) + (format #t (G_ " ~,1h requests per second~%") + (/ requested time 1.))))) + + +;;; +;;; Command-line options. +;;; + +(define (show-help) + (display (G_ "Usage: guix weather [OPTIONS] +Report the availability of substitutes.\n")) + (display (G_ " + --substitute-urls=URLS + check for available substitutes at URLS")) + (display (G_ " + --manifest=MANIFEST + look up substitutes for packages specified in MANIFEST")) + (display (G_ " + -s, --system=SYSTEM consider substitutes for SYSTEM--e.g., \"i686-linux\"")) + (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 %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 challenge"))) + + (option '("substitute-urls") #t #f + (lambda (opt name arg result . rest) + (let ((urls (string-tokenize arg))) + (for-each (lambda (url) + (unless (string->uri url) + (leave (G_ "~a: invalid URL~%") url))) + urls) + (apply values + (alist-cons 'substitute-urls urls + (alist-delete 'substitute-urls result)) + rest)))) + (option '(#\m "manifest") #t #f + (lambda (opt name arg result) + (alist-cons 'manifest arg result))) + (option '(#\s "system") #t #f + (lambda (opt name arg result) + (alist-cons 'system arg result))))) + +(define %default-options + `((substitute-urls . ,%default-substitute-urls))) + +(define (load-manifest file) + "Load the manifest from FILE and return the list of packages it refers to." + (let* ((user-module (make-user-module '((guix profiles) (gnu)))) + (manifest (load* file user-module))) + (map manifest-entry-item + (manifest-transitive-entries manifest)))) + + +;;; +;;; Entry point. +;;; + +(define (guix-weather . args) + (with-error-handling + (let* ((opts (parse-command-line args %options + (list %default-options))) + (urls (assoc-ref opts 'substitute-urls)) + (systems (match (filter-map (match-lambda + (('system . system) system) + (_ #f)) + opts) + (() (list (%current-system))) + (systems systems))) + (packages (let ((file (assoc-ref opts 'manifest))) + (if file + (load-manifest file) + (all-packages)))) + (items (with-store store + (parameterize ((%graft? #f)) + (concatenate + (run-with-store store + (mapm %store-monad + (lambda (system) + (package-outputs packages system)) + systems))))))) + (for-each (lambda (server) + (report-server-coverage server items)) + urls)))) + +;;; Local Variables: +;;; eval: (put 'let/time 'scheme-indent-function 1) +;;; End: |