[bug#76081,v11,2/5] gnu: Move with-retries outside dbus-service.
Commit Message
This patch moves with-retries outside of (gnu build dbus-service) into a
more general (gnu build utils) which can be imported without
unnecessarily importing dbus related symbols.
* gnu/build/dbus-service.scm (sleep,with-retries): Move to...
* gnu/build/utils.scm: ...here.
* gnu/local.mk: Add gnu/build/utils.scm.
* gnu/build/jami-service.scm: Import (gnu build utils).
* gnu/services/telephony.scm (jami-account->alist): Format.
(jami-shepherd-services): Import (gnu build utils).
* gnu/test/messaging.scm (run-ngircd-test): Import (gnu build utils).
(run-pounce-test): Import (gnu build utils).
* gnu/test/telephony.scm (run-jami-test): Import (gnu build utils) and
format.
Change-Id: I3c1768f884ca46d0820a801bd0310c2ec8f3da54
---
gnu/build/dbus-service.scm | 39 +++------------------------
gnu/build/jami-service.scm | 1 +
gnu/build/utils.scm | 55 ++++++++++++++++++++++++++++++++++++++
gnu/local.mk | 1 +
gnu/services/telephony.scm | 9 ++++---
gnu/tests/messaging.scm | 8 +++---
gnu/tests/telephony.scm | 11 ++++----
7 files changed, 76 insertions(+), 48 deletions(-)
create mode 100644 gnu/build/utils.scm
@@ -1,5 +1,6 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2021, 2022 Maxim Cournoyer <maxim.cournoyer@gmail.com>
+;;; Copyright © 2025 Giacomo Leidi <goodoldpaul@autistici.org>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -24,6 +25,7 @@
;;; Code:
(define-module (gnu build dbus-service)
+ #:use-module (gnu build utils)
#:use-module (ice-9 match)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-19)
@@ -54,45 +56,10 @@ (define-module (gnu build dbus-service)
call-dbus-method
dbus-available-services
- dbus-service-available?
-
- with-retries))
+ dbus-service-available?))
(define %dbus-query-timeout 2) ;in seconds
-;;; Use Fibers' sleep to enable cooperative scheduling in Shepherd >= 0.9.0,
-;;; which is required at least for the Jami service.
-(define sleep*
- (lambda () ;delay execution
- (if (resolve-module '(fibers) #f #:ensure #f)
- (module-ref (resolve-interface '(fibers)) 'sleep)
- (begin
- (format #t "Fibers not available -- blocking 'sleep' in use~%")
- sleep))))
-
-;;;
-;;; Utilities.
-;;;
-
-(define-syntax-rule (with-retries n delay body ...)
- "Retry the code in BODY up to N times until it doesn't raise an exception nor
-return #f, else raise an error. A delay of DELAY seconds is inserted before
-each retry."
- (let loop ((attempts 0))
- (catch #t
- (lambda ()
- (let ((result (begin body ...)))
- (if (not result)
- (error "failed attempt" attempts)
- result)))
- (lambda args
- (if (< attempts n)
- (begin
- ((sleep*) delay) ;else wait and retry
- (loop (+ 1 attempts)))
- (error "maximum number of retry attempts reached"
- (quote body ...) args))))))
-
;;;
;;; Low level wrappers above AC/D-Bus.
@@ -25,6 +25,7 @@
(define-module (gnu build jami-service)
#:use-module (gnu build dbus-service)
+ #:use-module (gnu build utils)
#:use-module (ice-9 format)
#:use-module (ice-9 match)
#:use-module (ice-9 rdelim)
new file mode 100644
@@ -0,0 +1,55 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2025 Giacomo Leidi <goodoldpaul@autistici.org>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix 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.
+;;;
+;;; GNU Guix 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 GNU Guix. If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+;;;
+;;; This module contains helpers that could useful to any service.
+;;;
+;;; Code:
+
+(define-module (gnu build utils)
+ #:export (with-retries))
+
+;;; Use Fibers' sleep to enable cooperative scheduling in Shepherd >= 0.9.0,
+;;; which is required at least for the Jami service.
+(define sleep*
+ (lambda () ;delay execution
+ (if (resolve-module '(fibers) #f #:ensure #f)
+ (module-ref (resolve-interface '(fibers)) 'sleep)
+ (begin
+ (format #t "Fibers not available -- blocking 'sleep' in use~%")
+ sleep))))
+
+(define-syntax-rule (with-retries n delay body ...)
+ "Retry the code in BODY up to N times until it doesn't raise an exception nor
+return #f, else raise an error. A delay of DELAY seconds is inserted before
+each retry."
+ (let loop ((attempts 0))
+ (catch #t
+ (lambda ()
+ (let ((result (begin body ...)))
+ (if (not result)
+ (error "failed attempt" attempts)
+ result)))
+ (lambda args
+ (if (< attempts n)
+ (begin
+ ((sleep*) delay) ;else wait and retry
+ (loop (+ 1 attempts)))
+ (error "maximum number of retry attempts reached"
+ (quote body ...) args))))))
@@ -841,6 +841,7 @@ GNU_SYSTEM_MODULES = \
%D%/build/linux-modules.scm \
%D%/build/marionette.scm \
%D%/build/secret-service.scm \
+ %D%/build/utils.scm \
\
%D%/tests.scm \
%D%/tests/audio.scm \
@@ -210,7 +210,7 @@ (define (jami-account->alist jami-account-object)
(tfilter-maybe-value jami-account-object)
(tmap (lambda (field)
(let* ((name (field-name->account-detail
- (configuration-field-name field)))
+ (configuration-field-name field)))
(value ((configuration-field-serializer field)
name ((configuration-field-getter field)
jami-account-object))))
@@ -360,7 +360,8 @@ (define (jami-shepherd-services config)
;; variant of the 'sleep' procedure.
guile-fibers)
(with-imported-modules (source-module-closure
- '((gnu build dbus-service)
+ '((gnu build utils)
+ (gnu build dbus-service)
(gnu build jami-service)
(gnu system file-systems)))
@@ -541,7 +542,8 @@ (define (jami-shepherd-services config)
(list (shepherd-service
(documentation "Run a D-Bus session for the Jami daemon.")
(provision '(jami-dbus-session))
- (modules `((gnu build dbus-service)
+ (modules `((gnu build utils)
+ (gnu build dbus-service)
(gnu build jami-service)
(gnu system file-systems)
,@%default-modules))
@@ -587,6 +589,7 @@ (define (jami-shepherd-services config)
(ice-9 receive)
(srfi srfi-1)
(srfi srfi-26)
+ (gnu build utils)
(gnu build dbus-service)
(gnu build jami-service)
(gnu system file-systems)
@@ -269,7 +269,7 @@ (define (run-ngircd-test)
(marionette-operating-system
%ngircd-os
#:imported-modules (source-module-closure
- '((gnu build dbus-service)
+ '((gnu build utils)
(guix build utils)
(gnu services herd)))))))
@@ -298,7 +298,7 @@ (define (run-ngircd-test)
(test-assert "basic irc operations function as expected"
(marionette-eval
'(begin
- (use-modules ((gnu build dbus-service) #:select (with-retries))
+ (use-modules (gnu build utils)
(ice-9 textual-ports))
(define (write-command command)
@@ -437,7 +437,7 @@ (define (run-pounce-test)
(marionette-operating-system
%pounce-os
#:imported-modules (source-module-closure
- '((gnu build dbus-service)
+ '((gnu build utils)
(guix build utils)
(gnu services herd)))))
(memory-size 1024)))
@@ -470,7 +470,7 @@ (define (run-pounce-test)
(test-assert "pounce functions as an irc bouncer"
(marionette-eval
'(begin
- (use-modules ((gnu build dbus-service) #:select (with-retries))
+ (use-modules (gnu build utils)
(guix build utils)
(ice-9 textual-ports))
@@ -143,7 +143,8 @@ (define* (run-jami-test #:key provisioning? partial?)
#:imported-modules '((gnu services herd)
(guix combinators)
(gnu build jami-service)
- (gnu build dbus-service))))
+ (gnu build dbus-service)
+ (gnu build utils))))
(define vm (virtual-machine
(operating-system os)
(memory-size 512)))
@@ -209,7 +210,7 @@ (define* (run-jami-test #:key provisioning? partial?)
(test-assert "service can be stopped"
(marionette-eval
'(begin
- (use-modules (gnu build dbus-service)
+ (use-modules (gnu build utils)
(gnu build jami-service)
(gnu services herd)
(rnrs base))
@@ -223,10 +224,10 @@ (define* (run-jami-test #:key provisioning? partial?)
(test-assert "service can be restarted"
(marionette-eval
'(begin
- (use-modules (gnu build dbus-service)
+ (use-modules (gnu build utils)
(gnu build jami-service)
(gnu services herd)
- (rnrs base) )
+ (rnrs base))
;; Start the service.
(start-service 'jami)
(with-retries 40 1 (jami-service-available?))
@@ -239,7 +240,7 @@ (define* (run-jami-test #:key provisioning? partial?)
(test-assert "jami accounts provisioning, account present"
(marionette-eval
'(begin
- (use-modules (gnu build dbus-service)
+ (use-modules (gnu build utils)
(gnu services herd)
(rnrs base))
;; Accounts take some time to appear after being added.