[no subject]

[Ludovic Courtès]

branch: master
commit a7b7ede9e7effff2df2cb6d5d1f5c200a6f31f6a
Author: Ludovic Courtès <ludo@gnu.org>
AuthorDate: Sat Jul 15 18:24:04 2023 +0200

    Remove (cuirass watchdog).
    
    This is a followup to 1d49240cc19de45e6ccfa1bfd58bf0f205b79804.
    
    * src/cuirass/watchdog.scm: Remove.
    * Makefile.am (dist_pkgmodule_DATA): Remove it.
    * src/cuirass/scripts/register.scm (cuirass-register): Remove call to
    'start-watchdog'.
    * src/cuirass/scripts/web.scm (cuirass-web): Likewise.
---
 Makefile.am                      |  1 -
 src/cuirass/scripts/register.scm |  2 -
 src/cuirass/scripts/web.scm      |  2 -
 src/cuirass/watchdog.scm         | 94 ----------------------------------------
 4 files changed, 99 deletions(-)

diff --git a/Makefile.am b/Makefile.am
index 6ac8e81..6da434f 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -63,7 +63,6 @@ dist_pkgmodule_DATA =                         \
   src/cuirass/ui.scm                           \
   src/cuirass/utils.scm                                \
   src/cuirass/templates.scm                     \
-  src/cuirass/watchdog.scm                     \
   src/cuirass/zabbix.scm
 
 dist_scriptsmodule_DATA =                      \
diff --git a/src/cuirass/scripts/register.scm b/src/cuirass/scripts/register.scm
index 39138c5..80d2577 100644
--- a/src/cuirass/scripts/register.scm
+++ b/src/cuirass/scripts/register.scm
@@ -29,7 +29,6 @@
   #:use-module (cuirass notification)
   #:use-module (cuirass specification)
   #:use-module (cuirass utils)
-  #:use-module (cuirass watchdog)
   #:use-module (cuirass zabbix)
   #:use-module (guix ui)
   #:use-module ((guix build utils) #:select (mkdir-p))
@@ -129,7 +128,6 @@
                (if one-shot?
                    (process-specs (db-get-specifications))
                    (let ((exit-channel (make-channel)))
-                     (start-watchdog)
                      (clear-build-queue)
 
                      ;; If Cuirass was stopped during an evaluation,
diff --git a/src/cuirass/scripts/web.scm b/src/cuirass/scripts/web.scm
index 379d680..639d0f4 100644
--- a/src/cuirass/scripts/web.scm
+++ b/src/cuirass/scripts/web.scm
@@ -29,7 +29,6 @@
   #:use-module (cuirass notification)
   #:use-module (cuirass specification)
   #:use-module (cuirass utils)
-  #:use-module (cuirass watchdog)
   #:use-module (cuirass zabbix)
   #:use-module (guix ui)
   #:use-module ((guix build utils) #:select (mkdir-p))
@@ -99,7 +98,6 @@
                  (and paramfile (read-parameters paramfile))
 
                  (let ((exit-channel (make-channel)))
-                   (start-watchdog)
                    (spawn-fiber
                     (essential-task
                      'web exit-channel
diff --git a/src/cuirass/watchdog.scm b/src/cuirass/watchdog.scm
deleted file mode 100644
index 62a6b64..0000000
--- a/src/cuirass/watchdog.scm
+++ /dev/null
@@ -1,94 +0,0 @@
-;;; watchdog.scm -- Monitor fibers scheduling.
-;;; Copyright © 2020 Mathieu Othacehe <othacehe@gnu.org>
-;;;
-;;; 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/>.
-
-(define-module (cuirass watchdog)
-  #:use-module (cuirass logging)
-  #:use-module (cuirass utils)
-  #:use-module (fibers)
-  #:use-module (fibers channels)
-  ;; #:use-module (fibers internal)
-  #:use-module (fibers operations)
-  #:use-module (ice-9 match)
-  #:use-module (ice-9 threads)
-  #:export (start-watchdog))
-
-(define* (watchdog-fiber scheduler channel
-                         #:key
-                         (period 1))
-  "Spawn a fiber running on SCHEDULER that sends over CHANNEL, every PERIOD
-seconds, the scheduler name and the current time."
-  (spawn-fiber
-   (lambda ()
-     (while #t
-       (put-message channel (list (scheduler-name scheduler)
-                                  (current-time)))
-       (sleep period)))
-   scheduler))
-
-(define* (start-watchdog #:key (timeout 5))
-  "Start a watchdog checking that each Fibers scheduler is not blocked for
-more than TIMEOUT seconds.
-
-The watchdog mechanism consists in spawning a dedicated fiber per running
-Fiber scheduler, using the above watchdog-fiber method.  Those fibers send a
-ping signal periodically to a separate thread.  If no signal is received from
-one of the schedulers for more than TIMEOUT seconds, a warning message is
-printed."
-  (define (check-timeouts pings last-check)
-    (let* ((check-period timeout)
-           (cur-time (current-time))
-           (diff-check (- cur-time last-check)))
-      (if (> diff-check check-period)
-          (begin
-            (for-each
-             (match-lambda
-               ((scheduler . time)
-                (let ((diff-ping (- cur-time time)))
-                  (when (> diff-ping timeout)
-                    (log-warning "Scheduler ~a blocked since ~a seconds."
-                                 scheduler diff-ping)))))
-             pings)
-            cur-time)
-          last-check)))
-
-  ;; FIXME: Fibers 1.1.0 removed 'fold-all-schedulers' and it's not clear how
-  ;; to implement this watchdog using the 1.1.0 API.
-  *unspecified*
-
-  #;(let ((watchdog-channel (make-channel)))
-    (parameterize (((@@ (fibers internal) current-fiber) #f))
-      (call-with-new-thread
-       (lambda ()
-         (let loop ((pings '())
-                    (last-check 0))
-           (let ((operation-timeout 10))
-             (match (perform-operation
-                     (with-timeout
-                      (get-operation watchdog-channel)
-                      #:seconds operation-timeout
-                      #:wrap (const 'timeout)))
-               ((scheduler ping)
-                (loop (assq-set! pings scheduler ping)
-                      (check-timeouts pings last-check)))
-               ('timeout
-                (loop pings
-                      (check-timeouts pings last-check)))))))))
-    (fold-all-schedulers
-     (lambda (name scheduler seed)
-       (watchdog-fiber scheduler watchdog-channel))
-     '())))