blob: 61b9dd8ca6a3f07923f24923f97a7159d431212a (
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
|
#!/bin/sh
# -*- scheme -*-
# @configure_input@
#GUILE_LOAD_PATH="@PACKAGE_LOAD_PATH@${GUILE_LOAD_PATH:+:}$GUILE_LOAD_PATH"
#GUILE_LOAD_COMPILED_PATH="@PACKAGE_LOAD_COMPILED_PATH@${GUILE_LOAD_COMPILED_PATH:+:}$GUILE_LOAD_COMPILED_PATH"
exec ${GUILE:-@GUILE@} --no-auto-compile -e main -s "$0" "$@"
!#
;;;; cuirass -- continuous integration tool
;;; Copyright © 2016 Mathieu Lirzin <mthl@gnu.org>
;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com>
;;;
;;; 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)
(cuirass ui)
(guix ui)
(ice-9 getopt-long))
(define (show-help)
(format #t "Usage: ~a [OPTIONS]~%" (%program-name))
(display "Run build jobs from internal database.
--one-shot Evaluate and build jobs only once
--cache-directory=DIR Use DIR for storing repository data
-L --load-path=DIR Prepend DIR to Guix package module search path.
-S --specifications=SPECFILE
Add specifications from SPECFILE to database.
-D --database=DB Use DB to store build results.
-p --port=NUM Port of the HTTP server.
-I, --interval=N Wait N seconds between each poll
--use-substitutes Allow usage of pre-built substitutes
-V, --version Display version
-h, --help Display this help message")
(newline)
(show-package-information))
(define %options
'((one-shot (value #f))
(cache-directory (value #t))
(load-path (single-char #\L) (value #t))
(specifications (single-char #\S) (value #t))
(database (single-char #\D) (value #t))
(port (single-char #\p) (value #t))
(interval (single-char #\I) (value #t))
(use-substitutes (value #f))
(version (single-char #\V) (value #f))
(help (single-char #\h) (value #f))))
;;;
;;; Entry point.
;;;
(define* (main #:optional (args (command-line)))
(let ((opts (getopt-long args %options)))
(parameterize
((%program-name (car args))
(%package-database (option-ref opts 'database (%package-database)))
(%package-cachedir
(option-ref opts 'cache-directory (%package-cachedir)))
(%guix-package-path
(option-ref opts 'load-path (%guix-package-path)))
(%use-substitutes? (option-ref opts 'use-substitutes #f)))
(cond
((option-ref opts 'help #f)
(show-help)
(exit 0))
((option-ref opts 'version #f)
(show-version)
(exit 0))
(else
(let ((one-shot? (option-ref opts 'one-shot #f))
(port (string->number (option-ref opts 'port "8080")))
(interval (string->number (option-ref opts 'interval "10")))
(specfile (option-ref opts 'specifications #f)))
(with-database db
(and specfile
(let ((new-specs (save-module-excursion
(lambda ()
(set-current-module (make-user-module '()))
(primitive-load specfile)))))
(for-each (lambda (spec) (db-add-specification db spec))
new-specs)))
(if one-shot?
(process-specs db (db-get-specifications db))
(begin
(call-with-new-thread
(lambda ()
(while #t
(process-specs db (db-get-specifications db))
(sleep interval))))
(run-cuirass-server db #:port port))))))))))
|