mirror of
git://git.savannah.gnu.org/guix/data-service.git
synced 2023-12-14 03:23:03 +01:00
Add support for processing branch updated emails
This commit is contained in:
parent
5985b5938b
commit
bdfb654233
7 changed files with 134 additions and 4 deletions
|
@ -20,9 +20,10 @@
|
||||||
|
|
||||||
include guile.am
|
include guile.am
|
||||||
|
|
||||||
bin_SCRIPTS = \
|
bin_SCRIPTS = \
|
||||||
scripts/guix-data-service \
|
scripts/guix-data-service \
|
||||||
scripts/guix-data-service-process-jobs \
|
scripts/guix-data-service-process-jobs \
|
||||||
|
scripts/guix-data-service-process-branch-updated-email \
|
||||||
scripts/guix-data-service-query-build-servers
|
scripts/guix-data-service-query-build-servers
|
||||||
|
|
||||||
moddir = $(prefix)/share/guile/site/$(GUILE_EFFECTIVE_VERSION)
|
moddir = $(prefix)/share/guile/site/$(GUILE_EFFECTIVE_VERSION)
|
||||||
|
@ -30,6 +31,7 @@ godir = $(moddir)
|
||||||
assetsdir = $(datadir)/@PACKAGE@
|
assetsdir = $(datadir)/@PACKAGE@
|
||||||
|
|
||||||
SOURCES = \
|
SOURCES = \
|
||||||
|
guix-data-service/branch-updated-emails.scm \
|
||||||
guix-data-service/builds.scm \
|
guix-data-service/builds.scm \
|
||||||
guix-data-service/comparison.scm \
|
guix-data-service/comparison.scm \
|
||||||
guix-data-service/config.scm \
|
guix-data-service/config.scm \
|
||||||
|
|
|
@ -26,6 +26,11 @@ if test "x$have_fibers" != "xyes"; then
|
||||||
AC_MSG_ERROR([Guile fibers is missing; please install it.])
|
AC_MSG_ERROR([Guile fibers is missing; please install it.])
|
||||||
fi
|
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}"
|
guilemoduledir="${datarootdir}/guile/site/${GUILE_EFFECTIVE_VERSION}"
|
||||||
AC_SUBST([guilemoduledir])
|
AC_SUBST([guilemoduledir])
|
||||||
AC_SUBST([GUILE_EFFECTIVE_VERSION])
|
AC_SUBST([GUILE_EFFECTIVE_VERSION])
|
||||||
|
@ -35,6 +40,7 @@ AC_CONFIG_FILES([Makefile])
|
||||||
AC_CONFIG_FILES([guix-data-service/config.scm])
|
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], [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-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([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])
|
AC_CONFIG_FILES([pre-inst-env], [chmod +x pre-inst-env])
|
||||||
|
|
||||||
|
|
40
guix-data-service/branch-updated-emails.scm
Normal file
40
guix-data-service/branch-updated-emails.scm
Normal 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")))))
|
|
@ -20,6 +20,7 @@
|
||||||
#:use-module (guix-data-service model derivation)
|
#:use-module (guix-data-service model derivation)
|
||||||
#:export (process-next-load-new-guix-revision-job
|
#:export (process-next-load-new-guix-revision-job
|
||||||
select-job-for-commit
|
select-job-for-commit
|
||||||
|
enqueue-load-new-guix-revision-job
|
||||||
most-recent-n-load-new-guix-revision-jobs))
|
most-recent-n-load-new-guix-revision-jobs))
|
||||||
|
|
||||||
(define inferior-package-id
|
(define inferior-package-id
|
||||||
|
@ -314,6 +315,18 @@
|
||||||
(and store-item
|
(and store-item
|
||||||
(extract-information-from store conn url commit 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)
|
(define (select-job-for-commit conn commit)
|
||||||
(let ((result
|
(let ((result
|
||||||
(exec-query
|
(exec-query
|
||||||
|
|
|
@ -43,7 +43,8 @@
|
||||||
(source #f)
|
(source #f)
|
||||||
(build-system gnu-build-system)
|
(build-system gnu-build-system)
|
||||||
(inputs
|
(inputs
|
||||||
`(("guile-json" ,guile-json-3)
|
`(("guile-email" ,guile-email)
|
||||||
|
("guile-json" ,guile-json-3)
|
||||||
("guile-squee" ,guile-squee)
|
("guile-squee" ,guile-squee)
|
||||||
("guile-fibers" ,guile-fibers)
|
("guile-fibers" ,guile-fibers)
|
||||||
("guile-syntax-highlight" ,guile-syntax-highlight)
|
("guile-syntax-highlight" ,guile-syntax-highlight)
|
||||||
|
|
34
scripts/guix-data-service-process-branch-updated-email
Executable file
34
scripts/guix-data-service-process-branch-updated-email
Executable 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
34
scripts/guix-data-service-process-branch-updated-email.in
Normal 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)))))
|
Loading…
Reference in a new issue