mirror of
git://git.savannah.gnu.org/guix/guix-cuirass.git
synced 2023-12-14 06:03:04 +01:00
12def48b3b
Add a table to store events, which have a type and a JSON blob. These can be used to record changes, this commit inserts events when new builds are created, and when the status of builds change. The EventsOutbox table is then used to track when events have been sent out. This is done through the new cuirass-send-events script. * Makefile.am (bin_SCRIPTS): Add bin/cuirass-send-events. .gitignore: Add bin/cuirass-send-events. (dist_pkgmodule_DATA): Add src/cuirass/send-events.scm. (dist_sql_DATA): Add src/sql/upgrade-5.sql. (EXTRA_DIST): bin/cuirass-send-events.in. (bin/cuirass-send-events): New rule. * bin/cuirass-send-events.in: New file. * src/cuirass/send-events.scm: New file. * src/sql/upgrade-5.sql: New file. * src/cuirass/database.scm (changes-count): New procedure. (db-update-build-status!): Call db-add-event after updating the build status. (db-add-event): New procedure. (db-add-build): Insert an event when a new build is inserted. (db-delete-events-with-ids-<=-to): New procedure. * src/schema.sql (Events): New table.
81 lines
2.7 KiB
Scheme
81 lines
2.7 KiB
Scheme
#!/bin/sh
|
||
# -*- scheme -*-
|
||
# @configure_input@
|
||
#GUILE_LOAD_PATH="@PACKAGE_LOAD_PATH@${GUILE_LOAD_PATH:+:}$GUILE_LOAD_PATH"
|
||
#GUILE_LOAD_COMPILED_PATH="@PACKAGE_LOAD_COMPILED_PATH@${GUILE_LOAD_COMPILED_PATH:+:}$GUILE_LOAD_COMPILED_PATH"
|
||
exec ${GUILE:-@GUILE@} --no-auto-compile -e main -s "$0" "$@"
|
||
!#
|
||
;;;; cuirass -- continuous integration tool
|
||
;;; Copyright © 2016 Mathieu Lirzin <mthl@gnu.org>
|
||
;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com>
|
||
;;; Copyright © 2018 Ludovic Courtès <ludo@gnu.org>
|
||
;;; Copyright © 2018 Clément Lassieur <clement@lassieur.org>
|
||
;;; Copyright © 2019 Christopher Baines <mail@cbaines.net>
|
||
;;;
|
||
;;; This file is part of Cuirass.
|
||
;;;
|
||
;;; Cuirass 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.
|
||
;;;
|
||
;;; Cuirass 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 Cuirass. If not, see <http://www.gnu.org/licenses/>.
|
||
|
||
(use-modules (cuirass)
|
||
(cuirass ui)
|
||
(cuirass logging)
|
||
(cuirass utils)
|
||
(cuirass send-events)
|
||
(guix ui)
|
||
(fibers)
|
||
(fibers channels)
|
||
(srfi srfi-19)
|
||
(ice-9 getopt-long))
|
||
|
||
(define (show-help)
|
||
(format #t "Usage: ~a [OPTIONS]~%" (%program-name))
|
||
(display "Send events to the target URL.
|
||
|
||
-T --target-url=URL Send events to URL.
|
||
-D --database=DB Use DB to store build results.
|
||
-h, --help Display this help message")
|
||
(newline)
|
||
(show-package-information))
|
||
|
||
(define %options
|
||
'((target-url (single-char #\T) (value #t))
|
||
(database (single-char #\D) (value #t))
|
||
(help (single-char #\h) (value #f))))
|
||
|
||
|
||
;;;
|
||
;;; Entry point.
|
||
;;;
|
||
|
||
(define* (main #:optional (args (command-line)))
|
||
|
||
;; Always have stdout/stderr line-buffered.
|
||
(setvbuf (current-output-port) 'line)
|
||
(setvbuf (current-error-port) 'line)
|
||
|
||
(let ((opts (getopt-long args %options)))
|
||
(parameterize
|
||
((%program-name (car args))
|
||
(%package-database (option-ref opts 'database (%package-database)))
|
||
(%package-cachedir
|
||
(option-ref opts 'cache-directory (%package-cachedir))))
|
||
(cond
|
||
((option-ref opts 'help #f)
|
||
(show-help)
|
||
(exit 0))
|
||
(else
|
||
(while #t
|
||
(send-events (option-ref opts 'target-url #f))
|
||
(sleep 5)))))))
|