diff options
| -rw-r--r-- | doc/guix.texi | 14 | ||||
| -rw-r--r-- | guix/scripts/weather.scm | 109 |
2 files changed, 120 insertions, 3 deletions
diff --git a/doc/guix.texi b/doc/guix.texi index c37a87d5a1..d112b373c1 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -7912,15 +7912,27 @@ https://guix.example.org 19,824.2 MiB on disk (uncompressed) 0.030 seconds per request (182.9 seconds in total) 33.5 requests per second + + 9.8% (342 out of 3,470) of the missing items are queued + 867 queued builds + x86_64-linux: 518 (59.7%) + i686-linux: 221 (25.5%) + aarch64-linux: 128 (14.8%) + build rate: 23.41 builds per hour + x86_64-linux: 11.16 builds per hour + i686-linux: 6.03 builds per hour + aarch64-linux: 6.41 builds per hour @end example +@cindex continuous integration, statistics 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. +the server's throughput. The second part gives continuous integration +(CI) statistics, if the server supports it. To achieve that, @command{guix weather} queries over HTTP(S) meta-data (@dfn{narinfos}) for all the relevant store items. Like @command{guix diff --git a/guix/scripts/weather.scm b/guix/scripts/weather.scm index 2e782e36ce..5c934abaef 100644 --- a/guix/scripts/weather.scm +++ b/guix/scripts/weather.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2017 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2017, 2018 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2017 Ricardo Wurmus <rekado@elephly.net> ;;; ;;; This file is part of GNU Guix. @@ -29,11 +29,14 @@ #:use-module (guix grafts) #:use-module ((guix build syscalls) #:select (terminal-columns)) #:use-module (guix scripts substitute) + #:use-module (guix http-client) + #:use-module (guix ci) #: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-34) #:use-module (srfi srfi-37) #:use-module (ice-9 match) #:use-module (ice-9 format) @@ -100,6 +103,57 @@ values." (define-syntax-rule (let/time ((time result exp)) body ...) (call-with-time (lambda () exp) (lambda (time result) body ...))) +(define (histogram field proc seed lst) + "Return an alist giving a histogram of all the values of FIELD for elements +of LST. FIELD must be a one element procedure that returns a field's value. +For each FIELD value, call PROC with the previous field-specific result. +Example: + + (histogram car (lambda (x n) (+ 1 n)) 0 '((a . x)(b . y)(a . z))) + => ((a . 2) (b . 1)) + +meaning that we have two a's and one b." + (let loop ((lst lst) + (result '())) + (match lst + (() + result) + ((head . tail) + (let ((value (field head))) + (loop tail + (match (assoc-ref result value) + (#f + `((,value . ,(proc head seed)) ,@result)) + (previous + `((,value . ,(proc head previous)) + ,@(alist-delete value result)))))))))) + +(define (throughput lst timestamp) + "Return the throughput, in items per second, given the elements of LST, +calling TIMESTAMP to get the \"timestamp\" of each item." + (let ((oldest (reduce min +inf.0 (map build-timestamp lst))) + (now (time-second (current-time time-utc)))) + (/ (length lst) (- now oldest) 1.))) + +(define (queued-subset queue items) + "Return the subset of ITEMS, a list of store file names, that appears in +QUEUE, a list of builds. Return #f if elements in QUEUE lack information +about the derivations queued, as is the case with Hydra." + (define queued + (append-map (lambda (build) + (match (false-if-exception + (read-derivation-from-file (build-derivation build))) + (#f + '()) + (drv + (match (derivation->output-paths drv) + (((names . items) ...) items))))) + queue)) + + (if (any (negate build-derivation) queue) + #f ;no derivation information + (lset-intersection string=? queued items))) + (define (report-server-coverage server items) "Report the subset of ITEMS available as substitutes on SERVER." (define MiB (* (expt 2 20) 1.)) @@ -111,6 +165,8 @@ values." (format #t "~a~%" server) (let ((obtained (length narinfos)) (requested (length items)) + (missing (lset-difference string=? + items (map narinfo-path narinfos))) (sizes (filter-map narinfo-file-size narinfos)) (time (+ (time-second time) (/ (time-nanosecond time) 1e9)))) @@ -131,7 +187,56 @@ values." (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.))))) + (/ requested time 1.)) + + (guard (c ((http-get-error? c) + (if (= 404 (http-get-error-code c)) + (format (current-error-port) + (G_ " (continuous integration information \ +unavailable)~%")) + (format (current-error-port) + (G_ " '~a' returned ~a (~s)~%") + (uri->string (http-get-error-uri c)) + (http-get-error-code c) + (http-get-error-reason c))))) + (let* ((max %query-limit) + (queue (queued-builds server max)) + (len (length queue)) + (histo (histogram build-system + (lambda (build count) + (+ 1 count)) + 0 queue))) + (newline) + (unless (null? missing) + (let ((missing (length missing))) + (match (queued-subset queue missing) + (#f #f) + ((= length queued) + (format #t (G_ " ~,1f% (~h out of ~h) of the missing items \ +are queued~%") + (* 100. (/ queued missing)) + queued missing))))) + + (if (>= len max) + (format #t (G_ " at least ~h queued builds~%") len) + (format #t (G_ " ~h queued builds~%") len)) + (for-each (match-lambda + ((system . count) + (format #t (G_ " ~a: ~a (~0,1f%)~%") + system count (* 100. (/ count len))))) + histo)) + + (let* ((latest (latest-builds server)) + (builds/sec (throughput latest build-timestamp))) + (format #t (G_ " build rate: ~1,2f builds per hour~%") + (* builds/sec 3600.)) + (for-each (match-lambda + ((system . builds) + (format #t (G_ " ~a: ~,2f builds per hour~%") + system + (* (throughput builds build-timestamp) + 3600.)))) + (histogram build-system cons '() latest))))))) ;;; |