blob: 9a2d2825ba54a7e12a568a71e6f1cf5ac8520169 (
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
|
#!@GUILE@ --no-auto-compile
-*- scheme -*-
-*- geiser-scheme-implementation: guile -*-
!#
;;; Guix Build Coordinator
;;;
;;; Copyright © 2020 Christopher Baines <mail@cbaines.net>
;;;
;;; This file is part of the guix-build-coordinator.
;;;
;;; The Guix Build Coordinator 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.
;;;
;;; The Guix Build Coordinator 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 the guix-data-service. If not, see
;;; <http://www.gnu.org/licenses/>.
(use-modules (srfi srfi-1)
(srfi srfi-37)
(ice-9 match)
(guix-build-coordinator config)
(guix-build-coordinator datastore)
(guix-build-coordinator coordinator))
(define %options
;; Specifications of the command-line options
(list (option '("pid-file") #t #f
(lambda (opt name arg result)
(alist-cons 'pid-file
arg
result)))
(option '("secret-key-base-file") #t #f
(lambda (opt name arg result)
(alist-cons 'secret-key-base
(string-trim-right
(call-with-input-file arg get-string-all))
result)))
(option '("database") #t #f
(lambda (opt name arg result)
(alist-cons 'database
arg
result)))
(option '("update-database") #f #f
(lambda (opt name _ result)
(alist-cons 'update-database #t result)))
(option '("show-error-details") #f #f
(lambda (opt name _ result)
(alist-cons 'show-error-details #t result)))))
(define %default-options
;; Alist of default option values
`((update-database . #f)
(database . "sqlite://guix_build_coordinator.db")
(show-error-details
. ,(match (getenv "GUIX_BUILD_COORDINATOR_SHOW_ERROR_DETAILS")
(#f #f)
("" #f)
(_ #t)))))
(define (parse-options args)
(args-fold
args %options
(lambda (opt name arg result)
(error "unrecognized option" name))
(lambda (arg result)
(alist-cons
'arguments
(cons arg
(or (assoc-ref result 'arguments)
'()))
(alist-delete 'arguments result)))
%default-options))
(setvbuf (current-output-port) 'line)
(setvbuf (current-error-port) 'line)
(match (cdr (program-arguments))
(("build" rest ...)
(let ((opts (parse-options rest)))
(match (assq-ref opts 'arguments)
((derivation-file)
(let ((uuid (submit-build
(database-uri->datastore
(assq-ref opts 'database))
derivation-file)))
(simple-format #t "build submitted as ~A\n" uuid))))))
((arguments ...)
(let* ((opts (parse-options arguments))
(datastore (database-uri->datastore
(assq-ref opts 'database))))
(when (assoc-ref opts 'update-database)
(datastore-update datastore))
(let ((pid-file (assq-ref opts 'pid-file)))
(when pid-file
(call-with-output-file pid-file
(lambda (port)
(simple-format port "~A\n" (getpid))))))
(parameterize ((%show-error-details
(assoc-ref opts 'show-error-details)))
(peek "OPTS" opts)))))
|