2016-07-16 18:16:39 +02:00
|
|
|
;;; database.scm -- store evaluation and build results
|
2017-01-09 01:29:48 +01:00
|
|
|
;;; Copyright © 2016, 2017 Mathieu Lirzin <mthl@gnu.org>
|
2017-07-31 19:25:28 +02:00
|
|
|
;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com>
|
2018-01-07 10:19:56 +01:00
|
|
|
;;; Copyright © 2018 Ludovic Courtès <ludo@gnu.org>
|
2018-07-07 00:31:14 +02:00
|
|
|
;;; Copyright © 2018 Clément Lassieur <clement@lassieur.org>
|
Add a web interface.
* Makefile.am (dist_sql_DATA): Add static files.
* src/cuirass/database.scm (assqx-ref): Export it.
(db-get-builds): Add 'evaluation' filter and filters for pagination.
(db-get-evaluations-build-summary, db-get-evaluations-id-min,
db-get-evaluations-id-max, db-get-builds-min, db-get-builds-max): New exported
procedures.
* src/cuirass/http.scm (%static-directory): New parameter.
(%page-size, %file-mime-types, %file-white-list): New variables.
(handle-build-request, handle-builds-request): Move the WITH-CRITICAL-SECTION
call out.
(url-handler): Add RESPOND-HTML, RESPOND-STATIC-FILE and RESPOND-NOT-FOUND
procedures. Call WITH-CRITICAL-SECTION sooner for the '/build',
'/api/latestbuilds' and '/api/queue' routes. Add '/', '/jobset/<name>',
'/eval/<id>', '/static/<path>' routes. Use RESPOND-NOT-FOUND when the route
isn't found.
* src/cuirass/templates.scm: New file.
(html-page, specifications-table, evaluation-info-table,
build-eval-table): New exported procedures.
(pagination): New procedure.
Signed-off-by: Clément Lassieur <clement@lassieur.org>
2018-07-21 15:39:10 +02:00
|
|
|
;;; Copyright © 2018 Tatiana Sholokhova <tanja201396@gmail.com>
|
2016-06-26 15:13:31 +02:00
|
|
|
;;;
|
|
|
|
;;; This file is part of Cuirass.
|
|
|
|
;;;
|
2016-07-23 12:10:04 +02:00
|
|
|
;;; 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.
|
2016-06-26 15:13:31 +02:00
|
|
|
;;;
|
2016-07-23 12:10:04 +02:00
|
|
|
;;; Cuirass is distributed in the hope that it will be useful,
|
|
|
|
;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
2016-06-26 15:13:31 +02:00
|
|
|
;;; 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/>.
|
|
|
|
|
|
|
|
(define-module (cuirass database)
|
2016-06-26 18:40:31 +02:00
|
|
|
#:use-module (cuirass config)
|
2016-07-23 22:05:50 +02:00
|
|
|
#:use-module (cuirass utils)
|
|
|
|
#:use-module (ice-9 match)
|
2018-01-24 23:40:07 +01:00
|
|
|
#:use-module (ice-9 format)
|
2018-07-07 00:31:14 +02:00
|
|
|
#:use-module (ice-9 ftw)
|
2016-07-16 18:16:39 +02:00
|
|
|
#:use-module (ice-9 rdelim)
|
2018-07-07 00:31:14 +02:00
|
|
|
#:use-module (ice-9 regex)
|
2017-07-31 19:25:28 +02:00
|
|
|
#:use-module (srfi srfi-1)
|
2018-01-23 18:15:42 +01:00
|
|
|
#:use-module (srfi srfi-19)
|
2018-02-19 16:30:07 +01:00
|
|
|
#:use-module (srfi srfi-26)
|
2016-06-26 15:13:31 +02:00
|
|
|
#:use-module (sqlite3)
|
2016-06-26 18:40:31 +02:00
|
|
|
#:export (;; Procedures.
|
|
|
|
db-init
|
2016-06-26 15:13:31 +02:00
|
|
|
db-open
|
|
|
|
db-close
|
2016-07-23 17:00:38 +02:00
|
|
|
db-add-specification
|
2016-07-23 22:05:50 +02:00
|
|
|
db-get-specifications
|
2016-07-26 00:36:12 +02:00
|
|
|
db-add-stamp
|
|
|
|
db-get-stamp
|
2016-06-26 15:13:31 +02:00
|
|
|
db-add-evaluation
|
2016-07-26 16:53:57 +02:00
|
|
|
db-add-derivation
|
|
|
|
db-get-derivation
|
2018-04-05 22:15:20 +02:00
|
|
|
db-get-pending-derivations
|
2018-01-23 17:37:08 +01:00
|
|
|
build-status
|
2016-07-25 20:31:06 +02:00
|
|
|
db-add-build
|
2018-01-23 18:15:42 +01:00
|
|
|
db-update-build-status!
|
2017-07-31 19:25:28 +02:00
|
|
|
db-get-build
|
|
|
|
db-get-builds
|
Add a web interface.
* Makefile.am (dist_sql_DATA): Add static files.
* src/cuirass/database.scm (assqx-ref): Export it.
(db-get-builds): Add 'evaluation' filter and filters for pagination.
(db-get-evaluations-build-summary, db-get-evaluations-id-min,
db-get-evaluations-id-max, db-get-builds-min, db-get-builds-max): New exported
procedures.
* src/cuirass/http.scm (%static-directory): New parameter.
(%page-size, %file-mime-types, %file-white-list): New variables.
(handle-build-request, handle-builds-request): Move the WITH-CRITICAL-SECTION
call out.
(url-handler): Add RESPOND-HTML, RESPOND-STATIC-FILE and RESPOND-NOT-FOUND
procedures. Call WITH-CRITICAL-SECTION sooner for the '/build',
'/api/latestbuilds' and '/api/queue' routes. Add '/', '/jobset/<name>',
'/eval/<id>', '/static/<path>' routes. Use RESPOND-NOT-FOUND when the route
isn't found.
* src/cuirass/templates.scm: New file.
(html-page, specifications-table, evaluation-info-table,
build-eval-table): New exported procedures.
(pagination): New procedure.
Signed-off-by: Clément Lassieur <clement@lassieur.org>
2018-07-21 15:39:10 +02:00
|
|
|
db-get-builds-min
|
|
|
|
db-get-builds-max
|
2018-04-19 11:17:42 +02:00
|
|
|
db-get-evaluations
|
Add a web interface.
* Makefile.am (dist_sql_DATA): Add static files.
* src/cuirass/database.scm (assqx-ref): Export it.
(db-get-builds): Add 'evaluation' filter and filters for pagination.
(db-get-evaluations-build-summary, db-get-evaluations-id-min,
db-get-evaluations-id-max, db-get-builds-min, db-get-builds-max): New exported
procedures.
* src/cuirass/http.scm (%static-directory): New parameter.
(%page-size, %file-mime-types, %file-white-list): New variables.
(handle-build-request, handle-builds-request): Move the WITH-CRITICAL-SECTION
call out.
(url-handler): Add RESPOND-HTML, RESPOND-STATIC-FILE and RESPOND-NOT-FOUND
procedures. Call WITH-CRITICAL-SECTION sooner for the '/build',
'/api/latestbuilds' and '/api/queue' routes. Add '/', '/jobset/<name>',
'/eval/<id>', '/static/<path>' routes. Use RESPOND-NOT-FOUND when the route
isn't found.
* src/cuirass/templates.scm: New file.
(html-page, specifications-table, evaluation-info-table,
build-eval-table): New exported procedures.
(pagination): New procedure.
Signed-off-by: Clément Lassieur <clement@lassieur.org>
2018-07-21 15:39:10 +02:00
|
|
|
db-get-evaluations-build-summary
|
|
|
|
db-get-evaluations-id-min
|
|
|
|
db-get-evaluations-id-max
|
2016-07-16 18:16:39 +02:00
|
|
|
read-sql-file
|
2016-07-25 20:20:53 +02:00
|
|
|
read-quoted-string
|
2016-07-22 12:35:09 +02:00
|
|
|
sqlite-exec
|
2016-06-26 18:40:31 +02:00
|
|
|
;; Parameters.
|
|
|
|
%package-database
|
2016-07-23 17:00:38 +02:00
|
|
|
%package-schema-file
|
2016-06-26 18:40:31 +02:00
|
|
|
;; Macros.
|
|
|
|
with-database))
|
2016-06-26 15:13:31 +02:00
|
|
|
|
2018-02-08 17:31:39 +01:00
|
|
|
(define (%sqlite-exec db sql . args)
|
database: Use 'sqlite-bind' to avoid SQL injection.
* src/cuirass/database.scm (%sqlite-exec): Remove.
(sqlite-exec): Turn back into a procedure. Use 'sqlite-bind'. Add
'normalize' procedure and use it.
(db-add-specification, db-add-derivation, db-get-derivation)
(db-add-evaluation, db-add-build, db-update-build-status!)
(db-get-build, db-get-stamp, db-add-stamp): Use question marks in SQL
queries.
* src/cuirass/base.scm (build-packages)[register]: Make #:log
non-false.
* tests/database.scm (make-dummy-job): Add #:job-name, #:system,
#:nix-name, and #:eval-id. This is necessary because 'sqlite-bind'
would now translate #f to a real NULL (before it would translate to the
string "#f"...), and would thus report violations of the non-NULL
constraint.
Co-authored-by: Ludovic Courtès <ludo@gnu.org>
2018-02-08 11:39:45 +01:00
|
|
|
"Evaluate the given SQL query with the given ARGS. Return the list of
|
|
|
|
rows."
|
|
|
|
(define (normalize arg)
|
|
|
|
;; Turn ARG into a string, unless it's a primitive SQL datatype.
|
|
|
|
(if (or (null? arg) (pair? arg) (vector? arg))
|
|
|
|
(object->string arg)
|
|
|
|
arg))
|
|
|
|
|
2018-02-08 11:46:29 +01:00
|
|
|
(let ((stmt (sqlite-prepare db sql #:cache? #t)))
|
database: Use 'sqlite-bind' to avoid SQL injection.
* src/cuirass/database.scm (%sqlite-exec): Remove.
(sqlite-exec): Turn back into a procedure. Use 'sqlite-bind'. Add
'normalize' procedure and use it.
(db-add-specification, db-add-derivation, db-get-derivation)
(db-add-evaluation, db-add-build, db-update-build-status!)
(db-get-build, db-get-stamp, db-add-stamp): Use question marks in SQL
queries.
* src/cuirass/base.scm (build-packages)[register]: Make #:log
non-false.
* tests/database.scm (make-dummy-job): Add #:job-name, #:system,
#:nix-name, and #:eval-id. This is necessary because 'sqlite-bind'
would now translate #f to a real NULL (before it would translate to the
string "#f"...), and would thus report violations of the non-NULL
constraint.
Co-authored-by: Ludovic Courtès <ludo@gnu.org>
2018-02-08 11:39:45 +01:00
|
|
|
(for-each (lambda (arg index)
|
|
|
|
(sqlite-bind stmt index (normalize arg)))
|
|
|
|
args (iota (length args) 1))
|
|
|
|
(let ((result (sqlite-fold-right cons '() stmt)))
|
|
|
|
(sqlite-finalize stmt)
|
|
|
|
result)))
|
2018-01-25 10:38:19 +01:00
|
|
|
|
2018-02-08 17:31:39 +01:00
|
|
|
(define-syntax sqlite-exec/bind
|
|
|
|
(lambda (s)
|
|
|
|
;; Expand to an '%sqlite-exec' call where the query string has
|
|
|
|
;; interspersed question marks and the argument list is separate.
|
|
|
|
(define (string-literal? s)
|
|
|
|
(string? (syntax->datum s)))
|
|
|
|
|
|
|
|
(syntax-case s ()
|
|
|
|
((_ db (bindings ...) tail str arg rest ...)
|
|
|
|
#'(sqlite-exec/bind db
|
|
|
|
(bindings ... (str arg))
|
|
|
|
tail
|
|
|
|
rest ...))
|
|
|
|
((_ db (bindings ...) tail str)
|
|
|
|
#'(sqlite-exec/bind db (bindings ...) str))
|
|
|
|
((_ db ((strings args) ...) tail)
|
|
|
|
(and (every string-literal? #'(strings ...))
|
|
|
|
(string-literal? #'tail))
|
|
|
|
;; Optimized case: only string literals.
|
|
|
|
(with-syntax ((query (string-join
|
|
|
|
(append (syntax->datum #'(strings ...))
|
|
|
|
(list (syntax->datum #'tail)))
|
|
|
|
"? ")))
|
|
|
|
#'(%sqlite-exec db query args ...)))
|
|
|
|
((_ db ((strings args) ...) tail)
|
|
|
|
;; Fallback case: some of the strings aren't literals.
|
|
|
|
#'(%sqlite-exec db (string-join (list strings ... tail) "? ")
|
|
|
|
args ...)))))
|
|
|
|
|
|
|
|
(define-syntax-rule (sqlite-exec db query args ...)
|
|
|
|
"Execute the specific QUERY with the given ARGS. Uses of 'sqlite-exec'
|
|
|
|
typically look like this:
|
|
|
|
|
|
|
|
(sqlite-exec db \"SELECT * FROM Foo WHERE x = \"
|
|
|
|
x \"AND Y=\" y \";\")
|
|
|
|
|
|
|
|
References to variables 'x' and 'y' here are replaced by question marks in the
|
|
|
|
SQL query, and then 'sqlite-bind' is used to bind them.
|
|
|
|
|
|
|
|
This ensures that (1) SQL injection is impossible, and (2) the number of
|
|
|
|
question marks matches the number of arguments to bind."
|
|
|
|
(sqlite-exec/bind db () "" query args ...))
|
|
|
|
|
2016-06-26 18:40:31 +02:00
|
|
|
(define %package-database
|
|
|
|
;; Define to the database file name of this package.
|
2018-01-22 14:51:14 +01:00
|
|
|
(make-parameter (string-append %localstatedir "/run/" %package
|
|
|
|
"/" %package ".db")))
|
2016-06-26 18:40:31 +02:00
|
|
|
|
2016-07-16 18:16:39 +02:00
|
|
|
(define %package-schema-file
|
|
|
|
;; Define to the database schema file of this package.
|
|
|
|
(make-parameter (string-append (or (getenv "CUIRASS_DATADIR")
|
|
|
|
(string-append %datadir "/" %package))
|
|
|
|
"/schema.sql")))
|
|
|
|
|
2018-07-07 00:31:14 +02:00
|
|
|
(define %package-sql-dir
|
|
|
|
;; Define to the directory containing the SQL files.
|
|
|
|
(make-parameter (string-append (or (getenv "CUIRASS_DATADIR")
|
|
|
|
(string-append %datadir "/" %package))
|
|
|
|
"/sql")))
|
|
|
|
|
2016-07-16 18:16:39 +02:00
|
|
|
(define (read-sql-file file-name)
|
|
|
|
"Return a list of string containing SQL instructions from FILE-NAME."
|
|
|
|
(call-with-input-file file-name
|
2017-07-06 10:03:16 +02:00
|
|
|
(lambda (port)
|
2016-07-16 18:16:39 +02:00
|
|
|
(let loop ((insts '()))
|
|
|
|
(let ((inst (read-delimited ";" port 'concat)))
|
|
|
|
(if (or (eof-object? inst)
|
|
|
|
;; Don't cons the spaces after the last instructions.
|
|
|
|
(string-every char-whitespace? inst))
|
|
|
|
(reverse! insts)
|
|
|
|
(loop (cons inst insts))))))))
|
|
|
|
|
2018-03-25 00:02:16 +01:00
|
|
|
(define (set-db-options db)
|
|
|
|
"Set various options for DB and return it."
|
|
|
|
|
|
|
|
;; Turn DB in "write-ahead log" mode and return it.
|
2018-01-26 18:20:30 +01:00
|
|
|
(sqlite-exec db "PRAGMA journal_mode=WAL;")
|
2018-03-25 00:02:16 +01:00
|
|
|
|
|
|
|
;; Install a busy handler such that, when the database is locked, sqlite
|
|
|
|
;; retries until 30 seconds have passed, at which point it gives up and
|
|
|
|
;; throws SQLITE_BUSY. This is useful when we have several fibers or
|
|
|
|
;; threads accessing the database concurrently.
|
|
|
|
;;(sqlite-busy-timeout db (* 30 1000))
|
|
|
|
(sqlite-exec db "PRAGMA busy_timeout = 30000;")
|
|
|
|
|
2018-01-26 18:20:30 +01:00
|
|
|
db)
|
|
|
|
|
2018-07-07 00:31:14 +02:00
|
|
|
(define (db-load db schema)
|
|
|
|
"Evaluate the file SCHEMA, which may contain SQL queries, into DB."
|
|
|
|
(for-each (cut sqlite-exec db <>)
|
|
|
|
(read-sql-file schema)))
|
|
|
|
|
|
|
|
(define (db-schema-version db)
|
|
|
|
(vector-ref (car (sqlite-exec db "PRAGMA user_version;")) 0))
|
|
|
|
|
|
|
|
(define (db-set-schema-version db version)
|
|
|
|
(sqlite-exec db (format #f "PRAGMA user_version = ~d;" version)))
|
|
|
|
|
|
|
|
(define (latest-db-schema-version)
|
|
|
|
"Return the version to which the schema should be upgraded, based on the
|
|
|
|
upgrade-n.sql files, or 0 if there are no such files."
|
|
|
|
(reduce max 0
|
|
|
|
(map (compose string->number (cut match:substring <> 1))
|
|
|
|
(filter-map (cut string-match "^upgrade-([0-9]+)\\.sql$" <>)
|
|
|
|
(or (scandir (%package-sql-dir)) '())))))
|
|
|
|
|
2016-07-23 22:04:03 +02:00
|
|
|
(define* (db-init #:optional (db-name (%package-database))
|
|
|
|
#:key (schema (%package-schema-file)))
|
2016-06-26 18:40:31 +02:00
|
|
|
"Open the database to store and read jobs and builds informations. Return a
|
|
|
|
database object."
|
2016-07-23 22:04:03 +02:00
|
|
|
(when (file-exists? db-name)
|
|
|
|
(format (current-error-port) "Removing leftover database ~a~%" db-name)
|
|
|
|
(delete-file db-name))
|
|
|
|
(let ((db (sqlite-open db-name (logior SQLITE_OPEN_CREATE
|
2018-07-19 12:48:44 +02:00
|
|
|
SQLITE_OPEN_READWRITE
|
|
|
|
SQLITE_OPEN_NOMUTEX))))
|
2018-07-07 00:31:14 +02:00
|
|
|
(db-load db schema)
|
|
|
|
(db-set-schema-version db (latest-db-schema-version))
|
2016-07-23 22:04:03 +02:00
|
|
|
db))
|
2016-06-26 15:13:31 +02:00
|
|
|
|
2018-07-07 00:31:14 +02:00
|
|
|
(define (schema-upgrade-file version)
|
|
|
|
"Return the file containing the SQL instructions that upgrade the schema
|
|
|
|
from VERSION-1 to VERSION."
|
|
|
|
(in-vicinity (%package-sql-dir) (format #f "upgrade-~a.sql" version)))
|
|
|
|
|
|
|
|
(define (db-upgrade db)
|
|
|
|
"Upgrade database DB based on its current version and the available
|
|
|
|
upgrade-n.sql files."
|
|
|
|
(for-each (lambda (version)
|
|
|
|
(db-load db (schema-upgrade-file version))
|
|
|
|
(db-set-schema-version db version))
|
|
|
|
(let ((current (db-schema-version db)))
|
|
|
|
(iota (- (latest-db-schema-version) current) (1+ current))))
|
|
|
|
db)
|
|
|
|
|
2016-07-26 11:06:48 +02:00
|
|
|
(define* (db-open #:optional (db (%package-database)))
|
2016-06-26 18:40:31 +02:00
|
|
|
"Open database to store or read jobs and builds informations. Return a
|
|
|
|
database object."
|
2018-01-26 18:20:30 +01:00
|
|
|
;; Use "write-ahead log" mode because it improves concurrency and should
|
|
|
|
;; avoid SQLITE_LOCKED errors when we have several readers:
|
|
|
|
;; <https://www.sqlite.org/wal.html>.
|
2018-07-19 12:48:44 +02:00
|
|
|
|
|
|
|
;; SQLITE_OPEN_NOMUTEX disables mutexing on database connection and prepared
|
|
|
|
;; statement objects, thus making us responsible for serializing access to
|
|
|
|
;; database connections and prepared statements.
|
2018-03-25 00:02:16 +01:00
|
|
|
(set-db-options (if (file-exists? db)
|
2018-07-19 12:48:44 +02:00
|
|
|
(db-upgrade
|
|
|
|
(sqlite-open db (logior SQLITE_OPEN_READWRITE
|
|
|
|
SQLITE_OPEN_NOMUTEX)))
|
2018-03-25 00:02:16 +01:00
|
|
|
(db-init db))))
|
2016-06-26 15:13:31 +02:00
|
|
|
|
|
|
|
(define (db-close db)
|
|
|
|
"Close database object DB."
|
|
|
|
(sqlite-close db))
|
|
|
|
|
2016-07-22 13:13:52 +02:00
|
|
|
(define (last-insert-rowid db)
|
|
|
|
(vector-ref (car (sqlite-exec db "SELECT last_insert_rowid();"))
|
|
|
|
0))
|
|
|
|
|
Add support for multiple inputs.
* Makefile.am (dist_sql_DATA): Add src/sql/upgrade-1.sql.
* bin/cuirass.in (show-help, %options, main): Remove the LOAD-PATH option that
was used afterwards as %GUIX-PACKAGE-PATH.
* bin/evaluate.in (absolutize, input-checkout, spec-source, spec-load-path,
spec-package-path, format-checkouts): New procedures.
(%not-colon): Remove variable.
(main): Take the load path, package path and PROC from the checkouts that
result from the inputs. Format the checkouts before sending them to the
procedure. Remove the LOAD-PATH argument.
* doc/cuirass.texi (Overview, Database schema): Document the changes.
* examples/{guix-jobs.scm, hello-git.scm, hello-singleton.scm,
hello-subset.scm, random.scm}: Adapt to the new specification format.
* examples/guix-track-git.scm (package->spec): Rename to PACKAGE->INPUT.
(package->git-tracked): Replace FETCH-REPOSITORY with FETCH-INPUT and handle
the new format of its return value.
* examples/random-jobs.scm (make-random-jobs): Rename RANDOM to CHECKOUT.
Rename the checkout from 'random (which is a specification) to 'cuirass (which
is a checkout resulting from an input).
* src/cuirass/base.scm (fetch-repository): Rename to fetch-input. Rename SPEC
to INPUT. Return a checkout object instead of returning two values.
(evaluate): Take a list of CHECKOUTS and COMMITS as arguments, instead of
SOURCE. Remove TOKENIZE and LOAD-PATH. Pass the CHECKOUTS instead of the
SOURCE to "evaluate". Remove %GUIX-PACKAGE-PATH. Build the EVAL object
instead of getting it from "evaluate".
(compile?, fetch-inputs, compile-checkouts): New procedures.
(process-specs): Fetch all inputs instead of only fetching one repository.
The result of that fetching operation is a list of CHECKOUTS whose COMMITS are
used as a STAMP.
(%guix-package-path, set-guix-package-path): Remove them.
* src/cuirass/database.scm (db-add-input, db-get-inputs): New procedures.
(db-add-specification, db-get-specifications): Adapt to the new specification
format. Add/get all inputs as well.
(db-add-evaluation): Rename REVISION to COMMITS. Store COMMITS as space
separated commit hashes.
(db-get-builds): Rename REPO_NAME to NAME.
(db-get-stamp): Rename COMMIT to STAMP. Return #f when there is no STAMP.
(db-add-stamp): Rename COMMIT to STAMP. Deal with DB-GET-STAMP's new return
value.
(db-get-evaluations): Rename REVISION to COMMITS. Tokenize COMMITS.
* src/cuirass/utils.scm (%non-blocking): Export it.
* src/schema.sql (Inputs): New table that refers to the Specifications table.
(Specifications): Move input related fields to the Inputs table. Rename
REPO_NAME to NAME. Rename ARGUMENTS to PROC_ARGS. Rename FILE to PROC_FILE.
Add LOAD_PATH_INPUTS, PACKAGE_PATH_INPUTS and PROC_INPUT fields that refer to
the Inputs table.
(Stamps): Rename REPO_NAME to NAME.
(Evaluations): Rename REPO_NAME to NAME. Rename REVISION to COMMITS.
(Specifications_index): Replace with Inputs_index.
* src/sql/upgrade-1.sql: New file.
* tests/database.scm (example-spec, make-dummy-eval, sqlite-exec): Adapt to
the new specifications format. Rename REVISION to COMMITS.
* tests/http.scm (evaluations-query-result, fill-db): Idem.
2018-06-26 11:18:23 +02:00
|
|
|
(define (db-add-input db spec-name input)
|
|
|
|
(sqlite-exec db "\
|
|
|
|
INSERT OR IGNORE INTO Inputs (specification, name, url, load_path, branch, \
|
|
|
|
tag, revision, no_compile_p) VALUES ("
|
|
|
|
spec-name ", "
|
|
|
|
(assq-ref input #:name) ", "
|
|
|
|
(assq-ref input #:url) ", "
|
|
|
|
(assq-ref input #:load-path) ", "
|
|
|
|
(assq-ref input #:branch) ", "
|
|
|
|
(assq-ref input #:tag) ", "
|
|
|
|
(assq-ref input #:commit) ", "
|
|
|
|
(if (assq-ref input #:no-compile?) 1 0) ");")
|
|
|
|
(last-insert-rowid db))
|
|
|
|
|
2016-07-23 17:00:38 +02:00
|
|
|
(define (db-add-specification db spec)
|
Add support for multiple inputs.
* Makefile.am (dist_sql_DATA): Add src/sql/upgrade-1.sql.
* bin/cuirass.in (show-help, %options, main): Remove the LOAD-PATH option that
was used afterwards as %GUIX-PACKAGE-PATH.
* bin/evaluate.in (absolutize, input-checkout, spec-source, spec-load-path,
spec-package-path, format-checkouts): New procedures.
(%not-colon): Remove variable.
(main): Take the load path, package path and PROC from the checkouts that
result from the inputs. Format the checkouts before sending them to the
procedure. Remove the LOAD-PATH argument.
* doc/cuirass.texi (Overview, Database schema): Document the changes.
* examples/{guix-jobs.scm, hello-git.scm, hello-singleton.scm,
hello-subset.scm, random.scm}: Adapt to the new specification format.
* examples/guix-track-git.scm (package->spec): Rename to PACKAGE->INPUT.
(package->git-tracked): Replace FETCH-REPOSITORY with FETCH-INPUT and handle
the new format of its return value.
* examples/random-jobs.scm (make-random-jobs): Rename RANDOM to CHECKOUT.
Rename the checkout from 'random (which is a specification) to 'cuirass (which
is a checkout resulting from an input).
* src/cuirass/base.scm (fetch-repository): Rename to fetch-input. Rename SPEC
to INPUT. Return a checkout object instead of returning two values.
(evaluate): Take a list of CHECKOUTS and COMMITS as arguments, instead of
SOURCE. Remove TOKENIZE and LOAD-PATH. Pass the CHECKOUTS instead of the
SOURCE to "evaluate". Remove %GUIX-PACKAGE-PATH. Build the EVAL object
instead of getting it from "evaluate".
(compile?, fetch-inputs, compile-checkouts): New procedures.
(process-specs): Fetch all inputs instead of only fetching one repository.
The result of that fetching operation is a list of CHECKOUTS whose COMMITS are
used as a STAMP.
(%guix-package-path, set-guix-package-path): Remove them.
* src/cuirass/database.scm (db-add-input, db-get-inputs): New procedures.
(db-add-specification, db-get-specifications): Adapt to the new specification
format. Add/get all inputs as well.
(db-add-evaluation): Rename REVISION to COMMITS. Store COMMITS as space
separated commit hashes.
(db-get-builds): Rename REPO_NAME to NAME.
(db-get-stamp): Rename COMMIT to STAMP. Return #f when there is no STAMP.
(db-add-stamp): Rename COMMIT to STAMP. Deal with DB-GET-STAMP's new return
value.
(db-get-evaluations): Rename REVISION to COMMITS. Tokenize COMMITS.
* src/cuirass/utils.scm (%non-blocking): Export it.
* src/schema.sql (Inputs): New table that refers to the Specifications table.
(Specifications): Move input related fields to the Inputs table. Rename
REPO_NAME to NAME. Rename ARGUMENTS to PROC_ARGS. Rename FILE to PROC_FILE.
Add LOAD_PATH_INPUTS, PACKAGE_PATH_INPUTS and PROC_INPUT fields that refer to
the Inputs table.
(Stamps): Rename REPO_NAME to NAME.
(Evaluations): Rename REPO_NAME to NAME. Rename REVISION to COMMITS.
(Specifications_index): Replace with Inputs_index.
* src/sql/upgrade-1.sql: New file.
* tests/database.scm (example-spec, make-dummy-eval, sqlite-exec): Adapt to
the new specifications format. Rename REVISION to COMMITS.
* tests/http.scm (evaluations-query-result, fill-db): Idem.
2018-06-26 11:18:23 +02:00
|
|
|
"Store SPEC in database DB. SPEC inputs are stored in the INPUTS table."
|
2018-02-08 17:31:39 +01:00
|
|
|
(sqlite-exec db "\
|
Add support for multiple inputs.
* Makefile.am (dist_sql_DATA): Add src/sql/upgrade-1.sql.
* bin/cuirass.in (show-help, %options, main): Remove the LOAD-PATH option that
was used afterwards as %GUIX-PACKAGE-PATH.
* bin/evaluate.in (absolutize, input-checkout, spec-source, spec-load-path,
spec-package-path, format-checkouts): New procedures.
(%not-colon): Remove variable.
(main): Take the load path, package path and PROC from the checkouts that
result from the inputs. Format the checkouts before sending them to the
procedure. Remove the LOAD-PATH argument.
* doc/cuirass.texi (Overview, Database schema): Document the changes.
* examples/{guix-jobs.scm, hello-git.scm, hello-singleton.scm,
hello-subset.scm, random.scm}: Adapt to the new specification format.
* examples/guix-track-git.scm (package->spec): Rename to PACKAGE->INPUT.
(package->git-tracked): Replace FETCH-REPOSITORY with FETCH-INPUT and handle
the new format of its return value.
* examples/random-jobs.scm (make-random-jobs): Rename RANDOM to CHECKOUT.
Rename the checkout from 'random (which is a specification) to 'cuirass (which
is a checkout resulting from an input).
* src/cuirass/base.scm (fetch-repository): Rename to fetch-input. Rename SPEC
to INPUT. Return a checkout object instead of returning two values.
(evaluate): Take a list of CHECKOUTS and COMMITS as arguments, instead of
SOURCE. Remove TOKENIZE and LOAD-PATH. Pass the CHECKOUTS instead of the
SOURCE to "evaluate". Remove %GUIX-PACKAGE-PATH. Build the EVAL object
instead of getting it from "evaluate".
(compile?, fetch-inputs, compile-checkouts): New procedures.
(process-specs): Fetch all inputs instead of only fetching one repository.
The result of that fetching operation is a list of CHECKOUTS whose COMMITS are
used as a STAMP.
(%guix-package-path, set-guix-package-path): Remove them.
* src/cuirass/database.scm (db-add-input, db-get-inputs): New procedures.
(db-add-specification, db-get-specifications): Adapt to the new specification
format. Add/get all inputs as well.
(db-add-evaluation): Rename REVISION to COMMITS. Store COMMITS as space
separated commit hashes.
(db-get-builds): Rename REPO_NAME to NAME.
(db-get-stamp): Rename COMMIT to STAMP. Return #f when there is no STAMP.
(db-add-stamp): Rename COMMIT to STAMP. Deal with DB-GET-STAMP's new return
value.
(db-get-evaluations): Rename REVISION to COMMITS. Tokenize COMMITS.
* src/cuirass/utils.scm (%non-blocking): Export it.
* src/schema.sql (Inputs): New table that refers to the Specifications table.
(Specifications): Move input related fields to the Inputs table. Rename
REPO_NAME to NAME. Rename ARGUMENTS to PROC_ARGS. Rename FILE to PROC_FILE.
Add LOAD_PATH_INPUTS, PACKAGE_PATH_INPUTS and PROC_INPUT fields that refer to
the Inputs table.
(Stamps): Rename REPO_NAME to NAME.
(Evaluations): Rename REPO_NAME to NAME. Rename REVISION to COMMITS.
(Specifications_index): Replace with Inputs_index.
* src/sql/upgrade-1.sql: New file.
* tests/database.scm (example-spec, make-dummy-eval, sqlite-exec): Adapt to
the new specifications format. Rename REVISION to COMMITS.
* tests/http.scm (evaluations-query-result, fill-db): Idem.
2018-06-26 11:18:23 +02:00
|
|
|
INSERT OR IGNORE INTO Specifications (name, load_path_inputs, \
|
|
|
|
package_path_inputs, proc_input, proc_file, proc, proc_args) \
|
2018-02-08 17:31:39 +01:00
|
|
|
VALUES ("
|
|
|
|
(assq-ref spec #:name) ", "
|
Add support for multiple inputs.
* Makefile.am (dist_sql_DATA): Add src/sql/upgrade-1.sql.
* bin/cuirass.in (show-help, %options, main): Remove the LOAD-PATH option that
was used afterwards as %GUIX-PACKAGE-PATH.
* bin/evaluate.in (absolutize, input-checkout, spec-source, spec-load-path,
spec-package-path, format-checkouts): New procedures.
(%not-colon): Remove variable.
(main): Take the load path, package path and PROC from the checkouts that
result from the inputs. Format the checkouts before sending them to the
procedure. Remove the LOAD-PATH argument.
* doc/cuirass.texi (Overview, Database schema): Document the changes.
* examples/{guix-jobs.scm, hello-git.scm, hello-singleton.scm,
hello-subset.scm, random.scm}: Adapt to the new specification format.
* examples/guix-track-git.scm (package->spec): Rename to PACKAGE->INPUT.
(package->git-tracked): Replace FETCH-REPOSITORY with FETCH-INPUT and handle
the new format of its return value.
* examples/random-jobs.scm (make-random-jobs): Rename RANDOM to CHECKOUT.
Rename the checkout from 'random (which is a specification) to 'cuirass (which
is a checkout resulting from an input).
* src/cuirass/base.scm (fetch-repository): Rename to fetch-input. Rename SPEC
to INPUT. Return a checkout object instead of returning two values.
(evaluate): Take a list of CHECKOUTS and COMMITS as arguments, instead of
SOURCE. Remove TOKENIZE and LOAD-PATH. Pass the CHECKOUTS instead of the
SOURCE to "evaluate". Remove %GUIX-PACKAGE-PATH. Build the EVAL object
instead of getting it from "evaluate".
(compile?, fetch-inputs, compile-checkouts): New procedures.
(process-specs): Fetch all inputs instead of only fetching one repository.
The result of that fetching operation is a list of CHECKOUTS whose COMMITS are
used as a STAMP.
(%guix-package-path, set-guix-package-path): Remove them.
* src/cuirass/database.scm (db-add-input, db-get-inputs): New procedures.
(db-add-specification, db-get-specifications): Adapt to the new specification
format. Add/get all inputs as well.
(db-add-evaluation): Rename REVISION to COMMITS. Store COMMITS as space
separated commit hashes.
(db-get-builds): Rename REPO_NAME to NAME.
(db-get-stamp): Rename COMMIT to STAMP. Return #f when there is no STAMP.
(db-add-stamp): Rename COMMIT to STAMP. Deal with DB-GET-STAMP's new return
value.
(db-get-evaluations): Rename REVISION to COMMITS. Tokenize COMMITS.
* src/cuirass/utils.scm (%non-blocking): Export it.
* src/schema.sql (Inputs): New table that refers to the Specifications table.
(Specifications): Move input related fields to the Inputs table. Rename
REPO_NAME to NAME. Rename ARGUMENTS to PROC_ARGS. Rename FILE to PROC_FILE.
Add LOAD_PATH_INPUTS, PACKAGE_PATH_INPUTS and PROC_INPUT fields that refer to
the Inputs table.
(Stamps): Rename REPO_NAME to NAME.
(Evaluations): Rename REPO_NAME to NAME. Rename REVISION to COMMITS.
(Specifications_index): Replace with Inputs_index.
* src/sql/upgrade-1.sql: New file.
* tests/database.scm (example-spec, make-dummy-eval, sqlite-exec): Adapt to
the new specifications format. Rename REVISION to COMMITS.
* tests/http.scm (evaluations-query-result, fill-db): Idem.
2018-06-26 11:18:23 +02:00
|
|
|
(assq-ref spec #:load-path-inputs) ", "
|
|
|
|
(assq-ref spec #:package-path-inputs)", "
|
|
|
|
(assq-ref spec #:proc-input) ", "
|
|
|
|
(assq-ref spec #:proc-file) ", "
|
2018-02-08 17:31:39 +01:00
|
|
|
(symbol->string (assq-ref spec #:proc)) ", "
|
Add support for multiple inputs.
* Makefile.am (dist_sql_DATA): Add src/sql/upgrade-1.sql.
* bin/cuirass.in (show-help, %options, main): Remove the LOAD-PATH option that
was used afterwards as %GUIX-PACKAGE-PATH.
* bin/evaluate.in (absolutize, input-checkout, spec-source, spec-load-path,
spec-package-path, format-checkouts): New procedures.
(%not-colon): Remove variable.
(main): Take the load path, package path and PROC from the checkouts that
result from the inputs. Format the checkouts before sending them to the
procedure. Remove the LOAD-PATH argument.
* doc/cuirass.texi (Overview, Database schema): Document the changes.
* examples/{guix-jobs.scm, hello-git.scm, hello-singleton.scm,
hello-subset.scm, random.scm}: Adapt to the new specification format.
* examples/guix-track-git.scm (package->spec): Rename to PACKAGE->INPUT.
(package->git-tracked): Replace FETCH-REPOSITORY with FETCH-INPUT and handle
the new format of its return value.
* examples/random-jobs.scm (make-random-jobs): Rename RANDOM to CHECKOUT.
Rename the checkout from 'random (which is a specification) to 'cuirass (which
is a checkout resulting from an input).
* src/cuirass/base.scm (fetch-repository): Rename to fetch-input. Rename SPEC
to INPUT. Return a checkout object instead of returning two values.
(evaluate): Take a list of CHECKOUTS and COMMITS as arguments, instead of
SOURCE. Remove TOKENIZE and LOAD-PATH. Pass the CHECKOUTS instead of the
SOURCE to "evaluate". Remove %GUIX-PACKAGE-PATH. Build the EVAL object
instead of getting it from "evaluate".
(compile?, fetch-inputs, compile-checkouts): New procedures.
(process-specs): Fetch all inputs instead of only fetching one repository.
The result of that fetching operation is a list of CHECKOUTS whose COMMITS are
used as a STAMP.
(%guix-package-path, set-guix-package-path): Remove them.
* src/cuirass/database.scm (db-add-input, db-get-inputs): New procedures.
(db-add-specification, db-get-specifications): Adapt to the new specification
format. Add/get all inputs as well.
(db-add-evaluation): Rename REVISION to COMMITS. Store COMMITS as space
separated commit hashes.
(db-get-builds): Rename REPO_NAME to NAME.
(db-get-stamp): Rename COMMIT to STAMP. Return #f when there is no STAMP.
(db-add-stamp): Rename COMMIT to STAMP. Deal with DB-GET-STAMP's new return
value.
(db-get-evaluations): Rename REVISION to COMMITS. Tokenize COMMITS.
* src/cuirass/utils.scm (%non-blocking): Export it.
* src/schema.sql (Inputs): New table that refers to the Specifications table.
(Specifications): Move input related fields to the Inputs table. Rename
REPO_NAME to NAME. Rename ARGUMENTS to PROC_ARGS. Rename FILE to PROC_FILE.
Add LOAD_PATH_INPUTS, PACKAGE_PATH_INPUTS and PROC_INPUT fields that refer to
the Inputs table.
(Stamps): Rename REPO_NAME to NAME.
(Evaluations): Rename REPO_NAME to NAME. Rename REVISION to COMMITS.
(Specifications_index): Replace with Inputs_index.
* src/sql/upgrade-1.sql: New file.
* tests/database.scm (example-spec, make-dummy-eval, sqlite-exec): Adapt to
the new specifications format. Rename REVISION to COMMITS.
* tests/http.scm (evaluations-query-result, fill-db): Idem.
2018-06-26 11:18:23 +02:00
|
|
|
(assq-ref spec #:proc-args) ");")
|
|
|
|
(let ((spec-id (last-insert-rowid db)))
|
|
|
|
(for-each (lambda (input)
|
|
|
|
(db-add-input db (assq-ref spec #:name) input))
|
|
|
|
(assq-ref spec #:inputs))
|
|
|
|
spec-id))
|
|
|
|
|
|
|
|
(define (db-get-inputs db spec-name)
|
|
|
|
(let loop ((rows (sqlite-exec db "SELECT * FROM Inputs WHERE specification="
|
|
|
|
spec-name ";"))
|
|
|
|
(inputs '()))
|
|
|
|
(match rows
|
|
|
|
(() inputs)
|
|
|
|
((#(specification name url load-path branch tag revision no-compile-p)
|
|
|
|
. rest)
|
|
|
|
(loop rest
|
|
|
|
(cons `((#:name . ,name)
|
|
|
|
(#:url . ,url)
|
|
|
|
(#:load-path . ,load-path)
|
|
|
|
(#:branch . ,branch)
|
|
|
|
(#:tag . ,tag)
|
|
|
|
(#:commit . ,revision)
|
|
|
|
(#:no-compile? . ,(positive? no-compile-p)))
|
|
|
|
inputs))))))
|
2016-07-23 17:00:38 +02:00
|
|
|
|
2016-07-23 22:05:50 +02:00
|
|
|
(define (db-get-specifications db)
|
|
|
|
(let loop ((rows (sqlite-exec db "SELECT * FROM Specifications;"))
|
|
|
|
(specs '()))
|
|
|
|
(match rows
|
|
|
|
(() specs)
|
Add support for multiple inputs.
* Makefile.am (dist_sql_DATA): Add src/sql/upgrade-1.sql.
* bin/cuirass.in (show-help, %options, main): Remove the LOAD-PATH option that
was used afterwards as %GUIX-PACKAGE-PATH.
* bin/evaluate.in (absolutize, input-checkout, spec-source, spec-load-path,
spec-package-path, format-checkouts): New procedures.
(%not-colon): Remove variable.
(main): Take the load path, package path and PROC from the checkouts that
result from the inputs. Format the checkouts before sending them to the
procedure. Remove the LOAD-PATH argument.
* doc/cuirass.texi (Overview, Database schema): Document the changes.
* examples/{guix-jobs.scm, hello-git.scm, hello-singleton.scm,
hello-subset.scm, random.scm}: Adapt to the new specification format.
* examples/guix-track-git.scm (package->spec): Rename to PACKAGE->INPUT.
(package->git-tracked): Replace FETCH-REPOSITORY with FETCH-INPUT and handle
the new format of its return value.
* examples/random-jobs.scm (make-random-jobs): Rename RANDOM to CHECKOUT.
Rename the checkout from 'random (which is a specification) to 'cuirass (which
is a checkout resulting from an input).
* src/cuirass/base.scm (fetch-repository): Rename to fetch-input. Rename SPEC
to INPUT. Return a checkout object instead of returning two values.
(evaluate): Take a list of CHECKOUTS and COMMITS as arguments, instead of
SOURCE. Remove TOKENIZE and LOAD-PATH. Pass the CHECKOUTS instead of the
SOURCE to "evaluate". Remove %GUIX-PACKAGE-PATH. Build the EVAL object
instead of getting it from "evaluate".
(compile?, fetch-inputs, compile-checkouts): New procedures.
(process-specs): Fetch all inputs instead of only fetching one repository.
The result of that fetching operation is a list of CHECKOUTS whose COMMITS are
used as a STAMP.
(%guix-package-path, set-guix-package-path): Remove them.
* src/cuirass/database.scm (db-add-input, db-get-inputs): New procedures.
(db-add-specification, db-get-specifications): Adapt to the new specification
format. Add/get all inputs as well.
(db-add-evaluation): Rename REVISION to COMMITS. Store COMMITS as space
separated commit hashes.
(db-get-builds): Rename REPO_NAME to NAME.
(db-get-stamp): Rename COMMIT to STAMP. Return #f when there is no STAMP.
(db-add-stamp): Rename COMMIT to STAMP. Deal with DB-GET-STAMP's new return
value.
(db-get-evaluations): Rename REVISION to COMMITS. Tokenize COMMITS.
* src/cuirass/utils.scm (%non-blocking): Export it.
* src/schema.sql (Inputs): New table that refers to the Specifications table.
(Specifications): Move input related fields to the Inputs table. Rename
REPO_NAME to NAME. Rename ARGUMENTS to PROC_ARGS. Rename FILE to PROC_FILE.
Add LOAD_PATH_INPUTS, PACKAGE_PATH_INPUTS and PROC_INPUT fields that refer to
the Inputs table.
(Stamps): Rename REPO_NAME to NAME.
(Evaluations): Rename REPO_NAME to NAME. Rename REVISION to COMMITS.
(Specifications_index): Replace with Inputs_index.
* src/sql/upgrade-1.sql: New file.
* tests/database.scm (example-spec, make-dummy-eval, sqlite-exec): Adapt to
the new specifications format. Rename REVISION to COMMITS.
* tests/http.scm (evaluations-query-result, fill-db): Idem.
2018-06-26 11:18:23 +02:00
|
|
|
((#(name load-path-inputs package-path-inputs proc-input proc-file proc
|
|
|
|
proc-args)
|
2016-09-15 23:15:54 +02:00
|
|
|
. rest)
|
2016-07-23 22:05:50 +02:00
|
|
|
(loop rest
|
2016-11-13 01:54:41 +01:00
|
|
|
(cons `((#:name . ,name)
|
Add support for multiple inputs.
* Makefile.am (dist_sql_DATA): Add src/sql/upgrade-1.sql.
* bin/cuirass.in (show-help, %options, main): Remove the LOAD-PATH option that
was used afterwards as %GUIX-PACKAGE-PATH.
* bin/evaluate.in (absolutize, input-checkout, spec-source, spec-load-path,
spec-package-path, format-checkouts): New procedures.
(%not-colon): Remove variable.
(main): Take the load path, package path and PROC from the checkouts that
result from the inputs. Format the checkouts before sending them to the
procedure. Remove the LOAD-PATH argument.
* doc/cuirass.texi (Overview, Database schema): Document the changes.
* examples/{guix-jobs.scm, hello-git.scm, hello-singleton.scm,
hello-subset.scm, random.scm}: Adapt to the new specification format.
* examples/guix-track-git.scm (package->spec): Rename to PACKAGE->INPUT.
(package->git-tracked): Replace FETCH-REPOSITORY with FETCH-INPUT and handle
the new format of its return value.
* examples/random-jobs.scm (make-random-jobs): Rename RANDOM to CHECKOUT.
Rename the checkout from 'random (which is a specification) to 'cuirass (which
is a checkout resulting from an input).
* src/cuirass/base.scm (fetch-repository): Rename to fetch-input. Rename SPEC
to INPUT. Return a checkout object instead of returning two values.
(evaluate): Take a list of CHECKOUTS and COMMITS as arguments, instead of
SOURCE. Remove TOKENIZE and LOAD-PATH. Pass the CHECKOUTS instead of the
SOURCE to "evaluate". Remove %GUIX-PACKAGE-PATH. Build the EVAL object
instead of getting it from "evaluate".
(compile?, fetch-inputs, compile-checkouts): New procedures.
(process-specs): Fetch all inputs instead of only fetching one repository.
The result of that fetching operation is a list of CHECKOUTS whose COMMITS are
used as a STAMP.
(%guix-package-path, set-guix-package-path): Remove them.
* src/cuirass/database.scm (db-add-input, db-get-inputs): New procedures.
(db-add-specification, db-get-specifications): Adapt to the new specification
format. Add/get all inputs as well.
(db-add-evaluation): Rename REVISION to COMMITS. Store COMMITS as space
separated commit hashes.
(db-get-builds): Rename REPO_NAME to NAME.
(db-get-stamp): Rename COMMIT to STAMP. Return #f when there is no STAMP.
(db-add-stamp): Rename COMMIT to STAMP. Deal with DB-GET-STAMP's new return
value.
(db-get-evaluations): Rename REVISION to COMMITS. Tokenize COMMITS.
* src/cuirass/utils.scm (%non-blocking): Export it.
* src/schema.sql (Inputs): New table that refers to the Specifications table.
(Specifications): Move input related fields to the Inputs table. Rename
REPO_NAME to NAME. Rename ARGUMENTS to PROC_ARGS. Rename FILE to PROC_FILE.
Add LOAD_PATH_INPUTS, PACKAGE_PATH_INPUTS and PROC_INPUT fields that refer to
the Inputs table.
(Stamps): Rename REPO_NAME to NAME.
(Evaluations): Rename REPO_NAME to NAME. Rename REVISION to COMMITS.
(Specifications_index): Replace with Inputs_index.
* src/sql/upgrade-1.sql: New file.
* tests/database.scm (example-spec, make-dummy-eval, sqlite-exec): Adapt to
the new specifications format. Rename REVISION to COMMITS.
* tests/http.scm (evaluations-query-result, fill-db): Idem.
2018-06-26 11:18:23 +02:00
|
|
|
(#:load-path-inputs .
|
|
|
|
,(with-input-from-string load-path-inputs read))
|
|
|
|
(#:package-path-inputs .
|
|
|
|
,(with-input-from-string package-path-inputs read))
|
|
|
|
(#:proc-input . ,proc-input)
|
|
|
|
(#:proc-file . ,proc-file)
|
2016-07-23 22:05:50 +02:00
|
|
|
(#:proc . ,(with-input-from-string proc read))
|
Add support for multiple inputs.
* Makefile.am (dist_sql_DATA): Add src/sql/upgrade-1.sql.
* bin/cuirass.in (show-help, %options, main): Remove the LOAD-PATH option that
was used afterwards as %GUIX-PACKAGE-PATH.
* bin/evaluate.in (absolutize, input-checkout, spec-source, spec-load-path,
spec-package-path, format-checkouts): New procedures.
(%not-colon): Remove variable.
(main): Take the load path, package path and PROC from the checkouts that
result from the inputs. Format the checkouts before sending them to the
procedure. Remove the LOAD-PATH argument.
* doc/cuirass.texi (Overview, Database schema): Document the changes.
* examples/{guix-jobs.scm, hello-git.scm, hello-singleton.scm,
hello-subset.scm, random.scm}: Adapt to the new specification format.
* examples/guix-track-git.scm (package->spec): Rename to PACKAGE->INPUT.
(package->git-tracked): Replace FETCH-REPOSITORY with FETCH-INPUT and handle
the new format of its return value.
* examples/random-jobs.scm (make-random-jobs): Rename RANDOM to CHECKOUT.
Rename the checkout from 'random (which is a specification) to 'cuirass (which
is a checkout resulting from an input).
* src/cuirass/base.scm (fetch-repository): Rename to fetch-input. Rename SPEC
to INPUT. Return a checkout object instead of returning two values.
(evaluate): Take a list of CHECKOUTS and COMMITS as arguments, instead of
SOURCE. Remove TOKENIZE and LOAD-PATH. Pass the CHECKOUTS instead of the
SOURCE to "evaluate". Remove %GUIX-PACKAGE-PATH. Build the EVAL object
instead of getting it from "evaluate".
(compile?, fetch-inputs, compile-checkouts): New procedures.
(process-specs): Fetch all inputs instead of only fetching one repository.
The result of that fetching operation is a list of CHECKOUTS whose COMMITS are
used as a STAMP.
(%guix-package-path, set-guix-package-path): Remove them.
* src/cuirass/database.scm (db-add-input, db-get-inputs): New procedures.
(db-add-specification, db-get-specifications): Adapt to the new specification
format. Add/get all inputs as well.
(db-add-evaluation): Rename REVISION to COMMITS. Store COMMITS as space
separated commit hashes.
(db-get-builds): Rename REPO_NAME to NAME.
(db-get-stamp): Rename COMMIT to STAMP. Return #f when there is no STAMP.
(db-add-stamp): Rename COMMIT to STAMP. Deal with DB-GET-STAMP's new return
value.
(db-get-evaluations): Rename REVISION to COMMITS. Tokenize COMMITS.
* src/cuirass/utils.scm (%non-blocking): Export it.
* src/schema.sql (Inputs): New table that refers to the Specifications table.
(Specifications): Move input related fields to the Inputs table. Rename
REPO_NAME to NAME. Rename ARGUMENTS to PROC_ARGS. Rename FILE to PROC_FILE.
Add LOAD_PATH_INPUTS, PACKAGE_PATH_INPUTS and PROC_INPUT fields that refer to
the Inputs table.
(Stamps): Rename REPO_NAME to NAME.
(Evaluations): Rename REPO_NAME to NAME. Rename REVISION to COMMITS.
(Specifications_index): Replace with Inputs_index.
* src/sql/upgrade-1.sql: New file.
* tests/database.scm (example-spec, make-dummy-eval, sqlite-exec): Adapt to
the new specifications format. Rename REVISION to COMMITS.
* tests/http.scm (evaluations-query-result, fill-db): Idem.
2018-06-26 11:18:23 +02:00
|
|
|
(#:proc-args . ,(with-input-from-string proc-args read))
|
|
|
|
(#:inputs . ,(db-get-inputs db name)))
|
2016-07-23 22:05:50 +02:00
|
|
|
specs))))))
|
|
|
|
|
2016-07-26 16:53:57 +02:00
|
|
|
(define (db-add-derivation db job)
|
2016-06-26 15:13:31 +02:00
|
|
|
"Store a derivation result in database DB and return its ID."
|
2018-02-14 16:40:50 +01:00
|
|
|
(catch 'sqlite-error
|
|
|
|
(lambda ()
|
|
|
|
(sqlite-exec db "\
|
database: Use 'sqlite-bind' to avoid SQL injection.
* src/cuirass/database.scm (%sqlite-exec): Remove.
(sqlite-exec): Turn back into a procedure. Use 'sqlite-bind'. Add
'normalize' procedure and use it.
(db-add-specification, db-add-derivation, db-get-derivation)
(db-add-evaluation, db-add-build, db-update-build-status!)
(db-get-build, db-get-stamp, db-add-stamp): Use question marks in SQL
queries.
* src/cuirass/base.scm (build-packages)[register]: Make #:log
non-false.
* tests/database.scm (make-dummy-job): Add #:job-name, #:system,
#:nix-name, and #:eval-id. This is necessary because 'sqlite-bind'
would now translate #f to a real NULL (before it would translate to the
string "#f"...), and would thus report violations of the non-NULL
constraint.
Co-authored-by: Ludovic Courtès <ludo@gnu.org>
2018-02-08 11:39:45 +01:00
|
|
|
INSERT INTO Derivations (derivation, job_name, system, nix_name, evaluation)\
|
2018-02-08 17:31:39 +01:00
|
|
|
VALUES ("
|
2018-02-14 16:40:50 +01:00
|
|
|
(assq-ref job #:derivation) ", "
|
|
|
|
(assq-ref job #:job-name) ", "
|
|
|
|
(assq-ref job #:system) ", "
|
|
|
|
(assq-ref job #:nix-name) ", "
|
|
|
|
(assq-ref job #:eval-id) ");")
|
|
|
|
(last-insert-rowid db))
|
|
|
|
(lambda (key who code message . rest)
|
|
|
|
;; If we get a unique-constraint-failed error, that means we have
|
|
|
|
;; already inserted the same (derivation,eval-id) tuple. That happens
|
|
|
|
;; when several jobs produce the same derivation, and we can ignore it.
|
|
|
|
(if (= code SQLITE_CONSTRAINT_PRIMARYKEY)
|
|
|
|
(sqlite-exec db "SELECT * FROM Derivations WHERE derivation="
|
|
|
|
(assq-ref job #:derivation) ";")
|
|
|
|
(apply throw key who code rest)))))
|
2016-06-26 15:13:31 +02:00
|
|
|
|
2016-07-26 16:53:57 +02:00
|
|
|
(define (db-get-derivation db id)
|
2016-06-26 15:13:31 +02:00
|
|
|
"Retrieve a job in database DB which corresponds to ID."
|
2018-02-08 17:31:39 +01:00
|
|
|
(car (sqlite-exec db "SELECT * FROM Derivations WHERE derivation=" id ";")))
|
2016-07-26 16:53:57 +02:00
|
|
|
|
2016-07-27 19:19:26 +02:00
|
|
|
(define (db-add-evaluation db eval)
|
|
|
|
(sqlite-exec db "\
|
Add support for multiple inputs.
* Makefile.am (dist_sql_DATA): Add src/sql/upgrade-1.sql.
* bin/cuirass.in (show-help, %options, main): Remove the LOAD-PATH option that
was used afterwards as %GUIX-PACKAGE-PATH.
* bin/evaluate.in (absolutize, input-checkout, spec-source, spec-load-path,
spec-package-path, format-checkouts): New procedures.
(%not-colon): Remove variable.
(main): Take the load path, package path and PROC from the checkouts that
result from the inputs. Format the checkouts before sending them to the
procedure. Remove the LOAD-PATH argument.
* doc/cuirass.texi (Overview, Database schema): Document the changes.
* examples/{guix-jobs.scm, hello-git.scm, hello-singleton.scm,
hello-subset.scm, random.scm}: Adapt to the new specification format.
* examples/guix-track-git.scm (package->spec): Rename to PACKAGE->INPUT.
(package->git-tracked): Replace FETCH-REPOSITORY with FETCH-INPUT and handle
the new format of its return value.
* examples/random-jobs.scm (make-random-jobs): Rename RANDOM to CHECKOUT.
Rename the checkout from 'random (which is a specification) to 'cuirass (which
is a checkout resulting from an input).
* src/cuirass/base.scm (fetch-repository): Rename to fetch-input. Rename SPEC
to INPUT. Return a checkout object instead of returning two values.
(evaluate): Take a list of CHECKOUTS and COMMITS as arguments, instead of
SOURCE. Remove TOKENIZE and LOAD-PATH. Pass the CHECKOUTS instead of the
SOURCE to "evaluate". Remove %GUIX-PACKAGE-PATH. Build the EVAL object
instead of getting it from "evaluate".
(compile?, fetch-inputs, compile-checkouts): New procedures.
(process-specs): Fetch all inputs instead of only fetching one repository.
The result of that fetching operation is a list of CHECKOUTS whose COMMITS are
used as a STAMP.
(%guix-package-path, set-guix-package-path): Remove them.
* src/cuirass/database.scm (db-add-input, db-get-inputs): New procedures.
(db-add-specification, db-get-specifications): Adapt to the new specification
format. Add/get all inputs as well.
(db-add-evaluation): Rename REVISION to COMMITS. Store COMMITS as space
separated commit hashes.
(db-get-builds): Rename REPO_NAME to NAME.
(db-get-stamp): Rename COMMIT to STAMP. Return #f when there is no STAMP.
(db-add-stamp): Rename COMMIT to STAMP. Deal with DB-GET-STAMP's new return
value.
(db-get-evaluations): Rename REVISION to COMMITS. Tokenize COMMITS.
* src/cuirass/utils.scm (%non-blocking): Export it.
* src/schema.sql (Inputs): New table that refers to the Specifications table.
(Specifications): Move input related fields to the Inputs table. Rename
REPO_NAME to NAME. Rename ARGUMENTS to PROC_ARGS. Rename FILE to PROC_FILE.
Add LOAD_PATH_INPUTS, PACKAGE_PATH_INPUTS and PROC_INPUT fields that refer to
the Inputs table.
(Stamps): Rename REPO_NAME to NAME.
(Evaluations): Rename REPO_NAME to NAME. Rename REVISION to COMMITS.
(Specifications_index): Replace with Inputs_index.
* src/sql/upgrade-1.sql: New file.
* tests/database.scm (example-spec, make-dummy-eval, sqlite-exec): Adapt to
the new specifications format. Rename REVISION to COMMITS.
* tests/http.scm (evaluations-query-result, fill-db): Idem.
2018-06-26 11:18:23 +02:00
|
|
|
INSERT INTO Evaluations (specification, commits) VALUES ("
|
2018-02-08 17:31:39 +01:00
|
|
|
(assq-ref eval #:specification) ", "
|
Add support for multiple inputs.
* Makefile.am (dist_sql_DATA): Add src/sql/upgrade-1.sql.
* bin/cuirass.in (show-help, %options, main): Remove the LOAD-PATH option that
was used afterwards as %GUIX-PACKAGE-PATH.
* bin/evaluate.in (absolutize, input-checkout, spec-source, spec-load-path,
spec-package-path, format-checkouts): New procedures.
(%not-colon): Remove variable.
(main): Take the load path, package path and PROC from the checkouts that
result from the inputs. Format the checkouts before sending them to the
procedure. Remove the LOAD-PATH argument.
* doc/cuirass.texi (Overview, Database schema): Document the changes.
* examples/{guix-jobs.scm, hello-git.scm, hello-singleton.scm,
hello-subset.scm, random.scm}: Adapt to the new specification format.
* examples/guix-track-git.scm (package->spec): Rename to PACKAGE->INPUT.
(package->git-tracked): Replace FETCH-REPOSITORY with FETCH-INPUT and handle
the new format of its return value.
* examples/random-jobs.scm (make-random-jobs): Rename RANDOM to CHECKOUT.
Rename the checkout from 'random (which is a specification) to 'cuirass (which
is a checkout resulting from an input).
* src/cuirass/base.scm (fetch-repository): Rename to fetch-input. Rename SPEC
to INPUT. Return a checkout object instead of returning two values.
(evaluate): Take a list of CHECKOUTS and COMMITS as arguments, instead of
SOURCE. Remove TOKENIZE and LOAD-PATH. Pass the CHECKOUTS instead of the
SOURCE to "evaluate". Remove %GUIX-PACKAGE-PATH. Build the EVAL object
instead of getting it from "evaluate".
(compile?, fetch-inputs, compile-checkouts): New procedures.
(process-specs): Fetch all inputs instead of only fetching one repository.
The result of that fetching operation is a list of CHECKOUTS whose COMMITS are
used as a STAMP.
(%guix-package-path, set-guix-package-path): Remove them.
* src/cuirass/database.scm (db-add-input, db-get-inputs): New procedures.
(db-add-specification, db-get-specifications): Adapt to the new specification
format. Add/get all inputs as well.
(db-add-evaluation): Rename REVISION to COMMITS. Store COMMITS as space
separated commit hashes.
(db-get-builds): Rename REPO_NAME to NAME.
(db-get-stamp): Rename COMMIT to STAMP. Return #f when there is no STAMP.
(db-add-stamp): Rename COMMIT to STAMP. Deal with DB-GET-STAMP's new return
value.
(db-get-evaluations): Rename REVISION to COMMITS. Tokenize COMMITS.
* src/cuirass/utils.scm (%non-blocking): Export it.
* src/schema.sql (Inputs): New table that refers to the Specifications table.
(Specifications): Move input related fields to the Inputs table. Rename
REPO_NAME to NAME. Rename ARGUMENTS to PROC_ARGS. Rename FILE to PROC_FILE.
Add LOAD_PATH_INPUTS, PACKAGE_PATH_INPUTS and PROC_INPUT fields that refer to
the Inputs table.
(Stamps): Rename REPO_NAME to NAME.
(Evaluations): Rename REPO_NAME to NAME. Rename REVISION to COMMITS.
(Specifications_index): Replace with Inputs_index.
* src/sql/upgrade-1.sql: New file.
* tests/database.scm (example-spec, make-dummy-eval, sqlite-exec): Adapt to
the new specifications format. Rename REVISION to COMMITS.
* tests/http.scm (evaluations-query-result, fill-db): Idem.
2018-06-26 11:18:23 +02:00
|
|
|
(string-join (assq-ref eval #:commits)) ");")
|
2016-07-26 16:53:57 +02:00
|
|
|
(last-insert-rowid db))
|
2016-06-26 15:13:31 +02:00
|
|
|
|
2016-06-26 18:40:31 +02:00
|
|
|
(define-syntax-rule (with-database db body ...)
|
|
|
|
"Run BODY with a connection to the database which is bound to DB in BODY."
|
2018-01-22 23:07:10 +01:00
|
|
|
;; XXX: We don't install an unwind handler to play well with delimited
|
|
|
|
;; continuations and fibers. But as a consequence, we leak DB when BODY
|
|
|
|
;; raises an exception.
|
2018-03-19 22:13:54 +01:00
|
|
|
(let ((db (db-open)))
|
|
|
|
(unwind-protect body ... (db-close db))))
|
2016-06-26 18:40:31 +02:00
|
|
|
|
2016-07-25 20:20:53 +02:00
|
|
|
(define* (read-quoted-string #:optional (port (current-input-port)))
|
2016-06-29 16:16:48 +02:00
|
|
|
"Read all of the characters out of PORT and return them as a SQL quoted
|
|
|
|
string."
|
|
|
|
(let loop ((chars '()))
|
|
|
|
(let ((char (read-char port)))
|
|
|
|
(cond ((eof-object? char) (list->string (reverse! chars)))
|
|
|
|
((char=? char #\') (loop (cons* char char chars)))
|
|
|
|
(else (loop (cons char chars)))))))
|
|
|
|
|
2017-08-26 10:42:40 +02:00
|
|
|
;; Extended error codes (see <sqlite3.h>).
|
|
|
|
;; XXX: This should be defined by (sqlite3).
|
|
|
|
(define SQLITE_CONSTRAINT 19)
|
|
|
|
(define SQLITE_CONSTRAINT_PRIMARYKEY
|
|
|
|
(logior SQLITE_CONSTRAINT (ash 6 8)))
|
2018-02-14 16:40:50 +01:00
|
|
|
(define SQLITE_CONSTRAINT_UNIQUE
|
|
|
|
(logior SQLITE_CONSTRAINT (ash 8 8)))
|
2017-08-26 10:42:40 +02:00
|
|
|
|
2018-01-23 17:37:08 +01:00
|
|
|
(define-enumeration build-status
|
2018-01-23 18:15:42 +01:00
|
|
|
;; Build status as expected by Hydra's API. Note: the negative values are
|
|
|
|
;; Cuirass' own extensions.
|
|
|
|
(scheduled -2)
|
|
|
|
(started -1)
|
2018-01-23 17:37:08 +01:00
|
|
|
(succeeded 0)
|
|
|
|
(failed 1)
|
|
|
|
(failed-dependency 2)
|
|
|
|
(failed-other 3)
|
2018-01-23 23:16:32 +01:00
|
|
|
(canceled 4))
|
2018-01-23 17:37:08 +01:00
|
|
|
|
2016-07-25 20:31:06 +02:00
|
|
|
(define (db-add-build db build)
|
2017-07-31 19:25:28 +02:00
|
|
|
"Store BUILD in database DB. BUILD eventual outputs are stored
|
|
|
|
in the OUTPUTS table."
|
|
|
|
(let* ((build-exec
|
|
|
|
(sqlite-exec db "\
|
|
|
|
INSERT INTO Builds (derivation, evaluation, log, status, timestamp, starttime, stoptime)\
|
2018-02-08 17:31:39 +01:00
|
|
|
VALUES ("
|
|
|
|
(assq-ref build #:derivation) ", "
|
|
|
|
(assq-ref build #:eval-id) ", "
|
|
|
|
(assq-ref build #:log) ", "
|
2018-01-23 18:15:42 +01:00
|
|
|
(or (assq-ref build #:status)
|
2018-02-08 17:31:39 +01:00
|
|
|
(build-status scheduled)) ", "
|
|
|
|
(or (assq-ref build #:timestamp) 0) ", "
|
|
|
|
(or (assq-ref build #:starttime) 0) ", "
|
|
|
|
(or (assq-ref build #:stoptime) 0) ");"))
|
2017-07-31 19:25:28 +02:00
|
|
|
(build-id (last-insert-rowid db)))
|
|
|
|
(for-each (lambda (output)
|
|
|
|
(match output
|
|
|
|
((name . path)
|
|
|
|
(sqlite-exec db "\
|
2018-02-08 17:31:39 +01:00
|
|
|
INSERT INTO Outputs (build, name, path) VALUES ("
|
|
|
|
build-id ", " name ", " path ");"))))
|
2017-07-31 19:25:28 +02:00
|
|
|
(assq-ref build #:outputs))
|
|
|
|
build-id))
|
2017-08-26 10:42:40 +02:00
|
|
|
|
2018-01-24 23:40:07 +01:00
|
|
|
(define* (db-update-build-status! db drv status #:key log-file)
|
2018-01-23 18:15:42 +01:00
|
|
|
"Update DB so that DRV's status is STATUS. This also updates the
|
2018-01-24 23:40:07 +01:00
|
|
|
'starttime' or 'stoptime' fields. If LOG-FILE is true, record it as the build
|
|
|
|
log file for DRV."
|
2018-01-23 18:15:42 +01:00
|
|
|
(define now
|
|
|
|
(time-second (current-time time-utc)))
|
|
|
|
|
|
|
|
(if (= status (build-status started))
|
2018-02-08 17:31:39 +01:00
|
|
|
(sqlite-exec db "UPDATE Builds SET starttime=" now ", status="
|
|
|
|
status "WHERE derivation=" drv ";")
|
2018-02-08 11:59:42 +01:00
|
|
|
|
|
|
|
;; Update only if we're switching to a different status; otherwise leave
|
|
|
|
;; things unchanged. This ensures that 'stoptime' remains valid and
|
|
|
|
;; doesn't change every time we mark DRV as 'succeeded' several times in
|
|
|
|
;; a row, for instance.
|
database: Use 'sqlite-bind' to avoid SQL injection.
* src/cuirass/database.scm (%sqlite-exec): Remove.
(sqlite-exec): Turn back into a procedure. Use 'sqlite-bind'. Add
'normalize' procedure and use it.
(db-add-specification, db-add-derivation, db-get-derivation)
(db-add-evaluation, db-add-build, db-update-build-status!)
(db-get-build, db-get-stamp, db-add-stamp): Use question marks in SQL
queries.
* src/cuirass/base.scm (build-packages)[register]: Make #:log
non-false.
* tests/database.scm (make-dummy-job): Add #:job-name, #:system,
#:nix-name, and #:eval-id. This is necessary because 'sqlite-bind'
would now translate #f to a real NULL (before it would translate to the
string "#f"...), and would thus report violations of the non-NULL
constraint.
Co-authored-by: Ludovic Courtès <ludo@gnu.org>
2018-02-08 11:39:45 +01:00
|
|
|
(if log-file
|
2018-02-08 17:31:39 +01:00
|
|
|
(sqlite-exec db "UPDATE Builds SET stoptime=" now
|
|
|
|
", status=" status ", log=" log-file
|
|
|
|
"WHERE derivation=" drv "AND status != " status ";")
|
|
|
|
(sqlite-exec db "UPDATE Builds SET stoptime=" now
|
|
|
|
", status=" status
|
|
|
|
"WHERE derivation=" drv " AND status != " status ";"))))
|
2018-01-23 18:15:42 +01:00
|
|
|
|
2017-07-31 19:25:28 +02:00
|
|
|
(define (db-get-outputs db build-id)
|
|
|
|
"Retrieve the OUTPUTS of the build identified by BUILD-ID in DB database."
|
|
|
|
(let loop ((rows
|
2018-02-08 17:31:39 +01:00
|
|
|
(sqlite-exec db "SELECT name, path FROM Outputs WHERE build="
|
|
|
|
build-id ";"))
|
2017-07-31 19:25:28 +02:00
|
|
|
(outputs '()))
|
|
|
|
(match rows
|
|
|
|
(() outputs)
|
|
|
|
((#(name path)
|
|
|
|
. rest)
|
|
|
|
(loop rest
|
|
|
|
(cons `(,name . ((#:path . ,path)))
|
|
|
|
outputs))))))
|
|
|
|
|
|
|
|
(define (db-format-build db build)
|
|
|
|
(match build
|
2017-07-31 19:27:28 +02:00
|
|
|
(#(id timestamp starttime stoptime log status derivation job-name system
|
2018-07-02 17:25:31 +02:00
|
|
|
nix-name repo-name)
|
2017-07-31 19:27:28 +02:00
|
|
|
`((#:id . ,id)
|
|
|
|
(#:timestamp . ,timestamp)
|
|
|
|
(#:starttime . ,starttime)
|
|
|
|
(#:stoptime . ,stoptime)
|
|
|
|
(#:log . ,log)
|
|
|
|
(#:status . ,status)
|
|
|
|
(#:derivation . ,derivation)
|
|
|
|
(#:job-name . ,job-name)
|
|
|
|
(#:system . ,system)
|
|
|
|
(#:nix-name . ,nix-name)
|
|
|
|
(#:repo-name . ,repo-name)
|
2018-07-02 17:25:31 +02:00
|
|
|
(#:outputs . ,(db-get-outputs db id))))))
|
2017-07-31 19:25:28 +02:00
|
|
|
|
|
|
|
(define (db-get-builds db filters)
|
|
|
|
"Retrieve all builds in database DB which are matched by given FILTERS.
|
Add a web interface.
* Makefile.am (dist_sql_DATA): Add static files.
* src/cuirass/database.scm (assqx-ref): Export it.
(db-get-builds): Add 'evaluation' filter and filters for pagination.
(db-get-evaluations-build-summary, db-get-evaluations-id-min,
db-get-evaluations-id-max, db-get-builds-min, db-get-builds-max): New exported
procedures.
* src/cuirass/http.scm (%static-directory): New parameter.
(%page-size, %file-mime-types, %file-white-list): New variables.
(handle-build-request, handle-builds-request): Move the WITH-CRITICAL-SECTION
call out.
(url-handler): Add RESPOND-HTML, RESPOND-STATIC-FILE and RESPOND-NOT-FOUND
procedures. Call WITH-CRITICAL-SECTION sooner for the '/build',
'/api/latestbuilds' and '/api/queue' routes. Add '/', '/jobset/<name>',
'/eval/<id>', '/static/<path>' routes. Use RESPOND-NOT-FOUND when the route
isn't found.
* src/cuirass/templates.scm: New file.
(html-page, specifications-table, evaluation-info-table,
build-eval-table): New exported procedures.
(pagination): New procedure.
Signed-off-by: Clément Lassieur <clement@lassieur.org>
2018-07-21 15:39:10 +02:00
|
|
|
FILTERS is an assoc list whose possible keys are 'id | 'jobset | 'job |
|
|
|
|
'system | 'nr | 'order | 'status | 'evaluation."
|
2018-02-19 22:20:23 +01:00
|
|
|
|
|
|
|
(define (format-output name path)
|
2018-03-01 15:49:30 +01:00
|
|
|
`(,name . ((#:path . ,path))))
|
2018-02-19 22:20:23 +01:00
|
|
|
|
|
|
|
(define (cons-output name path rest)
|
|
|
|
"If NAME and PATH are both not #f, cons them to REST.
|
|
|
|
Otherwise return REST unchanged."
|
|
|
|
(if (and (not name) (not path))
|
|
|
|
rest
|
|
|
|
(cons (format-output name path) rest)))
|
|
|
|
|
|
|
|
(define (collect-outputs repeated-builds-id repeated-row outputs rows)
|
|
|
|
"Given rows somewhat like
|
|
|
|
1 'a 'b 2 'x
|
|
|
|
^ 'c 'd 2 'x
|
|
|
|
| ^^^^^ ^^^^
|
|
|
|
| group ++++- group headers
|
|
|
|
| detail
|
|
|
|
+------------ group id
|
|
|
|
|
|
|
|
return rows somewhat like
|
|
|
|
|
|
|
|
1 2 'x '((a b) (c d))
|
|
|
|
|
|
|
|
.
|
|
|
|
|
|
|
|
As a special case, if the group detail is #f #f, ignore it.
|
|
|
|
This is made specifically to support LEFT JOINs.
|
|
|
|
|
|
|
|
Assumes that if group id stays the same the group headers stay the same."
|
|
|
|
(define (finish-group)
|
|
|
|
(match repeated-row
|
2018-03-01 15:49:30 +01:00
|
|
|
(#(timestamp starttime stoptime log status derivation job-name system
|
2018-07-02 17:25:31 +02:00
|
|
|
nix-name repo-name)
|
2018-03-01 15:49:30 +01:00
|
|
|
`((#:id . ,repeated-builds-id)
|
|
|
|
(#:timestamp . ,timestamp)
|
|
|
|
(#:starttime . ,starttime)
|
|
|
|
(#:stoptime . ,stoptime)
|
|
|
|
(#:log . ,log)
|
|
|
|
(#:status . ,status)
|
|
|
|
(#:derivation . ,derivation)
|
|
|
|
(#:job-name . ,job-name)
|
|
|
|
(#:system . ,system)
|
|
|
|
(#:nix-name . ,nix-name)
|
|
|
|
(#:repo-name . ,repo-name)
|
2018-07-02 17:25:31 +02:00
|
|
|
(#:outputs . ,outputs)))))
|
2018-02-19 22:20:23 +01:00
|
|
|
|
|
|
|
(define (same-group? builds-id)
|
|
|
|
(= builds-id repeated-builds-id))
|
|
|
|
|
|
|
|
(match rows
|
2018-03-01 15:49:30 +01:00
|
|
|
(() (list (finish-group)))
|
|
|
|
((#((? same-group? x-builds-id) x-output-name x-output-path other-cells ...) . rest)
|
|
|
|
;; Accumulate group members of current group.
|
|
|
|
(let ((outputs (cons-output x-output-name x-output-path outputs)))
|
|
|
|
(collect-outputs repeated-builds-id repeated-row outputs rest)))
|
|
|
|
((#(x-builds-id x-output-name x-output-path other-cells ...) . rest)
|
|
|
|
(cons (finish-group) ;finish current group
|
|
|
|
|
|
|
|
;; Start new group.
|
|
|
|
(let* ((outputs (cons-output x-output-name x-output-path '()))
|
|
|
|
(x-repeated-row (list->vector other-cells)))
|
|
|
|
(collect-outputs x-builds-id x-repeated-row outputs rest))))))
|
2018-02-19 22:20:23 +01:00
|
|
|
|
|
|
|
(define (group-outputs rows)
|
|
|
|
(match rows
|
2018-03-01 15:49:30 +01:00
|
|
|
(() '())
|
|
|
|
((#(x-builds-id x-output-name x-output-path other-cells ...) . rest)
|
|
|
|
(let ((x-repeated-row (list->vector other-cells)))
|
|
|
|
(collect-outputs x-builds-id x-repeated-row '() rows)))))
|
2018-02-19 22:20:23 +01:00
|
|
|
|
2018-03-29 15:30:57 +02:00
|
|
|
(let* ((order (match (assq 'order filters)
|
2018-07-20 10:50:48 +02:00
|
|
|
(('order . 'build-id) "id ASC")
|
|
|
|
(('order . 'decreasing-build-id) "id DESC")
|
|
|
|
(('order . 'finish-time) "stoptime DESC")
|
|
|
|
(('order . 'finish-time+build-id) "stoptime DESC, id DESC")
|
|
|
|
(('order . 'start-time) "starttime DESC")
|
|
|
|
(('order . 'submission-time) "timestamp DESC")
|
|
|
|
(('order . 'status+submission-time)
|
2018-03-29 15:30:57 +02:00
|
|
|
;; With this order, builds in 'running' state (-1) appear
|
|
|
|
;; before those in 'scheduled' state (-2).
|
Add a web interface.
* Makefile.am (dist_sql_DATA): Add static files.
* src/cuirass/database.scm (assqx-ref): Export it.
(db-get-builds): Add 'evaluation' filter and filters for pagination.
(db-get-evaluations-build-summary, db-get-evaluations-id-min,
db-get-evaluations-id-max, db-get-builds-min, db-get-builds-max): New exported
procedures.
* src/cuirass/http.scm (%static-directory): New parameter.
(%page-size, %file-mime-types, %file-white-list): New variables.
(handle-build-request, handle-builds-request): Move the WITH-CRITICAL-SECTION
call out.
(url-handler): Add RESPOND-HTML, RESPOND-STATIC-FILE and RESPOND-NOT-FOUND
procedures. Call WITH-CRITICAL-SECTION sooner for the '/build',
'/api/latestbuilds' and '/api/queue' routes. Add '/', '/jobset/<name>',
'/eval/<id>', '/static/<path>' routes. Use RESPOND-NOT-FOUND when the route
isn't found.
* src/cuirass/templates.scm: New file.
(html-page, specifications-table, evaluation-info-table,
build-eval-table): New exported procedures.
(pagination): New procedure.
Signed-off-by: Clément Lassieur <clement@lassieur.org>
2018-07-21 15:39:10 +02:00
|
|
|
"status DESC, timestamp DESC")
|
|
|
|
(_ "id DESC")))
|
|
|
|
(stmt-text (format #f "SELECT * FROM (
|
|
|
|
SELECT Builds.id, Outputs.name, Outputs.path, Builds.timestamp,
|
|
|
|
Builds.starttime, Builds.stoptime, Builds.log, Builds.status,
|
|
|
|
Builds.derivation, Derivations.job_name, Derivations.system,
|
|
|
|
Derivations.nix_name,Specifications.name
|
|
|
|
FROM Builds
|
|
|
|
INNER JOIN Derivations ON Builds.derivation = Derivations.derivation
|
|
|
|
AND Builds.evaluation = Derivations.evaluation
|
|
|
|
INNER JOIN Evaluations ON Derivations.evaluation = Evaluations.id
|
|
|
|
INNER JOIN Specifications ON Evaluations.specification = Specifications.name
|
|
|
|
LEFT JOIN Outputs ON Outputs.build = Builds.id
|
|
|
|
WHERE (:id IS NULL OR (:id = Builds.id))
|
|
|
|
AND (:jobset IS NULL OR (:jobset = Specifications.name))
|
|
|
|
AND (:job IS NULL OR (:job = Derivations.job_name))
|
|
|
|
AND (:system IS NULL OR (:system = Derivations.system))
|
|
|
|
AND (:evaluation IS NULL OR (:evaluation = Builds.evaluation))
|
2018-08-04 16:07:31 +02:00
|
|
|
AND (:status IS NULL OR (:status = 'done' AND Builds.status >= 0)
|
|
|
|
OR (:status = 'pending' AND Builds.status < 0))
|
|
|
|
AND (:borderlowtime IS NULL OR :borderlowid IS NULL
|
|
|
|
OR ((:borderlowtime, :borderlowid) < (Builds.stoptime, Builds.id)))
|
|
|
|
AND (:borderhightime IS NULL OR :borderhighid IS NULL
|
|
|
|
OR ((:borderhightime, :borderhighid) > (Builds.stoptime, Builds.id)))
|
Add a web interface.
* Makefile.am (dist_sql_DATA): Add static files.
* src/cuirass/database.scm (assqx-ref): Export it.
(db-get-builds): Add 'evaluation' filter and filters for pagination.
(db-get-evaluations-build-summary, db-get-evaluations-id-min,
db-get-evaluations-id-max, db-get-builds-min, db-get-builds-max): New exported
procedures.
* src/cuirass/http.scm (%static-directory): New parameter.
(%page-size, %file-mime-types, %file-white-list): New variables.
(handle-build-request, handle-builds-request): Move the WITH-CRITICAL-SECTION
call out.
(url-handler): Add RESPOND-HTML, RESPOND-STATIC-FILE and RESPOND-NOT-FOUND
procedures. Call WITH-CRITICAL-SECTION sooner for the '/build',
'/api/latestbuilds' and '/api/queue' routes. Add '/', '/jobset/<name>',
'/eval/<id>', '/static/<path>' routes. Use RESPOND-NOT-FOUND when the route
isn't found.
* src/cuirass/templates.scm: New file.
(html-page, specifications-table, evaluation-info-table,
build-eval-table): New exported procedures.
(pagination): New procedure.
Signed-off-by: Clément Lassieur <clement@lassieur.org>
2018-07-21 15:39:10 +02:00
|
|
|
ORDER BY
|
2018-08-04 16:07:31 +02:00
|
|
|
CASE WHEN :borderlowtime IS NULL
|
|
|
|
OR :borderlowid IS NULL THEN Builds.stoptime
|
|
|
|
ELSE -Builds.stoptime
|
|
|
|
END DESC,
|
|
|
|
CASE WHEN :borderlowtime IS NULL
|
|
|
|
OR :borderlowid IS NULL THEN Builds.id
|
|
|
|
ELSE -Builds.id
|
|
|
|
END DESC
|
Add a web interface.
* Makefile.am (dist_sql_DATA): Add static files.
* src/cuirass/database.scm (assqx-ref): Export it.
(db-get-builds): Add 'evaluation' filter and filters for pagination.
(db-get-evaluations-build-summary, db-get-evaluations-id-min,
db-get-evaluations-id-max, db-get-builds-min, db-get-builds-max): New exported
procedures.
* src/cuirass/http.scm (%static-directory): New parameter.
(%page-size, %file-mime-types, %file-white-list): New variables.
(handle-build-request, handle-builds-request): Move the WITH-CRITICAL-SECTION
call out.
(url-handler): Add RESPOND-HTML, RESPOND-STATIC-FILE and RESPOND-NOT-FOUND
procedures. Call WITH-CRITICAL-SECTION sooner for the '/build',
'/api/latestbuilds' and '/api/queue' routes. Add '/', '/jobset/<name>',
'/eval/<id>', '/static/<path>' routes. Use RESPOND-NOT-FOUND when the route
isn't found.
* src/cuirass/templates.scm: New file.
(html-page, specifications-table, evaluation-info-table,
build-eval-table): New exported procedures.
(pagination): New procedure.
Signed-off-by: Clément Lassieur <clement@lassieur.org>
2018-07-21 15:39:10 +02:00
|
|
|
LIMIT :nr)
|
|
|
|
ORDER BY ~a, id ASC;" order))
|
2018-02-19 16:30:07 +01:00
|
|
|
(stmt (sqlite-prepare db stmt-text #:cache? #t)))
|
Add a web interface.
* Makefile.am (dist_sql_DATA): Add static files.
* src/cuirass/database.scm (assqx-ref): Export it.
(db-get-builds): Add 'evaluation' filter and filters for pagination.
(db-get-evaluations-build-summary, db-get-evaluations-id-min,
db-get-evaluations-id-max, db-get-builds-min, db-get-builds-max): New exported
procedures.
* src/cuirass/http.scm (%static-directory): New parameter.
(%page-size, %file-mime-types, %file-white-list): New variables.
(handle-build-request, handle-builds-request): Move the WITH-CRITICAL-SECTION
call out.
(url-handler): Add RESPOND-HTML, RESPOND-STATIC-FILE and RESPOND-NOT-FOUND
procedures. Call WITH-CRITICAL-SECTION sooner for the '/build',
'/api/latestbuilds' and '/api/queue' routes. Add '/', '/jobset/<name>',
'/eval/<id>', '/static/<path>' routes. Use RESPOND-NOT-FOUND when the route
isn't found.
* src/cuirass/templates.scm: New file.
(html-page, specifications-table, evaluation-info-table,
build-eval-table): New exported procedures.
(pagination): New procedure.
Signed-off-by: Clément Lassieur <clement@lassieur.org>
2018-07-21 15:39:10 +02:00
|
|
|
(sqlite-bind-arguments
|
|
|
|
stmt
|
2018-07-20 10:50:48 +02:00
|
|
|
#:id (assq-ref filters 'id)
|
|
|
|
#:jobset (assq-ref filters 'jobset)
|
|
|
|
#:job (assq-ref filters 'job)
|
|
|
|
#:evaluation (assq-ref filters 'evaluation)
|
|
|
|
#:system (assq-ref filters 'system)
|
|
|
|
#:status (and=> (assq-ref filters 'status) object->string)
|
|
|
|
#:borderlowid (assq-ref filters 'border-low-id)
|
|
|
|
#:borderhighid (assq-ref filters 'border-high-id)
|
|
|
|
#:borderlowtime (assq-ref filters 'border-low-time)
|
|
|
|
#:borderhightime (assq-ref filters 'border-high-time)
|
|
|
|
#:nr (match (assq-ref filters 'nr)
|
Add a web interface.
* Makefile.am (dist_sql_DATA): Add static files.
* src/cuirass/database.scm (assqx-ref): Export it.
(db-get-builds): Add 'evaluation' filter and filters for pagination.
(db-get-evaluations-build-summary, db-get-evaluations-id-min,
db-get-evaluations-id-max, db-get-builds-min, db-get-builds-max): New exported
procedures.
* src/cuirass/http.scm (%static-directory): New parameter.
(%page-size, %file-mime-types, %file-white-list): New variables.
(handle-build-request, handle-builds-request): Move the WITH-CRITICAL-SECTION
call out.
(url-handler): Add RESPOND-HTML, RESPOND-STATIC-FILE and RESPOND-NOT-FOUND
procedures. Call WITH-CRITICAL-SECTION sooner for the '/build',
'/api/latestbuilds' and '/api/queue' routes. Add '/', '/jobset/<name>',
'/eval/<id>', '/static/<path>' routes. Use RESPOND-NOT-FOUND when the route
isn't found.
* src/cuirass/templates.scm: New file.
(html-page, specifications-table, evaluation-info-table,
build-eval-table): New exported procedures.
(pagination): New procedure.
Signed-off-by: Clément Lassieur <clement@lassieur.org>
2018-07-21 15:39:10 +02:00
|
|
|
(#f -1)
|
|
|
|
(x x)))
|
2018-02-19 22:20:23 +01:00
|
|
|
(sqlite-reset stmt)
|
|
|
|
(group-outputs (sqlite-fold-right cons '() stmt))))
|
2018-02-19 16:30:07 +01:00
|
|
|
|
|
|
|
(define (db-get-build db id)
|
|
|
|
"Retrieve a build in database DB which corresponds to ID."
|
2018-07-20 10:50:48 +02:00
|
|
|
(match (db-get-builds db `((id . ,id)))
|
2018-02-19 16:30:07 +01:00
|
|
|
((build)
|
|
|
|
build)
|
|
|
|
(() #f)))
|
2016-07-26 00:36:12 +02:00
|
|
|
|
2018-04-05 22:15:20 +02:00
|
|
|
(define (db-get-pending-derivations db)
|
|
|
|
"Return the list of derivation file names corresponding to pending builds in
|
|
|
|
DB. The returned list is guaranteed to not have any duplicates."
|
|
|
|
;; This is of course much more efficient than calling 'delete-duplicates' on
|
|
|
|
;; a list of results obtained without DISTINCT, both in space and time.
|
|
|
|
;;
|
|
|
|
;; Here we use a subquery so that sqlite can use two indexes instead of
|
|
|
|
;; creating a "TEMP B-TREE" when doing a single flat query, as "EXPLAIN
|
|
|
|
;; QUERY PLAN" shows.
|
|
|
|
(map (match-lambda (#(drv) drv))
|
|
|
|
(sqlite-exec db "
|
|
|
|
SELECT DISTINCT derivation FROM (
|
|
|
|
SELECT Derivations.derivation FROM Derivations INNER JOIN Builds
|
|
|
|
WHERE Derivations.derivation = Builds.derivation AND Builds.status < 0
|
|
|
|
);")))
|
|
|
|
|
2016-07-26 00:36:12 +02:00
|
|
|
(define (db-get-stamp db spec)
|
|
|
|
"Return a stamp corresponding to specification SPEC in database DB."
|
2018-02-08 17:31:39 +01:00
|
|
|
(let ((res (sqlite-exec db "SELECT * FROM Stamps WHERE specification="
|
|
|
|
(assq-ref spec #:name) ";")))
|
2016-07-26 00:36:12 +02:00
|
|
|
(match res
|
Add support for multiple inputs.
* Makefile.am (dist_sql_DATA): Add src/sql/upgrade-1.sql.
* bin/cuirass.in (show-help, %options, main): Remove the LOAD-PATH option that
was used afterwards as %GUIX-PACKAGE-PATH.
* bin/evaluate.in (absolutize, input-checkout, spec-source, spec-load-path,
spec-package-path, format-checkouts): New procedures.
(%not-colon): Remove variable.
(main): Take the load path, package path and PROC from the checkouts that
result from the inputs. Format the checkouts before sending them to the
procedure. Remove the LOAD-PATH argument.
* doc/cuirass.texi (Overview, Database schema): Document the changes.
* examples/{guix-jobs.scm, hello-git.scm, hello-singleton.scm,
hello-subset.scm, random.scm}: Adapt to the new specification format.
* examples/guix-track-git.scm (package->spec): Rename to PACKAGE->INPUT.
(package->git-tracked): Replace FETCH-REPOSITORY with FETCH-INPUT and handle
the new format of its return value.
* examples/random-jobs.scm (make-random-jobs): Rename RANDOM to CHECKOUT.
Rename the checkout from 'random (which is a specification) to 'cuirass (which
is a checkout resulting from an input).
* src/cuirass/base.scm (fetch-repository): Rename to fetch-input. Rename SPEC
to INPUT. Return a checkout object instead of returning two values.
(evaluate): Take a list of CHECKOUTS and COMMITS as arguments, instead of
SOURCE. Remove TOKENIZE and LOAD-PATH. Pass the CHECKOUTS instead of the
SOURCE to "evaluate". Remove %GUIX-PACKAGE-PATH. Build the EVAL object
instead of getting it from "evaluate".
(compile?, fetch-inputs, compile-checkouts): New procedures.
(process-specs): Fetch all inputs instead of only fetching one repository.
The result of that fetching operation is a list of CHECKOUTS whose COMMITS are
used as a STAMP.
(%guix-package-path, set-guix-package-path): Remove them.
* src/cuirass/database.scm (db-add-input, db-get-inputs): New procedures.
(db-add-specification, db-get-specifications): Adapt to the new specification
format. Add/get all inputs as well.
(db-add-evaluation): Rename REVISION to COMMITS. Store COMMITS as space
separated commit hashes.
(db-get-builds): Rename REPO_NAME to NAME.
(db-get-stamp): Rename COMMIT to STAMP. Return #f when there is no STAMP.
(db-add-stamp): Rename COMMIT to STAMP. Deal with DB-GET-STAMP's new return
value.
(db-get-evaluations): Rename REVISION to COMMITS. Tokenize COMMITS.
* src/cuirass/utils.scm (%non-blocking): Export it.
* src/schema.sql (Inputs): New table that refers to the Specifications table.
(Specifications): Move input related fields to the Inputs table. Rename
REPO_NAME to NAME. Rename ARGUMENTS to PROC_ARGS. Rename FILE to PROC_FILE.
Add LOAD_PATH_INPUTS, PACKAGE_PATH_INPUTS and PROC_INPUT fields that refer to
the Inputs table.
(Stamps): Rename REPO_NAME to NAME.
(Evaluations): Rename REPO_NAME to NAME. Rename REVISION to COMMITS.
(Specifications_index): Replace with Inputs_index.
* src/sql/upgrade-1.sql: New file.
* tests/database.scm (example-spec, make-dummy-eval, sqlite-exec): Adapt to
the new specifications format. Rename REVISION to COMMITS.
* tests/http.scm (evaluations-query-result, fill-db): Idem.
2018-06-26 11:18:23 +02:00
|
|
|
(() #f)
|
|
|
|
((#(spec stamp)) stamp))))
|
|
|
|
|
|
|
|
(define (db-add-stamp db spec stamp)
|
|
|
|
"Associate STAMP to specification SPEC in database DB."
|
|
|
|
(if (db-get-stamp db spec)
|
|
|
|
(sqlite-exec db "UPDATE Stamps SET stamp=" stamp
|
|
|
|
"WHERE specification=" (assq-ref spec #:name) ";")
|
2016-07-26 00:36:12 +02:00
|
|
|
(sqlite-exec db "\
|
2018-02-08 17:31:39 +01:00
|
|
|
INSERT INTO Stamps (specification, stamp) VALUES ("
|
Add support for multiple inputs.
* Makefile.am (dist_sql_DATA): Add src/sql/upgrade-1.sql.
* bin/cuirass.in (show-help, %options, main): Remove the LOAD-PATH option that
was used afterwards as %GUIX-PACKAGE-PATH.
* bin/evaluate.in (absolutize, input-checkout, spec-source, spec-load-path,
spec-package-path, format-checkouts): New procedures.
(%not-colon): Remove variable.
(main): Take the load path, package path and PROC from the checkouts that
result from the inputs. Format the checkouts before sending them to the
procedure. Remove the LOAD-PATH argument.
* doc/cuirass.texi (Overview, Database schema): Document the changes.
* examples/{guix-jobs.scm, hello-git.scm, hello-singleton.scm,
hello-subset.scm, random.scm}: Adapt to the new specification format.
* examples/guix-track-git.scm (package->spec): Rename to PACKAGE->INPUT.
(package->git-tracked): Replace FETCH-REPOSITORY with FETCH-INPUT and handle
the new format of its return value.
* examples/random-jobs.scm (make-random-jobs): Rename RANDOM to CHECKOUT.
Rename the checkout from 'random (which is a specification) to 'cuirass (which
is a checkout resulting from an input).
* src/cuirass/base.scm (fetch-repository): Rename to fetch-input. Rename SPEC
to INPUT. Return a checkout object instead of returning two values.
(evaluate): Take a list of CHECKOUTS and COMMITS as arguments, instead of
SOURCE. Remove TOKENIZE and LOAD-PATH. Pass the CHECKOUTS instead of the
SOURCE to "evaluate". Remove %GUIX-PACKAGE-PATH. Build the EVAL object
instead of getting it from "evaluate".
(compile?, fetch-inputs, compile-checkouts): New procedures.
(process-specs): Fetch all inputs instead of only fetching one repository.
The result of that fetching operation is a list of CHECKOUTS whose COMMITS are
used as a STAMP.
(%guix-package-path, set-guix-package-path): Remove them.
* src/cuirass/database.scm (db-add-input, db-get-inputs): New procedures.
(db-add-specification, db-get-specifications): Adapt to the new specification
format. Add/get all inputs as well.
(db-add-evaluation): Rename REVISION to COMMITS. Store COMMITS as space
separated commit hashes.
(db-get-builds): Rename REPO_NAME to NAME.
(db-get-stamp): Rename COMMIT to STAMP. Return #f when there is no STAMP.
(db-add-stamp): Rename COMMIT to STAMP. Deal with DB-GET-STAMP's new return
value.
(db-get-evaluations): Rename REVISION to COMMITS. Tokenize COMMITS.
* src/cuirass/utils.scm (%non-blocking): Export it.
* src/schema.sql (Inputs): New table that refers to the Specifications table.
(Specifications): Move input related fields to the Inputs table. Rename
REPO_NAME to NAME. Rename ARGUMENTS to PROC_ARGS. Rename FILE to PROC_FILE.
Add LOAD_PATH_INPUTS, PACKAGE_PATH_INPUTS and PROC_INPUT fields that refer to
the Inputs table.
(Stamps): Rename REPO_NAME to NAME.
(Evaluations): Rename REPO_NAME to NAME. Rename REVISION to COMMITS.
(Specifications_index): Replace with Inputs_index.
* src/sql/upgrade-1.sql: New file.
* tests/database.scm (example-spec, make-dummy-eval, sqlite-exec): Adapt to
the new specifications format. Rename REVISION to COMMITS.
* tests/http.scm (evaluations-query-result, fill-db): Idem.
2018-06-26 11:18:23 +02:00
|
|
|
(assq-ref spec #:name) ", " stamp ");")))
|
2018-04-19 11:17:42 +02:00
|
|
|
|
|
|
|
(define (db-get-evaluations db limit)
|
Add support for multiple inputs.
* Makefile.am (dist_sql_DATA): Add src/sql/upgrade-1.sql.
* bin/cuirass.in (show-help, %options, main): Remove the LOAD-PATH option that
was used afterwards as %GUIX-PACKAGE-PATH.
* bin/evaluate.in (absolutize, input-checkout, spec-source, spec-load-path,
spec-package-path, format-checkouts): New procedures.
(%not-colon): Remove variable.
(main): Take the load path, package path and PROC from the checkouts that
result from the inputs. Format the checkouts before sending them to the
procedure. Remove the LOAD-PATH argument.
* doc/cuirass.texi (Overview, Database schema): Document the changes.
* examples/{guix-jobs.scm, hello-git.scm, hello-singleton.scm,
hello-subset.scm, random.scm}: Adapt to the new specification format.
* examples/guix-track-git.scm (package->spec): Rename to PACKAGE->INPUT.
(package->git-tracked): Replace FETCH-REPOSITORY with FETCH-INPUT and handle
the new format of its return value.
* examples/random-jobs.scm (make-random-jobs): Rename RANDOM to CHECKOUT.
Rename the checkout from 'random (which is a specification) to 'cuirass (which
is a checkout resulting from an input).
* src/cuirass/base.scm (fetch-repository): Rename to fetch-input. Rename SPEC
to INPUT. Return a checkout object instead of returning two values.
(evaluate): Take a list of CHECKOUTS and COMMITS as arguments, instead of
SOURCE. Remove TOKENIZE and LOAD-PATH. Pass the CHECKOUTS instead of the
SOURCE to "evaluate". Remove %GUIX-PACKAGE-PATH. Build the EVAL object
instead of getting it from "evaluate".
(compile?, fetch-inputs, compile-checkouts): New procedures.
(process-specs): Fetch all inputs instead of only fetching one repository.
The result of that fetching operation is a list of CHECKOUTS whose COMMITS are
used as a STAMP.
(%guix-package-path, set-guix-package-path): Remove them.
* src/cuirass/database.scm (db-add-input, db-get-inputs): New procedures.
(db-add-specification, db-get-specifications): Adapt to the new specification
format. Add/get all inputs as well.
(db-add-evaluation): Rename REVISION to COMMITS. Store COMMITS as space
separated commit hashes.
(db-get-builds): Rename REPO_NAME to NAME.
(db-get-stamp): Rename COMMIT to STAMP. Return #f when there is no STAMP.
(db-add-stamp): Rename COMMIT to STAMP. Deal with DB-GET-STAMP's new return
value.
(db-get-evaluations): Rename REVISION to COMMITS. Tokenize COMMITS.
* src/cuirass/utils.scm (%non-blocking): Export it.
* src/schema.sql (Inputs): New table that refers to the Specifications table.
(Specifications): Move input related fields to the Inputs table. Rename
REPO_NAME to NAME. Rename ARGUMENTS to PROC_ARGS. Rename FILE to PROC_FILE.
Add LOAD_PATH_INPUTS, PACKAGE_PATH_INPUTS and PROC_INPUT fields that refer to
the Inputs table.
(Stamps): Rename REPO_NAME to NAME.
(Evaluations): Rename REPO_NAME to NAME. Rename REVISION to COMMITS.
(Specifications_index): Replace with Inputs_index.
* src/sql/upgrade-1.sql: New file.
* tests/database.scm (example-spec, make-dummy-eval, sqlite-exec): Adapt to
the new specifications format. Rename REVISION to COMMITS.
* tests/http.scm (evaluations-query-result, fill-db): Idem.
2018-06-26 11:18:23 +02:00
|
|
|
(let loop ((rows (sqlite-exec db "SELECT id, specification, commits
|
2018-04-19 11:17:42 +02:00
|
|
|
FROM Evaluations ORDER BY id DESC LIMIT " limit ";"))
|
|
|
|
(evaluations '()))
|
|
|
|
(match rows
|
2018-04-23 09:50:31 +02:00
|
|
|
(() (reverse evaluations))
|
Add support for multiple inputs.
* Makefile.am (dist_sql_DATA): Add src/sql/upgrade-1.sql.
* bin/cuirass.in (show-help, %options, main): Remove the LOAD-PATH option that
was used afterwards as %GUIX-PACKAGE-PATH.
* bin/evaluate.in (absolutize, input-checkout, spec-source, spec-load-path,
spec-package-path, format-checkouts): New procedures.
(%not-colon): Remove variable.
(main): Take the load path, package path and PROC from the checkouts that
result from the inputs. Format the checkouts before sending them to the
procedure. Remove the LOAD-PATH argument.
* doc/cuirass.texi (Overview, Database schema): Document the changes.
* examples/{guix-jobs.scm, hello-git.scm, hello-singleton.scm,
hello-subset.scm, random.scm}: Adapt to the new specification format.
* examples/guix-track-git.scm (package->spec): Rename to PACKAGE->INPUT.
(package->git-tracked): Replace FETCH-REPOSITORY with FETCH-INPUT and handle
the new format of its return value.
* examples/random-jobs.scm (make-random-jobs): Rename RANDOM to CHECKOUT.
Rename the checkout from 'random (which is a specification) to 'cuirass (which
is a checkout resulting from an input).
* src/cuirass/base.scm (fetch-repository): Rename to fetch-input. Rename SPEC
to INPUT. Return a checkout object instead of returning two values.
(evaluate): Take a list of CHECKOUTS and COMMITS as arguments, instead of
SOURCE. Remove TOKENIZE and LOAD-PATH. Pass the CHECKOUTS instead of the
SOURCE to "evaluate". Remove %GUIX-PACKAGE-PATH. Build the EVAL object
instead of getting it from "evaluate".
(compile?, fetch-inputs, compile-checkouts): New procedures.
(process-specs): Fetch all inputs instead of only fetching one repository.
The result of that fetching operation is a list of CHECKOUTS whose COMMITS are
used as a STAMP.
(%guix-package-path, set-guix-package-path): Remove them.
* src/cuirass/database.scm (db-add-input, db-get-inputs): New procedures.
(db-add-specification, db-get-specifications): Adapt to the new specification
format. Add/get all inputs as well.
(db-add-evaluation): Rename REVISION to COMMITS. Store COMMITS as space
separated commit hashes.
(db-get-builds): Rename REPO_NAME to NAME.
(db-get-stamp): Rename COMMIT to STAMP. Return #f when there is no STAMP.
(db-add-stamp): Rename COMMIT to STAMP. Deal with DB-GET-STAMP's new return
value.
(db-get-evaluations): Rename REVISION to COMMITS. Tokenize COMMITS.
* src/cuirass/utils.scm (%non-blocking): Export it.
* src/schema.sql (Inputs): New table that refers to the Specifications table.
(Specifications): Move input related fields to the Inputs table. Rename
REPO_NAME to NAME. Rename ARGUMENTS to PROC_ARGS. Rename FILE to PROC_FILE.
Add LOAD_PATH_INPUTS, PACKAGE_PATH_INPUTS and PROC_INPUT fields that refer to
the Inputs table.
(Stamps): Rename REPO_NAME to NAME.
(Evaluations): Rename REPO_NAME to NAME. Rename REVISION to COMMITS.
(Specifications_index): Replace with Inputs_index.
* src/sql/upgrade-1.sql: New file.
* tests/database.scm (example-spec, make-dummy-eval, sqlite-exec): Adapt to
the new specifications format. Rename REVISION to COMMITS.
* tests/http.scm (evaluations-query-result, fill-db): Idem.
2018-06-26 11:18:23 +02:00
|
|
|
((#(id specification commits)
|
2018-04-19 11:17:42 +02:00
|
|
|
. rest)
|
|
|
|
(loop rest
|
|
|
|
(cons `((#:id . ,id)
|
|
|
|
(#:specification . ,specification)
|
Add support for multiple inputs.
* Makefile.am (dist_sql_DATA): Add src/sql/upgrade-1.sql.
* bin/cuirass.in (show-help, %options, main): Remove the LOAD-PATH option that
was used afterwards as %GUIX-PACKAGE-PATH.
* bin/evaluate.in (absolutize, input-checkout, spec-source, spec-load-path,
spec-package-path, format-checkouts): New procedures.
(%not-colon): Remove variable.
(main): Take the load path, package path and PROC from the checkouts that
result from the inputs. Format the checkouts before sending them to the
procedure. Remove the LOAD-PATH argument.
* doc/cuirass.texi (Overview, Database schema): Document the changes.
* examples/{guix-jobs.scm, hello-git.scm, hello-singleton.scm,
hello-subset.scm, random.scm}: Adapt to the new specification format.
* examples/guix-track-git.scm (package->spec): Rename to PACKAGE->INPUT.
(package->git-tracked): Replace FETCH-REPOSITORY with FETCH-INPUT and handle
the new format of its return value.
* examples/random-jobs.scm (make-random-jobs): Rename RANDOM to CHECKOUT.
Rename the checkout from 'random (which is a specification) to 'cuirass (which
is a checkout resulting from an input).
* src/cuirass/base.scm (fetch-repository): Rename to fetch-input. Rename SPEC
to INPUT. Return a checkout object instead of returning two values.
(evaluate): Take a list of CHECKOUTS and COMMITS as arguments, instead of
SOURCE. Remove TOKENIZE and LOAD-PATH. Pass the CHECKOUTS instead of the
SOURCE to "evaluate". Remove %GUIX-PACKAGE-PATH. Build the EVAL object
instead of getting it from "evaluate".
(compile?, fetch-inputs, compile-checkouts): New procedures.
(process-specs): Fetch all inputs instead of only fetching one repository.
The result of that fetching operation is a list of CHECKOUTS whose COMMITS are
used as a STAMP.
(%guix-package-path, set-guix-package-path): Remove them.
* src/cuirass/database.scm (db-add-input, db-get-inputs): New procedures.
(db-add-specification, db-get-specifications): Adapt to the new specification
format. Add/get all inputs as well.
(db-add-evaluation): Rename REVISION to COMMITS. Store COMMITS as space
separated commit hashes.
(db-get-builds): Rename REPO_NAME to NAME.
(db-get-stamp): Rename COMMIT to STAMP. Return #f when there is no STAMP.
(db-add-stamp): Rename COMMIT to STAMP. Deal with DB-GET-STAMP's new return
value.
(db-get-evaluations): Rename REVISION to COMMITS. Tokenize COMMITS.
* src/cuirass/utils.scm (%non-blocking): Export it.
* src/schema.sql (Inputs): New table that refers to the Specifications table.
(Specifications): Move input related fields to the Inputs table. Rename
REPO_NAME to NAME. Rename ARGUMENTS to PROC_ARGS. Rename FILE to PROC_FILE.
Add LOAD_PATH_INPUTS, PACKAGE_PATH_INPUTS and PROC_INPUT fields that refer to
the Inputs table.
(Stamps): Rename REPO_NAME to NAME.
(Evaluations): Rename REPO_NAME to NAME. Rename REVISION to COMMITS.
(Specifications_index): Replace with Inputs_index.
* src/sql/upgrade-1.sql: New file.
* tests/database.scm (example-spec, make-dummy-eval, sqlite-exec): Adapt to
the new specifications format. Rename REVISION to COMMITS.
* tests/http.scm (evaluations-query-result, fill-db): Idem.
2018-06-26 11:18:23 +02:00
|
|
|
(#:commits . ,(string-tokenize commits)))
|
2018-04-19 11:17:42 +02:00
|
|
|
evaluations))))))
|
Add a web interface.
* Makefile.am (dist_sql_DATA): Add static files.
* src/cuirass/database.scm (assqx-ref): Export it.
(db-get-builds): Add 'evaluation' filter and filters for pagination.
(db-get-evaluations-build-summary, db-get-evaluations-id-min,
db-get-evaluations-id-max, db-get-builds-min, db-get-builds-max): New exported
procedures.
* src/cuirass/http.scm (%static-directory): New parameter.
(%page-size, %file-mime-types, %file-white-list): New variables.
(handle-build-request, handle-builds-request): Move the WITH-CRITICAL-SECTION
call out.
(url-handler): Add RESPOND-HTML, RESPOND-STATIC-FILE and RESPOND-NOT-FOUND
procedures. Call WITH-CRITICAL-SECTION sooner for the '/build',
'/api/latestbuilds' and '/api/queue' routes. Add '/', '/jobset/<name>',
'/eval/<id>', '/static/<path>' routes. Use RESPOND-NOT-FOUND when the route
isn't found.
* src/cuirass/templates.scm: New file.
(html-page, specifications-table, evaluation-info-table,
build-eval-table): New exported procedures.
(pagination): New procedure.
Signed-off-by: Clément Lassieur <clement@lassieur.org>
2018-07-21 15:39:10 +02:00
|
|
|
|
|
|
|
(define (db-get-evaluations-build-summary db spec limit border-low border-high)
|
|
|
|
(let loop ((rows (sqlite-exec db "
|
|
|
|
SELECT E.id, E.commits, B.succeeded, B.failed, B.scheduled
|
|
|
|
FROM (SELECT id, evaluation, SUM(status=0) as succeeded,
|
|
|
|
SUM(status>0) as failed, SUM(status<0) as scheduled
|
|
|
|
FROM Builds
|
|
|
|
GROUP BY evaluation) B
|
|
|
|
JOIN
|
|
|
|
(SELECT id, commits
|
|
|
|
FROM Evaluations
|
|
|
|
WHERE (specification=" spec ")
|
|
|
|
AND (" border-low "IS NULL OR (id >" border-low "))
|
|
|
|
AND (" border-high "IS NULL OR (id <" border-high "))
|
|
|
|
ORDER BY CASE WHEN " border-low "IS NULL THEN id ELSE -id END DESC
|
|
|
|
LIMIT " limit ") E
|
|
|
|
ON B.evaluation=E.id
|
|
|
|
ORDER BY E.id ASC;"))
|
|
|
|
(evaluations '()))
|
|
|
|
(match rows
|
|
|
|
(() evaluations)
|
|
|
|
((#(id commits succeeded failed scheduled) . rest)
|
|
|
|
(loop rest
|
|
|
|
(cons `((#:id . ,id)
|
|
|
|
(#:commits . ,commits)
|
|
|
|
(#:succeeded . ,succeeded)
|
|
|
|
(#:failed . ,failed)
|
|
|
|
(#:scheduled . ,scheduled))
|
|
|
|
evaluations))))))
|
|
|
|
|
|
|
|
(define (db-get-evaluations-id-min db spec)
|
|
|
|
"Return the min id of evaluations for the given specification SPEC."
|
|
|
|
(let ((rows (sqlite-exec db "
|
|
|
|
SELECT MIN(id) FROM Evaluations
|
|
|
|
WHERE specification=" spec)))
|
|
|
|
(vector-ref (car rows) 0)))
|
|
|
|
|
|
|
|
(define (db-get-evaluations-id-max db spec)
|
|
|
|
"Return the max id of evaluations for the given specification SPEC."
|
|
|
|
(let ((rows (sqlite-exec db "
|
|
|
|
SELECT MAX(id) FROM Evaluations
|
|
|
|
WHERE specification=" spec)))
|
|
|
|
(vector-ref (car rows) 0)))
|
|
|
|
|
|
|
|
(define (db-get-builds-min db eval)
|
|
|
|
"Return the min build (stoptime, id) pair for
|
|
|
|
the given evaluation EVAL."
|
|
|
|
(let ((rows (sqlite-exec db "
|
|
|
|
SELECT stoptime, MIN(id) FROM
|
|
|
|
(SELECT id, stoptime FROM Builds
|
|
|
|
WHERE evaluation=" eval " AND
|
|
|
|
stoptime = (SELECT MIN(stoptime)
|
|
|
|
FROM Builds WHERE evaluation=" eval "))")))
|
|
|
|
(vector->list (car rows))))
|
|
|
|
|
|
|
|
(define (db-get-builds-max db eval)
|
|
|
|
"Return the max build (stoptime, id) pair for
|
|
|
|
the given evaluation EVAL."
|
|
|
|
(let ((rows (sqlite-exec db "
|
|
|
|
SELECT stoptime, MAX(id) FROM
|
|
|
|
(SELECT id, stoptime FROM Builds
|
|
|
|
WHERE evaluation=" eval " AND
|
|
|
|
stoptime = (SELECT MAX(stoptime)
|
|
|
|
FROM Builds WHERE evaluation=" eval "))")))
|
|
|
|
(vector->list (car rows))))
|