blob: 42116273587d9598f5f79cad22b0444ae22a54db (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
|
(define-module (guix-qa-frontpage reproducible-builds)
#:use-module (srfi srfi-43)
#:use-module (ice-9 threads)
#:use-module (zlib)
#:use-module (json)
#:use-module (guix-qa-frontpage guix-data-service)
#:export (start-generate-reproducible.json-thread))
(define* (start-generate-reproducible.json-thread)
(define (generate)
(let* ((revision (get-latest-processed-branch-revision "master"))
(data
(guix-data-service-request
(string-append
"https://data.qa.guix.gnu.org/revision/" revision
"/package-derivation-outputs.json?"
"system=x86_64-linux&target=none&field=nars"
"&limit_results=&all_results=on")))
(output-consistency-by-package
(make-hash-table)))
(vector-for-each
(lambda (_ output)
(let ((consistency
(assoc-ref output "output_consistency")))
(unless (string=? consistency "unknown")
(let* ((package (assoc-ref output "package"))
(key (cons (assoc-ref package "name")
(assoc-ref package "version"))))
(hash-set! output-consistency-by-package
key
(cons consistency
(or (hash-ref output-consistency-by-package
key)
'())))))))
(assoc-ref data "store_paths"))
(let ((result
(hash-fold
(lambda (key val result)
(cons
`((package . ,(car key))
(version . ,(cdr key))
(architecture . "x86_64-linux")
(status . ,(if (member "not-matching" val)
"unreproducible"
"reproducible")))
result))
'()
output-consistency-by-package)))
(call-with-output-file "reproducible.json.gz"
(lambda (port)
(call-with-zlib-output-port
port
(lambda (port)
(set-port-encoding! port "UTF-8")
(scm->json (list->vector result)
port
#:pretty #t))
#:format 'gzip))))))
(call-with-new-thread
(lambda ()
(while #t
(with-exception-handler
(lambda (exn)
(simple-format
(current-error-port)
"exception in generate reproducible.json fiber: ~A\n"
exn))
(lambda ()
(with-throw-handler #t
generate
(lambda args
(display (backtrace) (current-error-port))
(newline (current-error-port)))))
#:unwind? #t)
(simple-format #t "finished generating reproducible.json.gz\n")
(sleep (* 60 60 24))))))
|