From: Mathieu Othacehe <m.othacehe@gmail.com>
To: 27876@debbugs.gnu.org
Subject: [bug#27876] [PATCH v2 1/3] cuirass: Store new information in database to prepare new HTTP API integration.
Date: Tue, 1 Aug 2017 21:51:22 +0200 [thread overview]
Message-ID: <20170801195124.7030-1-m.othacehe@gmail.com> (raw)
In-Reply-To: <20170730100759.17734-1-m.othacehe@gmail.com>
* bin/evaluate.in (fill-job): New procedure.
(main): Use it to fill informations (nix-name, system) that will later be
added to database.
* doc/cuirass.texi (Database)[Derivation]: Add system and nix_name fields.
(Database)[Builds]: Add id, status, timestamp, starttime and stoptime
fields. Remove output field.
(Database)[Outputs]: New table describing the build outputs.
* src/cuirass/base.scm (build-packages): Add new fields to build object before
adding it to database.
* src/cuirass/database.scm (db-get-build, db-get-builds): New procedures to get
a build by id from database and a list of builds using filter parameters
respectively.
* src/schema.sql (Outputs) : New table.
(Derivations): Add system and nix_name columns.
(Builds): Remove output column and add id, status, timestamp, starttime and
stoptime columns.
---
bin/evaluate.in | 18 +++++-
doc/cuirass.texi | 49 ++++++++++++++++-
src/cuirass/base.scm | 43 ++++++++++-----
src/cuirass/database.scm | 139 +++++++++++++++++++++++++++++++++++++++++++----
src/schema.sql | 17 +++++-
5 files changed, 235 insertions(+), 31 deletions(-)
diff --git a/bin/evaluate.in b/bin/evaluate.in
index d1d0767..858c34e 100644
--- a/bin/evaluate.in
+++ b/bin/evaluate.in
@@ -28,9 +28,22 @@ exec ${GUILE:-@GUILE@} --no-auto-compile -e main -s "$0" "$@"
(use-modules (cuirass)
(ice-9 match)
(ice-9 pretty-print)
+ (srfi srfi-26)
(guix build utils)
+ (guix derivations)
(guix store))
+(define (fill-job job eval-id)
+ "Given JOB assoc list, add EVAL-ID to it. Also process #:nix-name and
+ #:system from derivation stored in JOB."
+ (let ((drv (read-derivation-from-file
+ (assq-ref job #:derivation))))
+ ((compose
+ (cut acons #:eval-id eval-id <>)
+ (cut acons #:nix-name (derivation-name drv) <>)
+ (cut acons #:system (derivation-system drv) <>))
+ job)))
+
(define* (main #:optional (args (command-line)))
(match args
((command load-path guix-package-path cachedir specstr database)
@@ -73,8 +86,9 @@ exec ${GUILE:-@GUILE@} --no-auto-compile -e main -s "$0" "$@"
(pretty-print
(map (lambda (thunk)
(let* ((job (call-with-time-display thunk))
- ;; Keep track of SPEC id in the returned jobs.
- (job* (acons #:eval-id eval-id job)))
+ ;; Fill job with informations that will later be
+ ;; added to database.
+ (job* (fill-job job eval-id)))
(db-add-derivation db job*)
job*))
thunks)
diff --git a/doc/cuirass.texi b/doc/cuirass.texi
index 2899ffb..443b53c 100644
--- a/doc/cuirass.texi
+++ b/doc/cuirass.texi
@@ -11,6 +11,7 @@ This manual is for Cuirass version @value{VERSION}, a build automation
server.
Copyright @copyright{} 2016, 2017 Mathieu Lirzin
+Copyright @copyright{} 2017 Mathieu Othacehe
@quotation
Permission is granted to copy, distribute and/or modify this document
@@ -312,6 +313,13 @@ This field holds the @code{id} of an evaluation from the
@item job_name
This text field holds the name of the job.
+
+@item system
+This text field holds the system name of the derivation.
+
+@item nix_name
+This text field holds the name of the derivation.
+
@end table
@section Builds
@@ -322,6 +330,9 @@ that builds are not in a one to one relationship with derivations in
order to keep track of non-deterministic compilations.
@table @code
+@item id
+This is an automatically incrementing numeric identifier.
+
@item derivation
This text field holds the absolute name of the derivation file that
resulted in this build.
@@ -334,9 +345,41 @@ belongs.
@item log
This text field holds the absolute file name of the build log file.
-@item output
-This text field holds the absolute directory name of the build output or
-@code{NULL} if the build failed.
+@item status
+This integer field holds the build status of the derivation.
+
+@item timestamp
+This integer field holds a timestamp taken at build creation time.
+
+@item starttime
+This integer field holds a timestamp taken at build start time.
+Currently, it has the same value as the @code{timestamp} above.
+
+@item stoptime
+This integer field holds a timestamp taken at build stop time.
+Currently, it has the same value as the @code{timestamp} above.
+
+@end table
+
+@section Outputs
+@cindex outputs, database
+
+This table keep tracks for every eventual build outputs. Each build
+stored in @code{Builds} table may have zero (if it has failed), one or
+multiple outputs.
+
+@table @code
+@item build
+This field holds the @code{id} of a build from the
+@code{Builds} table.
+
+@item name
+This text field holds the name of the output.
+
+@item path
+This text field holds the path of the output.
+
+@end table
@end table
diff --git a/src/cuirass/base.scm b/src/cuirass/base.scm
index 6abf871..8068539 100644
--- a/src/cuirass/base.scm
+++ b/src/cuirass/base.scm
@@ -31,6 +31,7 @@
#:use-module (ice-9 popen)
#:use-module (ice-9 rdelim)
#:use-module (ice-9 receive)
+ #:use-module (srfi srfi-1)
#:use-module (srfi srfi-19)
#:use-module (srfi srfi-34)
#:use-module (srfi srfi-35)
@@ -180,25 +181,41 @@ directory and the sha1 of the top level commit in this directory."
(define (build-packages store db jobs)
"Build JOBS and return a list of Build results."
+
+ (define hydra-build-status
+ ;; Build status as expected by hydra compatible API's.
+ '((succeeded . 0)
+ (failed . 1)
+ (failed-dependency . 2)
+ (failed-other . 3)
+ (cancelled . 4)))
+
(define (register job)
(let* ((name (assq-ref job #:job-name))
(drv (assq-ref job #:derivation))
(eval-id (assq-ref job #:eval-id))
;; XXX: How to keep logs from several attempts?
(log (log-file store drv))
- (outputs (match (derivation-path->output-paths drv)
- (((names . items) ...)
- (filter (lambda (item)
- (valid-path? store item))
- items)))))
- (for-each (lambda (output)
- (let ((build `((#:derivation . ,drv)
- (#:eval-id . ,eval-id)
- (#:log . ,log)
- (#:output . ,output))))
- (db-add-build db build)))
- outputs)
- (format #t "~{~A ~}\n" outputs)
+ (outputs (filter-map (lambda (res)
+ (match res
+ ((name . path)
+ (and (valid-path? store path)
+ `(,name . ,path)))))
+ (derivation-path->output-paths drv)))
+ (cur-time (time-second (current-time time-utc))))
+ (let ((build `((#:derivation . ,drv)
+ (#:eval-id . ,eval-id)
+ (#:log . ,log)
+ (#:status .
+ ,(match (length outputs)
+ (0 (assq-ref hydra-build-status 'failed))
+ (_ (assq-ref hydra-build-status 'succeeded))))
+ (#:outputs . ,outputs)
+ ;;; XXX: For now, we do not know start/stop build time.
+ (#:timestamp . ,cur-time)
+ (#:starttime . ,cur-time)
+ (#:stoptime . ,cur-time))))
+ (db-add-build db build))
build))
;; Pass all the jobs at once so we benefit from as much parallelism as
diff --git a/src/cuirass/database.scm b/src/cuirass/database.scm
index 804b8c2..5f60fac 100644
--- a/src/cuirass/database.scm
+++ b/src/cuirass/database.scm
@@ -1,5 +1,6 @@
;;; database.scm -- store evaluation and build results
;;; Copyright © 2016, 2017 Mathieu Lirzin <mthl@gnu.org>
+;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com>
;;;
;;; This file is part of Cuirass.
;;;
@@ -21,6 +22,7 @@
#:use-module (cuirass utils)
#:use-module (ice-9 match)
#:use-module (ice-9 rdelim)
+ #:use-module (srfi srfi-1)
#:use-module (sqlite3)
#:export (;; Procedures.
assq-refs
@@ -35,6 +37,8 @@
db-add-derivation
db-get-derivation
db-add-build
+ db-get-build
+ db-get-builds
read-sql-file
read-quoted-string
sqlite-exec
@@ -147,10 +151,12 @@ INSERT OR IGNORE INTO Specifications (repo_name, url, load_path, file, \
(define (db-add-derivation db job)
"Store a derivation result in database DB and return its ID."
(sqlite-exec db "\
-INSERT OR IGNORE INTO Derivations (derivation, job_name, evaluation)\
- VALUES ('~A', '~A', '~A');"
+INSERT OR IGNORE INTO Derivations (derivation, job_name, system, nix_name, evaluation)\
+ VALUES ('~A', '~A', '~A', '~A', '~A');"
(assq-ref job #:derivation)
(assq-ref job #:job-name)
+ (assq-ref job #:system)
+ (assq-ref job #:nix-name)
(assq-ref job #:eval-id)))
(define (db-get-derivation db id)
@@ -182,15 +188,126 @@ string."
(else (loop (cons char chars)))))))
(define (db-add-build db build)
- "Store BUILD in database DB."
- (sqlite-exec db "\
-INSERT INTO Builds (derivation, evaluation, log, output)\
- VALUES ('~A', '~A', '~A', '~A');"
- (assq-ref build #:derivation)
- (assq-ref build #:eval-id)
- (assq-ref build #:log)
- (assq-ref build #:output))
- (last-insert-rowid db))
+ "Store BUILD in database DB. BUILS eventual outputs are stored
+in the OUTPUTS table."
+ (let* ((build-exec
+ (sqlite-exec db "\
+INSERT INTO Builds (derivation, evaluation, log, status, timestamp, starttime, stoptime)\
+ VALUES ('~A', '~A', '~A', '~A', '~A', '~A', '~A');"
+ (assq-ref build #:derivation)
+ (assq-ref build #:eval-id)
+ (assq-ref build #:log)
+ (assq-ref build #:status)
+ (assq-ref build #:timestamp)
+ (assq-ref build #:starttime)
+ (assq-ref build #:stoptime)))
+ (build-id (last-insert-rowid db)))
+ (for-each (lambda (output)
+ (match output
+ ((name . path)
+ (sqlite-exec db "\
+INSERT INTO Outputs (build, name, path) VALUES ('~A', '~A', '~A');"
+ build-id name path))))
+ (assq-ref build #:outputs))
+ build-id))
+
+(define (db-get-outputs db build-id)
+ "Retrieve the OUTPUTS of the build identified by BUILD-ID in DB database."
+ (let loop ((rows
+ (sqlite-exec db "SELECT name, path FROM Outputs WHERE build='~A';"
+ build-id))
+ (outputs '()))
+ (match rows
+ (() outputs)
+ ((#(name path)
+ . rest)
+ (loop rest
+ (cons `(,name . ((#:path . ,path)))
+ outputs))))))
+
+(define db-build-request "\
+SELECT Builds.id, Builds.timestamp, Builds.starttime, Builds.stoptime, Builds.log, Builds.status,\
+Derivations.job_name, Derivations.system, Derivations.nix_name,\
+Specifications.repo_name, Specifications.branch \
+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")
+
+(define (db-format-build db build)
+ (match build
+ (#(id timestamp starttime stoptime log status job-name system
+ nix-name repo-name branch)
+ `((#:id . ,id)
+ (#:timestamp . ,timestamp)
+ (#:starttime . ,starttime)
+ (#:stoptime . ,stoptime)
+ (#:log . ,log)
+ (#:status . ,status)
+ (#:job-name . ,job-name)
+ (#:system . ,system)
+ (#:nix-name . ,nix-name)
+ (#:repo-name . ,repo-name)
+ (#:outputs . ,(db-get-outputs db id))
+ (#:branch . ,branch)))))
+
+(define (db-get-build db id)
+ "Retrieve a build in database DB which corresponds to ID."
+ (let ((res (sqlite-exec db (string-append db-build-request
+ " WHERE Builds.id='~A';") id)))
+ (match res
+ ((build)
+ (db-format-build db build))
+ (() #f))))
+
+(define (db-get-builds db filters)
+ "Retrieve all builds in database DB which are matched by given FILTERS.
+FILTERS is an assoc list which possible keys are 'project | 'jobset | 'job |
+'system | 'nr."
+
+ (define (format-where-clause filters)
+ (let ((where-clause
+ (filter-map
+ (lambda (param)
+ (match param
+ (('project project)
+ (format #f "Specifications.repo_name='~A'" project))
+ (('jobset jobset)
+ (format #f "Specifications.branch='~A'" jobset))
+ (('job job)
+ (format #f "Derivations.job_name='~A'" job))
+ (('system system)
+ (format #f "Derivations.system='~A'" system))
+ (_ #f)))
+ filters)))
+ (if (> (length where-clause) 0)
+ (string-append
+ "WHERE "
+ (string-join where-clause " AND "))
+ "")))
+
+ (define (format-order-clause filters)
+ (any
+ (lambda (param)
+ (match param
+ (('nr number)
+ (format #f "ORDER BY Builds.id DESC LIMIT '~A';" number))
+ (_ #f)))
+ filters))
+
+ (let loop ((rows
+ (sqlite-exec db (string-append
+ db-build-request
+ " "
+ (format-where-clause filters)
+ " "
+ (format-order-clause filters))))
+ (outputs '()))
+ (match rows
+ (() outputs)
+ ((row . rest)
+ (loop rest
+ (cons (db-format-build db row) outputs))))))
(define (db-get-stamp db spec)
"Return a stamp corresponding to specification SPEC in database DB."
diff --git a/src/schema.sql b/src/schema.sql
index 329d89d..0ee428c 100644
--- a/src/schema.sql
+++ b/src/schema.sql
@@ -31,18 +31,31 @@ CREATE TABLE Derivations (
derivation TEXT NOT NULL,
evaluation INTEGER NOT NULL,
job_name TEXT NOT NULL,
+ system TEXT NOT NULL,
+ nix_name TEXT NOT NULL,
PRIMARY KEY (derivation, evaluation),
FOREIGN KEY (evaluation) REFERENCES Evaluations (id)
);
+CREATE TABLE Outputs (
+ build INTEGER NOT NULL,
+ name TEXT NOT NULL,
+ path TEXT NOT NULL,
+ PRIMARY KEY (build, name),
+ FOREIGN KEY (build) REFERENCES Builds (id)
+);
+
-- Builds are not in a one to one relationship with derivations in order to
-- keep track of non deterministic compilations.
CREATE TABLE Builds (
+ id INTEGER NOT NULL PRIMARY KEY AUTOINCREMENT,
derivation TEXT NOT NULL,
evaluation INTEGER NOT NULL,
log TEXT NOT NULL,
- output TEXT, -- NULL if build failed
- PRIMARY KEY (derivation, evaluation, output),
+ status INTEGER NOT NULL,
+ timestamp INTEGER NOT NULL,
+ starttime INTEGER NOT NULL,
+ stoptime INTEGER NOT NULL,
FOREIGN KEY (derivation) REFERENCES Derivations (derivation),
FOREIGN KEY (evaluation) REFERENCES Evaluations (id)
);
--
2.13.2
next prev parent reply other threads:[~2017-08-01 19:52 UTC|newest]
Thread overview: 16+ messages / expand[flat|nested] mbox.gz Atom feed top
2017-07-30 10:07 [bug#27876] [PATCH] cuirass: add Hydra compatible HTTP API Mathieu Othacehe
2017-07-31 14:57 ` Ludovic Courtès
2017-08-01 19:48 ` Mathieu Othacehe
2017-08-02 9:22 ` Ludovic Courtès
2017-08-01 19:51 ` Mathieu Othacehe [this message]
2017-08-01 19:51 ` [bug#27876] [PATCH v2 2/3] " Mathieu Othacehe
2017-09-08 16:00 ` Ludovic Courtès
2017-08-01 19:51 ` [bug#27876] [PATCH v2 3/3] cuirass: Add tests for new " Mathieu Othacehe
2017-09-08 16:01 ` Ludovic Courtès
2017-09-08 15:59 ` [bug#27876] [PATCH v2 1/3] cuirass: Store new information in database to prepare new HTTP API integration Ludovic Courtès
2017-09-08 19:13 ` bug#27876: " Mathieu Othacehe
2017-09-08 20:44 ` [bug#27876] " Ludovic Courtès
2017-09-09 7:48 ` Mathieu Othacehe
2017-09-10 13:01 ` Ludovic Courtès
2017-09-10 13:26 ` Mathieu Othacehe
2017-09-10 20:38 ` Ludovic Courtès
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=20170801195124.7030-1-m.othacehe@gmail.com \
--to=m.othacehe@gmail.com \
--cc=27876@debbugs.gnu.org \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
Code repositories for project(s) associated with this external index
https://git.savannah.gnu.org/cgit/guix.git
This is an external index of several public inboxes,
see mirroring instructions on how to clone and mirror
all data and code used by this external index.