guix
/
data-service
mirror of git://git.savannah.gnu.org/guix/data-service.git
2
0
Fork 0
Code Issues Releases Wiki Activity

Add support for processing branch updated emails

This commit is contained in:
Christopher Baines 2019-03-19 20:18:09 +00:00
parent 5985b5938b
commit bdfb654233
No known key found for this signature in database
GPG Key ID: 5E28A33B0B84F577
7 changed files with 134 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
Makefile.am
View File

@ -20,9 +20,10 @@
include guile.am
bin_SCRIPTS = \
scripts/guix-data-service \
scripts/guix-data-service-process-jobs \
bin_SCRIPTS = \
scripts/guix-data-service \
scripts/guix-data-service-process-jobs \
scripts/guix-data-service-process-branch-updated-email \
scripts/guix-data-service-query-build-servers
moddir = $(prefix)/share/guile/site/$(GUILE_EFFECTIVE_VERSION)
@ -30,6 +31,7 @@ godir = $(moddir)
assetsdir = $(datadir)/@PACKAGE@
SOURCES = \
guix-data-service/branch-updated-emails.scm \
guix-data-service/builds.scm \
guix-data-service/comparison.scm \
guix-data-service/config.scm \

6
configure.ac
View File

@ -26,6 +26,11 @@ if test "x$have_fibers" != "xyes"; then
AC_MSG_ERROR([Guile fibers is missing; please install it.])
fi
GUILE_MODULE_AVAILABLE([have_email], [(email email)])
if test "x$have_email" != "xyes"; then
AC_MSG_ERROR([Guile email is missing; please install it.])
fi
guilemoduledir="${datarootdir}/guile/site/${GUILE_EFFECTIVE_VERSION}"
AC_SUBST([guilemoduledir])
AC_SUBST([GUILE_EFFECTIVE_VERSION])
@ -35,6 +40,7 @@ AC_CONFIG_FILES([Makefile])
AC_CONFIG_FILES([guix-data-service/config.scm])
AC_CONFIG_FILES([scripts/guix-data-service], [chmod +x scripts/guix-data-service])
AC_CONFIG_FILES([scripts/guix-data-service-process-jobs], [chmod +x scripts/guix-data-service-process-jobs])
AC_CONFIG_FILES([scripts/guix-data-service-process-branch-updated-email], [chmod +x scripts/guix-data-service-process-branch-updated-email])
AC_CONFIG_FILES([scripts/guix-data-service-query-build-servers], [chmod +x scripts/guix-data-service-query-build-servers])
AC_CONFIG_FILES([pre-inst-env], [chmod +x pre-inst-env])

40
guix-data-service/branch-updated-emails.scm Normal file
View File

@ -0,0 +1,40 @@
;;; Guix Data Service -- Information about Guix over time
;;; Copyright © 2019 Christopher Baines <mail@cbaines.net>
;;;
;;; This program is free software: you can redistribute it and/or
;;; modify it under the terms of the GNU Affero General Public License
;;; as published by the Free Software Foundation, either version 3 of
;;; the License, or (at your option) any later version.
;;;
;;; This program is distributed in the hope that it will be useful,
;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
;;; Affero General Public License for more details.
;;;
;;; You should have received a copy of the GNU Affero General Public
;;; License along with this program. If not, see
;;; <http://www.gnu.org/licenses/>.
(define-module (guix-data-service branch-updated-emails)
#:use-module (email email)
#:use-module (guix-data-service jobs load-new-guix-revision)
#:export (enqueue-job-for-email))
(define %repository-url-for-repo
'(("guix" . "https://git.savannah.gnu.org/git/guix.git")))
(define (enqueue-job-for-email conn email)
(let* ((headers (email-headers email))
(x-git-repo (assq-ref headers 'x-git-repo))
(x-git-reftype (assq-ref headers 'x-git-reftype))
(x-git-refname (assq-ref headers 'x-git-refname))
(x-git-newrev (assq-ref headers 'x-git-newrev)))
(when (and (string=? x-git-reftype "branch")
(string=? x-git-repo "guix")
(string? x-git-newrev))
(enqueue-load-new-guix-revision-job
conn
(assoc-ref %repository-url-for-repo
x-git-repo)
x-git-newrev
(string-append x-git-repo " " x-git-refname " updated")))))

13
guix-data-service/jobs/load-new-guix-revision.scm
View File

@ -20,6 +20,7 @@
#:use-module (guix-data-service model derivation)
#:export (process-next-load-new-guix-revision-job
select-job-for-commit
enqueue-load-new-guix-revision-job
most-recent-n-load-new-guix-revision-jobs))
(define inferior-package-id
@ -314,6 +315,18 @@
(and store-item
(extract-information-from store conn url commit store-item))))))
(define (enqueue-load-new-guix-revision-job conn url commit source)
(define query
"
INSERT INTO load_new_guix_revision_jobs (url, commit, source)
VALUES ($1, $2, $3)
RETURNING id;")
(first
(exec-query conn
query
(list url commit source))))
(define (select-job-for-commit conn commit)
(let ((result
(exec-query

3
guix-dev.scm
View File

@ -43,7 +43,8 @@
(source #f)
(build-system gnu-build-system)
(inputs
`(("guile-json" ,guile-json-3)
`(("guile-email" ,guile-email)
("guile-json" ,guile-json-3)
("guile-squee" ,guile-squee)
("guile-fibers" ,guile-fibers)
("guile-syntax-highlight" ,guile-syntax-highlight)

34
scripts/guix-data-service-process-branch-updated-email Executable file
View File

@ -0,0 +1,34 @@
#!/gnu/store/njwvn85rrkplkxk6gy5d7v1n0358a91i-profile/bin/guile --no-auto-compile
-*- scheme -*-
-*- geiser-scheme-implementation: guile -*-
!#
;;; Guix Data Service -- Information about Guix over time
;;; Copyright © 2019 Christopher Baines <mail@cbaines.net>
;;;
;;; This file is part of guix-data-service.
;;;
;;; guix-data-service 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.
;;;
;;; guix-data-service is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; 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 the guix-data-service. If not, see <http://www.gnu.org/licenses/>.
(use-modules (srfi srfi-1)
(srfi srfi-37)
(ice-9 textual-ports)
(squee)
(email email)
(guix-data-service branch-updated-emails))
(let ((conn (connect-to-postgres-paramstring "dbname=guix_data_service")))
(enqueue-job-for-email
conn
(parse-email
(get-string-all (current-input-port)))))

34
scripts/guix-data-service-process-branch-updated-email.in Normal file
View File

@ -0,0 +1,34 @@
#!@GUILE@ --no-auto-compile
-*- scheme -*-
-*- geiser-scheme-implementation: guile -*-
!#
;;; Guix Data Service -- Information about Guix over time
;;; Copyright © 2019 Christopher Baines <mail@cbaines.net>
;;;
;;; This file is part of guix-data-service.
;;;
;;; guix-data-service 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.
;;;
;;; guix-data-service is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; 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 the guix-data-service. If not, see <http://www.gnu.org/licenses/>.
(use-modules (srfi srfi-1)
(srfi srfi-37)
(ice-9 textual-ports)
(squee)
(email email)
(guix-data-service branch-updated-emails))
(let ((conn (connect-to-postgres-paramstring "dbname=guix_data_service")))
(enqueue-job-for-email
conn
(parse-email
(get-string-all (current-input-port)))))