blob: 87dd0adfacbb4105a7a41725139bc870a12502fb (
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
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
|
#!/bin/sh
# -*- scheme -*-
exec ${GUILE:-@GUILE@} --no-auto-compile -e main -s "$0" "$@"
!#
;;;; cuirass - continuous integration system
;;;
;;; Copyright © 2016 Mathieu Lirzin <mthl@gnu.org>
;;;
;;; This file is part of Cuirass.
;;;
;;; Cuirass 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.
;;;
;;; Cuirass 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 Cuirass. If not, see <http://www.gnu.org/licenses/>.
(use-modules (cuirass config)
(cuirass base)
(cuirass database)
(cuirass job)
(cuirass ui)
(ice-9 getopt-long)
(ice-9 match))
(define* (show-help prog)
(simple-format #t "Usage: ~a [OPTIONS] [CACHEDIR]" prog)
(display "
Run Guix job from a git repository cloned in CACHEDIR.
-f --use-file=FILE Use FILE which defines the job to evaluate
-D --database=DB Use DB to store build results.
-I, --interval=N Wait N seconds between each evaluation
-V, --version Display version
-h, --help Display this help message")
(newline)
(show-package-information))
(define %options
`((file (single-char #\f) (value #t))
(database (single-char #\f) (value #t))
(interval (single-char #\I) (value #t))
(version (single-char #\V) (value #f))
(help (single-char #\h) (value #f))))
(define %user-module
;; Cuirass user module.
(let ((m (make-module)))
(beautify-user-module! m)
m))
(define (fetch-repository cachedir spec)
"Get the latest version of Guix repository. Clone repository in directory
DIR if required."
(or (file-exists? cachedir) (mkdir cachedir))
(with-directory-excursion cachedir
(match spec
(($ <job-spec> name url branch)
(or (file-exists? name) (system* "git" "clone" url name))
(with-directory-excursion name
(and (zero? (system* "git" "fetch"))
(zero? (system* "git" "reset" "--hard"
(string-append "origin/" branch)))))))))
(define (evaluate store db cachedir spec)
"Evaluate and build package derivations. Return a list a jobs."
(save-module-excursion
(lambda ()
(set-current-module %user-module)
(let ((dir (string-append cachedir "/" (job-spec-name spec))))
(format #t "prepending ~s to the load path~%" dir)
(set! %load-path (cons dir %load-path)))
(primitive-load (job-spec-file spec))))
(let* ((proc (module-ref %user-module (job-spec-proc spec)))
(jobs (proc store (job-spec-arguments spec))))
(for-each (λ (job) (db-add-evaluation db job))
jobs)
jobs))
(define (build-packages store jobs)
"Build JOBS which is a list of <job> objects."
(map (match-lambda
(($ <job> name drv)
(format #t "building ~A...~%" drv)
((guix-variable 'derivations 'build-derivations)
store (list drv))
(format #t "~A~%"
((guix-variable 'derivations
'derivation-path->output-path) drv))))
jobs))
;;;
;;; Entry point.
;;;
(define* (main #:optional (args (command-line)))
(let ((opts (getopt-long args %options))
(progname "cuirass"))
(cond
((option-ref opts 'help #f)
(show-help progname)
(exit 0))
((option-ref opts 'version #f)
(show-version progname)
(exit 0))
(else
(let* ((specfile (option-ref opts 'file "tests/hello-subset.scm"))
(dbfile (option-ref opts 'database %package-database))
(specs (primitive-load specfile))
(args (option-ref opts '() #f))
(cachedir (if (null? args)
(getenv "CUIRASS_CACHEDIR")
(car args))))
(db-close (db-init dbfile))
(while #t
(for-each
(λ (spec)
(fetch-repository cachedir spec)
(let ((store ((guix-variable 'store 'open-connection)))
(db (db-open dbfile)))
(dynamic-wind
(const #t)
(lambda ()
(let* ((jobs (evaluate store db cachedir spec))
(set-build-options
(guix-variable 'store 'set-build-options)))
(set-build-options store #:use-substitutes? #f)
(build-packages store jobs)))
(lambda ()
((guix-variable 'store 'close-connection) store)
(db-close db)))))
specs)
(sleep (string->number (option-ref opts 'interval "60")))))))))
|