#!/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 ;;; Copyright © 2017 Mathieu Othacehe ;;; Copyright © 2018 Ludovic Courtès ;;; Copyright © 2018 Clément Lassieur ;;; ;;; 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 . (use-modules (cuirass) (cuirass ui) (cuirass logging) (cuirass utils) (guix ui) ((guix build utils) #:select (mkdir-p)) (fibers) (fibers channels) (srfi srfi-19) (ice-9 threads) ;for 'current-processor-count' (ice-9 getopt-long)) (define (show-help) (format #t "Usage: ~a [OPTIONS]~%" (%program-name)) (display "Run build jobs from internal database. --one-shot Evaluate and build jobs only once --cache-directory=DIR Use DIR for storing repository data --fallback Fall back to building when the substituter fails. -S --specifications=SPECFILE Add specifications from SPECFILE to database. -D --database=DB Use DB to store build results. --ttl=DURATION Keep build results live for at least DURATION. --web Start the web interface -p --port=NUM Port of the HTTP server. --listen=HOST Listen on the network interface for HOST -I, --interval=N Wait N seconds between each poll --use-substitutes Allow usage of pre-built substitutes --record-events Record events for distribution --threads=N Use up to N kernel threads -V, --version Display version -h, --help Display this help message") (newline) (show-package-information)) (define %options '((one-shot (value #f)) (web (value #f)) (cache-directory (value #t)) (specifications (single-char #\S) (value #t)) (database (single-char #\D) (value #t)) (port (single-char #\p) (value #t)) (listen (value #t)) (interval (single-char #\I) (value #t)) (use-substitutes (value #f)) (threads (value #t)) (fallback (value #f)) (record-events (value #f)) (ttl (value #t)) (version (single-char #\V) (value #f)) (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))) (%use-substitutes? (option-ref opts 'use-substitutes #f)) (%fallback? (option-ref opts 'fallback #f)) (%record-events? (option-ref opts 'record-events #f)) (%gc-root-ttl (time-second (string->duration (option-ref opts 'ttl "30d"))))) (cond ((option-ref opts 'help #f) (show-help) (exit 0)) ((option-ref opts 'version #f) (show-version) (exit 0)) (else (mkdir-p (%gc-root-directory)) (let ((one-shot? (option-ref opts 'one-shot #f)) (port (string->number (option-ref opts 'port "8080"))) (host (option-ref opts 'listen "localhost")) (interval (string->number (option-ref opts 'interval "300"))) (specfile (option-ref opts 'specifications #f)) ;; Since our work is mostly I/O-bound, default to a maximum of 4 ;; kernel threads. Going beyond that can increase overhead (GC ;; may not scale well, work-stealing may become detrimental, ;; etc.) for little in return. (threads (or (and=> (option-ref opts 'threads #f) string->number) (min (current-processor-count) 4)))) (prepare-git) (log-message "running Fibers on ~a kernel threads" threads) (run-fibers (lambda () (with-database (and specfile (let ((new-specs (save-module-excursion (lambda () (set-current-module (make-user-module '())) (primitive-load specfile))))) (for-each db-add-specification new-specs))) (if one-shot? (process-specs (db-get-specifications)) (let ((exit-channel (make-channel))) (if (option-ref opts 'web #f) (spawn-fiber (essential-task 'web exit-channel (lambda () (run-cuirass-server #:host host #:port port))) #:parallel? #t) (begin (clear-build-queue) ;; If Cuirass was stopped during an evaluation, consider ;; it done. Builds that were not registered during this ;; evaluation will be registered during the next ;; evaluation. (db-set-evaluations-done) ;; First off, restart builds that had not completed or ;; were not even started on a previous run. (spawn-fiber (essential-task 'restart-builds exit-channel (lambda () (restart-builds)))) (spawn-fiber (essential-task 'build exit-channel (lambda () (while #t (process-specs (db-get-specifications)) (log-message "next evaluation in ~a seconds" interval) (sleep interval))))) (spawn-fiber (essential-task 'monitor exit-channel (lambda () (while #t (log-monitoring-stats) (sleep 600))))))) (primitive-exit (get-message exit-channel)))))) ;; Most of our code is I/O so preemption doesn't matter much (it ;; could help while we're doing SQL requests, for instance, but it ;; doesn't actually help since these are non-resumable ;; continuations.) Thus, reduce the tick rate. #:hz 10 #:parallelism threads #:drain? #t)))))))