diff options
| -rw-r--r-- | guix-data-service/jobs/load-new-guix-revision.scm | 210 | ||||
| -rw-r--r-- | guix-data-service/model/git-repository.scm | 2 | ||||
| -rw-r--r-- | sqitch/deploy/load_new_guix_revision_job_events.sql | 18 | ||||
| -rw-r--r-- | sqitch/revert/load_new_guix_revision_job_events.sql | 12 | ||||
| -rw-r--r-- | sqitch/sqitch.plan | 1 | ||||
| -rw-r--r-- | sqitch/verify/load_new_guix_revision_job_events.sql | 8 |
6 files changed, 164 insertions, 87 deletions
diff --git a/guix-data-service/jobs/load-new-guix-revision.scm b/guix-data-service/jobs/load-new-guix-revision.scm index 2ae372d..d27b2bf 100644 --- a/guix-data-service/jobs/load-new-guix-revision.scm +++ b/guix-data-service/jobs/load-new-guix-revision.scm @@ -267,29 +267,33 @@ (define (channel->derivation-file-name store channel) (let ((inferior - (open-inferior/container - store - (guix-store-path store) - #:extra-shared-directories - '("/gnu/store") - #:extra-environment-variables - (list (string-append - "SSL_CERT_DIR=" (nss-certs-store-path store)))))) + (if (defined? 'open-inferior/container) + (open-inferior/container + store + (guix-store-path store) + #:extra-shared-directories + '("/gnu/store") + #:extra-environment-variables + (list (string-append + "SSL_CERT_DIR=" (nss-certs-store-path store)))) + (open-inferior (guix-store-path store))))) (catch #t (lambda () - ;; Create /etc/pass, as %known-shorthand-profiles in (guix - ;; profiles) tries to read from this file. Because the environment - ;; is cleaned in build-self.scm, xdg-directory in (guix utils) - ;; falls back to accessing /etc/passwd. - (inferior-eval - '(begin - (mkdir "/etc") - (call-with-output-file "/etc/passwd" - (lambda (port) - (display "root:x:0:0::/root:/bin/bash" port)))) - inferior) + ;; /etc is only missing if open-inferior/container has been used + (unless (file-exists? "/etc") + ;; Create /etc/pass, as %known-shorthand-profiles in (guix + ;; profiles) tries to read from this file. Because the environment + ;; is cleaned in build-self.scm, xdg-directory in (guix utils) + ;; falls back to accessing /etc/passwd. + (inferior-eval + '(begin + (mkdir "/etc") + (call-with-output-file "/etc/passwd" + (lambda (port) + (display "root:x:0:0::/root:/bin/bash" port)))) + inferior)) (let ((channel-instance (first @@ -355,60 +359,67 @@ (simple-format #t "guix-data-service: load-new-guix-revision: error: ~A\n" args) #f))) -(define (extract-information-from store conn git-repository-id commit store-path) +(define (extract-information-from conn git-repository-id commit store-path) (simple-format #t "debug: extract-information-from: ~A\n" store-path) - (let ((inf (open-inferior/container store store-path - #:extra-shared-directories - '("/gnu/store")))) - (inferior-eval '(use-modules (srfi srfi-1) - (srfi srfi-34) - (guix grafts) - (guix derivations)) - inf) - (inferior-eval '(%graft? #f) inf) - - (exec-query conn "BEGIN") - (catch - #t - (lambda () - (let* ((package-derivation-ids - (inferior-guix->package-derivation-ids store conn inf)) - (guix-revision-id - (insert-guix-revision conn git-repository-id commit store-path))) - - (insert-guix-revision-package-derivations conn - guix-revision-id - package-derivation-ids) - - (exec-query conn "COMMIT") - - (simple-format - #t "Successfully loaded ~A package/derivation pairs\n" - (length package-derivation-ids))) - #t) - (lambda (key . args) - (simple-format (current-error-port) - "Failed extracting information: ~A ~A\n" - key args) - (force-output) - (exec-query conn "ROLLBACK") - #f)))) + (with-store store + (let ((inf (if (defined? 'open-inferior/container) + (open-inferior/container store store-path + #:extra-shared-directories + '("/gnu/store")) + (open-inferior store-path)))) + (inferior-eval '(use-modules (srfi srfi-1) + (srfi srfi-34) + (guix grafts) + (guix derivations)) + inf) + (inferior-eval '(%graft? #f) inf) + + (catch + #t + (lambda () + (let* ((package-derivation-ids + (inferior-guix->package-derivation-ids store conn inf)) + (guix-revision-id + (insert-guix-revision conn git-repository-id commit store-path))) + + (insert-guix-revision-package-derivations conn + guix-revision-id + package-derivation-ids) + + (simple-format + #t "Successfully loaded ~A package/derivation pairs\n" + (length package-derivation-ids))) + #t) + (lambda (key . args) + (simple-format (current-error-port) + "Failed extracting information: ~A ~A\n" + key args) + (force-output) + #f))))) + +(define (store-item-for-git-repository-id-and-commit + conn git-repository-id commit) + (with-store store + (channel->guix-store-item + store + (channel (name 'guix) + (url (git-repository-id->url + conn + git-repository-id)) + (commit commit))))) (define (load-new-guix-revision conn git-repository-id commit) - (if (guix-revision-exists? conn git-repository-id commit) - #t - (with-store store - (let ((store-item (channel->guix-store-item - store - (channel (name 'guix) - (url (git-repository-id->url - conn - git-repository-id)) - (commit commit))))) - (and store-item - (extract-information-from store conn git-repository-id - commit store-item)))))) + (let ((store-item + (store-item-for-git-repository-id-and-commit + conn git-repository-id commit))) + (if store-item + (extract-information-from conn git-repository-id + commit store-item) + (begin + (simple-format #t "Failed to generate store item for ~A\n" + commit) + #f)))) (define (enqueue-load-new-guix-revision-job conn git-repository-id commit source) (define query @@ -442,27 +453,54 @@ RETURNING id;") (list (number->string n))))) result)) +(define (select-next-job-to-process conn) + (exec-query + conn + (string-append + "SELECT id, commit, source, git_repository_id " + "FROM load_new_guix_revision_jobs " + "WHERE succeeded_at IS NULL AND NOT EXISTS (" + "SELECT 1 " + "FROM load_new_guix_revision_job_events " + ;; Skip jobs that have failed, to avoid trying them over and over again + "WHERE job_id = load_new_guix_revision_jobs.id AND event = 'failure'" + ") ORDER BY id ASC LIMIT 1"))) + +(define (record-job-event conn job-id event) + (exec-query + conn + (string-append + "INSERT INTO load_new_guix_revision_job_events (job_id, event) " + "VALUES ($1, $2)") + (list job-id event))) + (define (record-job-succeeded conn id) (exec-query conn (string-append - "UPDATE load_new_guix_revision_jobs WHERE id = $1 " - "SET succeeded_at = current_time") + "UPDATE load_new_guix_revision_jobs " + "SET succeeded_at = clock_timestamp() " + "WHERE id = $1 ") (list id))) (define (process-next-load-new-guix-revision-job conn) - (let ((next - (exec-query - conn - (string-append - "SELECT id, commit, source, git_repository_id " - "FROM load_new_guix_revision_jobs ORDER BY id ASC LIMIT 1")))) - (match next - (((id commit source git-repository-id)) - (begin - (simple-format #t "Processing job ~A (commit: ~A, source: ~A)\n\n" - id commit source) - (when (eq? (load-new-guix-revision conn git-repository-id commit) - #t) - (record-job-succeeded conn id)))) - (_ #f)))) + (match (select-next-job-to-process conn) + (((id commit source git-repository-id)) + (begin + (record-job-event conn id "start") + (simple-format #t "Processing job ~A (commit: ~A, source: ~A)\n\n" + id commit source) + (exec-query conn "BEGIN") + (if (or (guix-revision-exists? conn git-repository-id commit) + (eq? (load-new-guix-revision conn git-repository-id commit) + #t)) + (begin + (record-job-succeeded conn id) + (record-job-event conn id "success") + (exec-query conn "COMMIT") + #t) + (begin + (exec-query conn "ROLLBACK") + (record-job-event conn id "failure") + #f)))) + (_ #f))) diff --git a/guix-data-service/model/git-repository.scm b/guix-data-service/model/git-repository.scm index 2f96606..305b3ec 100644 --- a/guix-data-service/model/git-repository.scm +++ b/guix-data-service/model/git-repository.scm @@ -46,7 +46,7 @@ " SELECT NULL AS id, load_new_guix_revision_jobs.id AS job_id, commit, source FROM load_new_guix_revision_jobs -WHERE git_repository_id = $1 +WHERE git_repository_id = $1 AND succeeded_at IS NULL UNION SELECT id, NULL, commit, NULL FROM guix_revisions diff --git a/sqitch/deploy/load_new_guix_revision_job_events.sql b/sqitch/deploy/load_new_guix_revision_job_events.sql new file mode 100644 index 0000000..96731fb --- /dev/null +++ b/sqitch/deploy/load_new_guix_revision_job_events.sql @@ -0,0 +1,18 @@ +-- Deploy guix-data-service:load_new_guix_revision_job_events to pg + +BEGIN; + +CREATE TYPE job_event AS ENUM ('start', 'failure', 'success'); + +ALTER TABLE ONLY load_new_guix_revision_jobs + ADD CONSTRAINT load_new_guix_revision_jobs_id UNIQUE (id); + +CREATE TABLE load_new_guix_revision_job_events ( + id integer GENERATED BY DEFAULT AS IDENTITY PRIMARY KEY, + job_id integer NOT NULL, + event job_event NOT NULL, + occurred_at timestamp without time zone NOT NULL DEFAULT clock_timestamp(), + CONSTRAINT job_id FOREIGN KEY (job_id) REFERENCES load_new_guix_revision_jobs (id) +); + +COMMIT; diff --git a/sqitch/revert/load_new_guix_revision_job_events.sql b/sqitch/revert/load_new_guix_revision_job_events.sql new file mode 100644 index 0000000..a0a1eec --- /dev/null +++ b/sqitch/revert/load_new_guix_revision_job_events.sql @@ -0,0 +1,12 @@ +-- Revert guix-data-service:load_new_guix_revision_job_events from pg + +BEGIN; + +DROP TABLE load_new_guix_revision_job_events; + +ALTER TABLE load_new_guix_revision_jobs + DROP CONSTRAINT load_new_guix_revision_jobs_id; + +DROP TYPE IF EXISTS job_event; + +COMMIT; diff --git a/sqitch/sqitch.plan b/sqitch/sqitch.plan index b4c873d..56619b9 100644 --- a/sqitch/sqitch.plan +++ b/sqitch/sqitch.plan @@ -12,3 +12,4 @@ add_location_information 2019-05-12T20:27:48Z Christopher Baines <mail@cbaines.n add_git_repositories_cgit_url_base 2019-05-13T18:45:14Z Christopher Baines <mail@cbaines.net> # Add cgit_url_base to git_repositories license_support 2019-05-13T20:37:40Z Christopher Baines <mail@cbaines.net> # Add support for storing license information dates_to_load_new_guix_revision_jobs 2019-06-02T07:39:49Z Christopher Baines <mail@cbaines.net> # Add dates to the load_new_guix_revision_jobs table +load_new_guix_revision_job_events 2019-06-02T15:44:41Z Christopher Baines <mail@cbaines.net> # Add new table for guix_revision_job_events diff --git a/sqitch/verify/load_new_guix_revision_job_events.sql b/sqitch/verify/load_new_guix_revision_job_events.sql new file mode 100644 index 0000000..9ea2196 --- /dev/null +++ b/sqitch/verify/load_new_guix_revision_job_events.sql @@ -0,0 +1,8 @@ +-- Verify guix-data-service:load_new_guix_revision_job_events on pg + +BEGIN; + +SELECT id, job_id, event, occurred_at + FROM load_new_guix_revision_job_events WHERE FALSE; + +ROLLBACK; |