nixo
/
guix-devel
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

weather: Add '--coverage'. 

* guix/scripts/weather.scm (show-help, %options): Add '--coverage'.
(package-partition-boundary, package->output-mapping)
(substitute-oracle, report-package-coverage-per-system)
(report-package-coverage): New procedures.
(guix-weather): Honor '--coverage'.
* doc/guix.texi (Invoking guix weather): Document it.
This commit is contained in:
Ludovic Courtès 2019-01-25 13:57:38 +01:00
parent af77219e8a
commit bd414e273c
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
2 changed files with 200 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

35
doc/guix.texi
View File

@ -9709,7 +9709,9 @@ 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. The second part gives continuous integration
(CI) statistics, if the server supports it.
(CI) statistics, if the server supports it. In addition, using the
@option{--coverage} option, @command{guix weather} can list ``important''
package substitutes missing on the server (see below).
To achieve that, @command{guix weather} queries over HTTP(S) meta-data
(@dfn{narinfos}) for all the relevant store items. Like @command{guix
@ -9737,6 +9739,37 @@ 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}).
@item --coverage[=@var{count}]
@itemx -c [@var{count}]
Report on substitute coverage for packages: list packages with at least
@var{count} dependents (zero by default) for which substitutes are
unavailable. Dependent packages themselves are not listed: if @var{b} depends
on @var{a} and @var{a} has no substitutes, only @var{a} is listed, even though
@var{b} usually lacks substitutes as well. The result looks like this:
@example
$ guix weather --substitute-urls=https://ci.guix.info -c 10
computing 8,983 package derivations for x86_64-linux...
looking for 9,343 store items on https://ci.guix.info...
updating substitutes from 'https://ci.guix.info'... 100.0%
https://ci.guix.info
64.7% substitutes available (6,047 out of 9,343)
@dots{}
2502 packages are missing from 'https://ci.guix.info' for 'x86_64-linux', among which:
58 kcoreaddons@@5.49.0 /gnu/store/@dots{}-kcoreaddons-5.49.0
46 qgpgme@@1.11.1 /gnu/store/@dots{}-qgpgme-1.11.1
37 perl-http-cookiejar@@0.008 /gnu/store/@dots{}-perl-http-cookiejar-0.008
@dots{}
@end example
What this example shows is that @code{kcoreaddons} and presumably the 58
packages that depend on it have no substitutes at @code{ci.guix.info};
likewise for @code{qgpgme} and the 46 packages that depend on it.
If you are a Guix developer, or if you are taking care of this build farm,
you'll probably want to have a closer look at these packages: they may simply
fail to build.
@end table
@node Invoking guix processes

167
guix/scripts/weather.scm
View File

@ -32,6 +32,9 @@
#:use-module (guix scripts substitute)
#:use-module (guix http-client)
#:use-module (guix ci)
#:use-module (guix sets)
#:use-module (guix graph)
#:autoload (guix scripts graph) (%bag-node-type)
#:use-module (gnu packages)
#:use-module (web uri)
#:use-module (srfi srfi-1)
@ -41,6 +44,7 @@
#:use-module (srfi srfi-37)
#:use-module (ice-9 match)
#:use-module (ice-9 format)
#:use-module (ice-9 vlist)
#:export (guix-weather))
(define (all-packages)
@ -257,6 +261,10 @@ Report the availability of substitutes.\n"))
-m, --manifest=MANIFEST
look up substitutes for packages specified in MANIFEST"))
(display (G_ "
-c, --coverage[=COUNT]
show substitute coverage for packages with at least
COUNT dependents"))
(display (G_ "
-s, --system=SYSTEM consider substitutes for SYSTEM--e.g., \"i686-linux\""))
(newline)
(display (G_ "
@ -289,6 +297,11 @@ Report the availability of substitutes.\n"))
(option '(#\m "manifest") #t #f
(lambda (opt name arg result)
(alist-cons 'manifest arg result)))
(option '(#\c "coverage") #f #t
(lambda (opt name arg result)
(alist-cons 'coverage
(if arg (string->number* arg) 0)
result)))
(option '(#\s "system") #t #f
(lambda (opt name arg result)
(alist-cons 'system arg result)))))
@ -303,6 +316,153 @@ Report the availability of substitutes.\n"))
(map manifest-entry-item
(manifest-transitive-entries manifest))))
;;;
;;; Missing package substitutes.
;;;
(define* (package-partition-boundary pred packages
#:key (system (%current-system)))
"Return the subset of PACKAGES that are at the \"boundary\" between those
that match PRED and those that don't. The returned packages themselves do not
match PRED but they have at least one direct dependency that does.
Note: The assumption is that, if P matches PRED, then all the dependencies of
P match PRED as well."
;; XXX: Graph theoreticians surely have something to teach us about this...
(let loop ((packages packages)
(result (setq))
(visited vlist-null))
(define (visited? package)
(vhash-assq package visited))
(match packages
((package . rest)
(cond ((visited? package)
(loop rest result visited))
((pred package)
(loop rest result (vhash-consq package #t visited)))
(else
(let* ((bag (package->bag package system))
(deps (filter-map (match-lambda
((label (? package? package) . _)
(and (not (pred package))
package))
(_ #f))
(bag-direct-inputs bag))))
(loop (append deps rest)
(if (null? deps)
(set-insert package result)
result)
(vhash-consq package #t visited))))))
(()
(set->list result)))))
(define (package->output-mapping packages system)
"Return a vhash that maps each item of PACKAGES to its corresponding output
store file names for SYSTEM."
(foldm %store-monad
(lambda (package mapping)
(mlet %store-monad ((drv (package->derivation package system
#:graft? #f)))
(return (vhash-consq package
(match (derivation->output-paths drv)
(((names . outputs) ...)
outputs))
mapping))))
vlist-null
packages))
(define (substitute-oracle server items)
"Return a procedure that, when passed a store item (one of those listed in
ITEMS), returns true if SERVER has a substitute for it, false otherwise."
(define available
(fold (lambda (narinfo set)
(set-insert (narinfo-path narinfo) set))
(set)
(lookup-narinfos server items)))
(cut set-contains? available <>))
(define* (report-package-coverage-per-system server packages system
#:key (threshold 0))
"Report on the subset of PACKAGES that lacks SYSTEM substitutes on SERVER,
sorted by decreasing number of dependents. Do not display those with less
than THRESHOLD dependents."
(mlet* %store-monad ((packages -> (package-closure packages #:system system))
(mapping (package->output-mapping packages system))
(back-edges (node-back-edges %bag-node-type packages)))
(define items
(vhash-fold (lambda (package items result)
(append items result))
'()
mapping))
(define substitutable?
(substitute-oracle server items))
(define substitutable-package?
(lambda (package)
(match (vhash-assq package mapping)
((_ . items)
(find substitutable? items))
(#f
#f))))
(define missing
(package-partition-boundary substitutable-package? packages
#:system system))
(define missing-count
(length missing))
(if (zero? threshold)
(format #t (N_ "The following ~a package is missing from '~a' for \
'~a':~%"
"The following ~a packages are missing from '~a' for \
'~a':~%"
missing-count)
missing-count server system)
(format #t (N_ "~a package is missing from '~a' for '~a':~%"
"~a packages are missing from '~a' for '~a', among \
which:~%"
missing-count)
missing-count server system))
(for-each (match-lambda
((package count)
(match (vhash-assq package mapping)
((_ . items)
(when (>= count threshold)
(format #t " ~4d\t~a@~a\t~{~a ~}~%"
count
(package-name package) (package-version package)
items)))
(#f ;PACKAGE must be an internal thing
#f))))
(sort (zip missing
(map (lambda (package)
(node-reachable-count (list package)
back-edges))
missing))
(match-lambda*
(((_ count1) (_ count2))
(< count2 count1)))))
(return #t)))
(define* (report-package-coverage server packages systems
#:key (threshold 0))
"Report on the substitute coverage for PACKAGES, for each of SYSTEMS, on
SERVER. Display information for packages with at least THRESHOLD dependents."
(with-store store
(run-with-store store
(foldm %store-monad
(lambda (system _)
(report-package-coverage-per-system server packages system
#:threshold threshold))
#f
systems))))
;;;
;;; Entry point.
@ -334,7 +494,12 @@ Report the availability of substitutes.\n"))
(package-outputs packages system))
systems)))))))
(for-each (lambda (server)
(report-server-coverage server items))
(report-server-coverage server items)
(match (assoc-ref opts 'coverage)
(#f #f)
(threshold
(report-package-coverage server packages systems
#:threshold threshold))))
urls)))))
;;; Local Variables: