futurile/guix-play
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

weather: Report continuous integration stats.

Browse Source 
* guix/scripts/weather.scm (histogram, throughput, queued-subset): New
procedures.
(report-server-coverage): Report CI information.
* doc/guix.texi (Invoking guix weather): Document it.
This commit is contained in:
Ludovic Courtès 2018-03-28 15:49:11 +02:00
parent b3517f3f9f
commit 183445a6ed
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
2 changed files with 120 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

14
doc/guix.texi
View File

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

109
guix/scripts/weather.scm
View File

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