From mboxrd@z Thu Jan 1 00:00:00 1970 From: ludo@gnu.org (Ludovic =?utf-8?Q?Court=C3=A8s?=) Subject: =?utf-8?Q?What=E2=80=99s?= the weather like? Date: Fri, 21 Jul 2017 17:13:06 +0200 Message-ID: <87bmodkem5.fsf@gnu.org> Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" Return-path: Received: from eggs.gnu.org ([2001:4830:134:3::10]:49175) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1dYZc8-0003TO-NC for guix-devel@gnu.org; Fri, 21 Jul 2017 11:13:14 -0400 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1dYZc5-000883-EA for guix-devel@gnu.org; Fri, 21 Jul 2017 11:13:12 -0400 Received: from fencepost.gnu.org ([2001:4830:134:3::e]:58159) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1dYZc5-00087z-9k for guix-devel@gnu.org; Fri, 21 Jul 2017 11:13:09 -0400 Received: from [193.50.110.220] (port=42404 helo=ribbon) by fencepost.gnu.org with esmtpsa (TLS1.2:RSA_AES_256_CBC_SHA1:256) (Exim 4.82) (envelope-from ) id 1dYZc4-0005rJ-Lw for guix-devel@gnu.org; Fri, 21 Jul 2017 11:13:09 -0400 List-Id: "Development of GNU Guix and the GNU System distribution." List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guix-devel-bounces+gcggd-guix-devel=m.gmane.org@gnu.org Sender: "Guix-devel" To: guix-devel --=-=-= Content-Type: text/plain; charset=utf-8 Content-Transfer-Encoding: quoted-printable Hello Guix! Lately we=E2=80=99ve had a lot of nar URLs return 404, mostly for server-si= de issues (setup issue on hydra.gnu.org that broke =E2=80=98guix publish=E2=80= =99 cache management, and a =E2=80=98guix publish=E2=80=99 cache eviction policy that= =E2=80=99s 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 =E2=80=98guix publish --cache=E2=80=99). So it goes like this: --8<---------------cut here---------------start------------->8--- $ ./pre-inst-env guix weather --substitute-urls=3Dhttps://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=E2=80=99s telling us that hydra.gnu.org has 81% of the substitutes = for x86_64 of the current public packages (those shown by =E2=80=9Cguix package -A=E2=80=9D). We can add multiple -s flags, thought that quickly takes ages, especially on that box. Thoughts? Ludo=E2=80=99. --=-=-= Content-Type: text/plain; charset=utf-8 Content-Disposition: inline; filename=weather.scm Content-Transfer-Encoding: quoted-printable Content-Description: the weather program ;;; GNU Guix --- Functional package management for GNU ;;; Copyright =C2=A9 2017 Ludovic Court=C3=A8s ;;; ;;; 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 . (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 (>=3D 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 a= nd ;; 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 (=3D 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=3DURLS check for available substitutes at URLS")) (display (G_ " -s, --system=3DSYSTEM consider substitutes for SYSTEM--e.g., \"i686-li= nux\"")) (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: --=-=-=--