ryan77627/guix
1
0
Fork 0
mirror of https://git.in.rschanz.org/ryan77627/guix.git synced 2024-11-07 07:26:13 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

Add 'guix weather'.

Browse source 
* guix/scripts/weather.scm: New file.
* Makefile.am (MODULES): Add it.
* doc/guix.texi (Substitutes, Invoking guix publish): Mention "guix
weather".
(Invoking guix weather): New node.

Co-authored-by: Ricardo Wurmus <rekado@elephly.net>
This commit is contained in:
Ludovic Courtès 2017-07-25 12:14:04 +02:00 committed by Ludovic Courtès
parent 5b4a6ba044
commit 585347d7aa
No known key found for this signature in database
GPG key ID: 090B11993D9AEBB5
3 changed files with 309 additions and 1 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

1
Makefile.am
View file

@ -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 \

75
doc/guix.texi
View file

@ -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

234
guix/scripts/weather.scm Normal file
View file

@ -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: