Cuirass: add support for multiple inputs

index 9985fd6..de54f72 100644

;;; Copyright © 2016, 2017 Mathieu Lirzin <mthl@gnu.org>

;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com>

;;; Copyright © 2017 Ricardo Wurmus <rekado@elephly.net>

;;;

;;; This file is part of Cuirass.

;;;

;; Immediately mark COMMIT as being processed so we don't spawn

;; a concurrent evaluation of that same commit.

(db-add-stamp db spec commit)

(spawn-fiber

(lambda ()

(guard (c ((evaluation-error? c)

(log-message "failed to evaluate spec '~s'"

(evaluation-error-spec-name c))

--

2.18.0

index bbecfb6..d219a3e 100644

;;; Copyright © 2012, 2013, 2016, 2018 Ludovic Courtès <ludo@gnu.org>

;;; Copyright © 2015 David Thompson <davet@gnu.org>

;;; Copyright © 2016 Mathieu Lirzin <mthl@gnu.org>

;;;

;;; This file is part of Cuirass.

;;;

(lambda (vars ...) exp ...)))

(define (%non-blocking thunk)

(define-syntax-rule (non-blocking exp ...)

"Evalaute EXP... in a separate thread so that it doesn't block the execution

--

2.18.0

index d372b9e..00954b8 100644

# Copyright © 1995-2016 Free Software Foundation, Inc.

# Copyright © 2016, 2017 Mathieu Lirzin <mthl@gnu.org>

# Copyright © 2018 Ludovic Courtès <ludo@gnu.org>

#

# This file is part of Cuirass.

#

pkgobjectdir = $(guileobjectdir)/$(PACKAGE)

webmoduledir = $(guilesitedir)/web/server

webobjectdir = $(guileobjectdir)/web/server

dist_pkgmodule_DATA = \

src/cuirass/base.scm \

$(dist_webmodule_DATA:.scm=.go)

dist_pkgdata_DATA = src/schema.sql

TEST_EXTENSIONS = .scm .sh

AM_TESTS_ENVIRONMENT = \

diff --git a/doc/cuirass.texi b/doc/cuirass.texi

index b5b27e8..38eb0b0 100644

Copyright @copyright{} 2016, 2017 Mathieu Lirzin@*

Copyright @copyright{} 2017 Mathieu Othacehe@*

@quotation

Permission is granted to copy, distribute and/or modify this document

build results, but also to coordinate the execution of jobs.

The database contains the following tables: @code{Specifications},

@section Specifications

@cindex specifications, database

@end table

@c *********************************************************************

@node Web API

@chapter Web API

diff --git a/src/cuirass/database.scm b/src/cuirass/database.scm

index a1398bc..188b9a8 100644

;;; Copyright © 2016, 2017 Mathieu Lirzin <mthl@gnu.org>

;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com>

;;; Copyright © 2018 Ludovic Courtès <ludo@gnu.org>

;;;

;;; This file is part of Cuirass.

;;;

#:use-module (cuirass utils)

#:use-module (ice-9 match)

#:use-module (ice-9 format)

#:use-module (ice-9 rdelim)

#:use-module (srfi srfi-1)

#:use-module (srfi srfi-19)

#:use-module (srfi srfi-26)

#:use-module (sqlite3)

#:export (;; Procedures.

db-init

(string-append %datadir "/" %package))

"/schema.sql")))

(define (read-sql-file file-name)

"Return a list of string containing SQL instructions from FILE-NAME."

(call-with-input-file file-name

db)

(define* (db-init #:optional (db-name (%package-database))

#:key (schema (%package-schema-file)))

"Open the database to store and read jobs and builds informations. Return a

(delete-file db-name))

(let ((db (sqlite-open db-name (logior SQLITE_OPEN_CREATE

SQLITE_OPEN_READWRITE))))

db))

(define* (db-open #:optional (db (%package-database)))

"Open database to store or read jobs and builds informations. Return a

database object."

;; avoid SQLITE_LOCKED errors when we have several readers:

;; <https://www.sqlite.org/wal.html>.

(set-db-options (if (file-exists? db)

(db-init db))))

(define (db-close db)

diff --git a/src/schema.sql b/src/schema.sql

index 65aebbd..a3f14eb 100644

BEGIN TRANSACTION;

CREATE TABLE Specifications (

repo_name TEXT NOT NULL PRIMARY KEY,

url TEXT NOT NULL,

diff --git a/src/sql/upgrade-1.sql b/src/sql/upgrade-1.sql

new file mode 100644

index 0000000..8f561da

--

2.18.0

index 38eb0b0..5c8c23f 100644

@{

"id": 2,

"job": "acpica-20150410-job",

"timestamp": 1501347493,

"starttime": 1501347493,

@item id

The unique build id.

@item jobset

@item job

The associated job-name, as a string.

@item nr

Limit query result to nr elements. This parameter is @emph{mandatory}.

@item jobset

Filter query result to builds with the given @code{jobset}.

$ curl "http://localhost:8080/api/latestbuilds?nr=10"

@end example

@example

@end example

If no builds matching given parameters are found, an empty JSON array is

diff --git a/src/cuirass/database.scm b/src/cuirass/database.scm

index 188b9a8..f38dcd4 100644

(define (db-format-build db build)

(match build

(#(id timestamp starttime stoptime log status derivation job-name system

`((#:id . ,id)

(#:timestamp . ,timestamp)

(#:starttime . ,starttime)

(#:system . ,system)

(#:nix-name . ,nix-name)

(#:repo-name . ,repo-name)

(define (db-get-builds db filters)

"Retrieve all builds in database DB which are matched by given FILTERS.

;; XXX Change caller and remove

(define (assqx-ref filters key)

(define (finish-group)

(match repeated-row

(#(timestamp starttime stoptime log status derivation job-name system

`((#:id . ,repeated-builds-id)

(#:timestamp . ,timestamp)

(#:starttime . ,starttime)

(#:system . ,system)

(#:nix-name . ,nix-name)

(#:repo-name . ,repo-name)

(define (same-group? builds-id)

(= builds-id repeated-builds-id))

(stmt-text (format #f "\

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,\

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.repo_name \

LEFT JOIN Outputs ON Outputs.build = Builds.id \

WHERE (:id IS NULL OR (:id = Builds.id)) \

AND (:job IS NULL OR (:job = Derivations.job_name)) \

AND (:system IS NULL OR (:system = Derivations.system)) \

AND (:status IS NULL OR (:status = 'done' AND Builds.status >= 0) OR (:status = 'pending' AND Builds.status < 0)) \

ORDER BY ~a, Builds.id ASC LIMIT :nr;" order))

(stmt (sqlite-prepare db stmt-text #:cache? #t)))

(sqlite-bind-arguments stmt #:id (assqx-ref filters 'id)

#:jobset (assqx-ref filters 'jobset)

#:job (assqx-ref filters 'job)

#:system (assqx-ref filters 'system)

diff --git a/src/cuirass/http.scm b/src/cuirass/http.scm

index e911b9b..a45e6b1 100644

;;; Copyright © 2016 Mathieu Lirzin <mthl@gnu.org>

;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com>

;;; Copyright © 2018 Ludovic Courtès <ludo@gnu.org>

;;;

;;; This file is part of Cuirass.

;;;

(build-status started)))))

`((#:id . ,(assq-ref build #:id))

(#:job . ,(assq-ref build #:job-name))

;; Hydra's API uses "timestamp" as the time of the last useful event for

diff --git a/tests/database.scm b/tests/database.scm

index 847c8a6..e71c7f7 100644

;;;

;;; Copyright © 2016 Mathieu Lirzin <mthl@gnu.org>

;;; Copyright © 2018 Ludovic Courtès <ludo@gnu.org>

;;;

;;; This file is part of Cuirass.

;;;

#(((1 "/foo.drv") (2 "/bar.drv") (3 "/baz.drv")) ;ascending order

((3 "/baz.drv") (2 "/bar.drv") (1 "/foo.drv")) ;descending order

((3 "/baz.drv") (2 "/bar.drv") (1 "/foo.drv")) ;ditto

((3 "/baz.drv")) ;nr = 1

((2 "/bar.drv") (1 "/foo.drv") (3 "/baz.drv"))) ;status+submission-time

(with-temporary-database db

(assq-ref alist #:derivation)))))

(vector (map summarize (db-get-builds db '((nr 3) (order build-id))))

(map summarize (db-get-builds db '()))

(map summarize (db-get-builds db '((nr 1))))

(map summarize

(db-get-builds db '((order status+submission-time))))))))

diff --git a/tests/http.scm b/tests/http.scm

index 9d460b2..ba53887 100644

;;; Copyright © 2016 Mathieu Lirzin <mthl@gnu.org>

;;; Copyright © 2017, 2018 Ludovic Courtès <ludo@gnu.org>

;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com>

;;;

;;; This file is part of Cuirass.

;;;

(define build-query-result

'((#:id . 1)

(#:job . "fake-job")

(#:timestamp . 1501347493)

(#:starttime . 1501347493)

500

(response-code (http-get (test-cuirass-uri "/api/latestbuilds"))))

(let ((hash-list

(call-with-input-string

(utf8->string

(http-get-body

(test-cuirass-uri

json->scm)))

(and (= (length hash-list) 1)

(hash-table=?

(object->json-string build-query-result)

json->scm)))))

;; The result should be an empty JSON array.

(let ((hash-list

(call-with-input-string

(utf8->string

(http-get-body

(test-cuirass-uri

json->scm)))

(= (length hash-list) 0)))

--

2.18.0

index 86d0e83..14ff52f 100644

;; Note: Do not use any Guix modules (see below).

(use-modules (ice-9 match)

(define (ref module name)

"Dynamically link variable NAME under MODULE and return it."

(let ((m (resolve-interface module)))

(module-ref m name)))

(define* (main #:optional (args (command-line)))

(match args

;;

;; Since we have relative file name canonicalization by default, better

;; Change '%load-path' once and for all. We need it to be effective

;; both when we load SPEC's #:file and when we later call the thunks.

(save-module-excursion

(lambda ()

(set-current-module %user-module)

;; From there on we can access Guix modules.

(apply real-build-things store args))))

;; Call the entry point of FILE and print the resulting job sexp.

(let* ((proc-name (assq-ref spec #:proc))

(proc (module-ref %user-module proc-name))

(pretty-print

thunks))

stdout)))))

((command _ ...)

diff --git a/doc/cuirass.texi b/doc/cuirass.texi

index 5c8c23f..308518e 100644

@chapter Overview

@command{cuirass} acts as a daemon polling @acronym{VCS, version control

What is actually done by @command{cuirass} is specified in a @dfn{job

specification} which is represented as an association list which is a

a specification might look like:

@lisp

(#:proc . cuirass-jobs)

@end lisp

In this specification the keys are Scheme keywords which have the nice

property of being self evaluating. This means that they can't refer to

another value like symbols do.

@quotation Note

@c This refers to

@c <https://github.com/libgit2/libgit2sharp/issues/1094#issuecomment-112306072>.

build results, but also to coordinate the execution of jobs.

The database contains the following tables: @code{Specifications},

@section Specifications

@cindex specifications, database

Cuirass fetches code and the environment in which it will be processed.

Entries in this table must have values for the following text fields:

@table @code

@item proc

@end table

The following columns are optional:

check out.

@item tag

@item revision

@item no_compile_p

When this integer field holds the value @code{1} Cuirass will skip

@section Stamps

@cindex stamps, database

@section Evaluations

@cindex evaluations, database

This is an automatically incrementing numeric identifier.

@item specification

@code{Specifications} table.

@end table

@section Derivations

diff --git a/examples/guix-jobs.scm b/examples/guix-jobs.scm

index 862cff7..4a01b66 100644

;;; guix-jobs.scm -- job specification test for Guix

;;; Copyright © 2016 Mathieu Lirzin <mthl@gnu.org>

;;;

;;; This file is part o