2017-07-21 17:13 GMT+02:00 Ludovic Courtès <[email protected]>: > Hello Guix! > > Lately we’ve had a lot of nar URLs return 404, mostly for server-side > issues (setup issue on hydra.gnu.org that broke ‘guix publish’ cache > management, and a ‘guix publish’ cache eviction policy that’s too > aggressive.) > > The attached tool allows you to query the status a substitute server > (and, as a side effect, triggers a nar regeneration if the server uses > ‘guix publish --cache’). So it goes like this: > > --8<---------------cut here---------------start------------->8--- > $ ./pre-inst-env guix weather --substitute-urls=https://hydra.gnu.org > computing 5,864 package derivations for x86_64-linux... > looking for 6,121 store items on https://hydra.gnu.org... > updating list of substitutes from 'https://hydra.gnu.org'... 100.0% > https://hydra.gnu.org > 81.2% substitutes available (4,970 out of 6,121) > 17,852.6 MiB of nars (compressed) > 46,415.5 MiB on disk (uncompressed) > 0.050 seconds per request (306.0 seconds in total) > 20.0 requests per second > --8<---------------cut here---------------end--------------->8--- > > Here it’s telling us that hydra.gnu.org has 81% of the substitutes for > x86_64 of the current public packages (those shown by “guix package > -A”). > > We can add multiple -s flags, thought that quickly takes ages, > especially on that box. > > Thoughts? > > Ludo’. >
This message has been sitting here for 2 days without receiving any comment. How is that ? This is very interesting but I have a few remarks First: having never being involved with binaries publishing I don't know what you mean with "if the server uses ‘guix publish --cache’" or with "We can add multiple -s flags" Having said that, I think it would be interesting to have the percentage of missing binaries for a specific operation rathher than for the whole server For example, if I want to reconfigure my system or if I want to create a VM image, how many binaries are missing in order to do that ? But even like this, I think it's useful Thanks ! > ;;; GNU Guix --- Functional package management for GNU > ;;; Copyright © 2017 Ludovic Courtès <[email protected]> > ;;; > ;;; 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 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 (srfi srfi-1) > #:use-module (srfi srfi-19) > #: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." > (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_ " > -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) > (apply values > (alist-cons 'substitute-urls > (string-tokenize arg) > (alist-delete 'substitute-urls > result)) > rest))) > (option '(#\s "system") #t #f > (lambda (opt name arg result) > (alist-cons 'system arg result))))) > > (define %default-options > `((substitute-urls . ,%default-substitute-urls))) > > > ;;; > ;;; 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 (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: > >
