From mboxrd@z Thu Jan 1 00:00:00 1970 Received: from eggs.gnu.org ([2001:4830:134:3::10]:36887) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1dcdD3-0003ku-TY for guix-patches@gnu.org; Tue, 01 Aug 2017 15:52:07 -0400 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1dcdD0-0008Kr-Mo for guix-patches@gnu.org; Tue, 01 Aug 2017 15:52:05 -0400 Received: from debbugs.gnu.org ([208.118.235.43]:34629) by eggs.gnu.org with esmtps (TLS1.0:RSA_AES_128_CBC_SHA1:16) (Exim 4.71) (envelope-from ) id 1dcdD0-0008Kc-IM for guix-patches@gnu.org; Tue, 01 Aug 2017 15:52:02 -0400 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1dcdD0-0001Is-8f for guix-patches@gnu.org; Tue, 01 Aug 2017 15:52:02 -0400 Subject: [bug#27876] [PATCH v2 1/3] cuirass: Store new information in database to prepare new HTTP API integration. References: <20170730100759.17734-1-m.othacehe@gmail.com> In-Reply-To: <20170730100759.17734-1-m.othacehe@gmail.com> Resent-Message-ID: From: Mathieu Othacehe Date: Tue, 1 Aug 2017 21:51:22 +0200 Message-Id: <20170801195124.7030-1-m.othacehe@gmail.com> MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guix-patches-bounces+kyle=kyleam.com@gnu.org Sender: "Guix-patches" To: 27876@debbugs.gnu.org * 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 +;;; Copyright © 2017 Mathieu Othacehe ;;; ;;; 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