civodul pushed a commit to branch master
in repository maintenance.
commit 534d8e9835ea19b65bff4e5b807a8fcbb38dbf8e
Author: Ludovic Courtès <l...@gnu.org>
AuthorDate: Thu Mar 27 23:00:11 2025 +0100
hydra: services: Turn ‘static-web-site’ jobs into Shepherd timers.
* hydra/modules/sysadmin/web.scm (static-web-site-mcron-jobs): Rename to…
(static-web-site-shepherd-services): … this.
[period->calendar-event]: New procedure.
Return a list of shepherd services.
(static-web-site-service-type): Extend ‘shepherd-root-service-type’
instead of ‘mcron-service-type’.
---
hydra/modules/sysadmin/web.scm | 51 +++++++++++++++++++++++++++++++++---------
1 file changed, 41 insertions(+), 10 deletions(-)
diff --git a/hydra/modules/sysadmin/web.scm b/hydra/modules/sysadmin/web.scm
index b07c0805..2fc8512e 100644
--- a/hydra/modules/sysadmin/web.scm
+++ b/hydra/modules/sysadmin/web.scm
@@ -163,7 +163,7 @@ that's built with Haunt or similar."
(directory static-web-site-configuration-directory
(default "/srv/www")))
-(define (static-web-site-mcron-jobs sites)
+(define (static-web-site-shepherd-services sites)
(define (update config)
(build-program (static-web-site-configuration-git-url config)
(static-web-site-configuration-directory config)
@@ -179,6 +179,25 @@ that's built with Haunt or similar."
(basename
(static-web-site-configuration-directory
config)))))
+ (define (period->calendar-event period offset)
+ ;; Convert in a veeeery approximate way PERIOD (in seconds) into a
+ ;; calendar-event-valued gexp.
+ (cond ((<= period 60)
+ #~(calendar-event #:seconds '(#$(modulo offset 60))
+ #:minutes (iota 60)))
+ ((<= period 3600)
+ #~(calendar-event #:minutes '(#$(modulo offset 60))
+ #:hours (iota 24)))
+ ((<= period (* 2 3600))
+ #~(calendar-event #:minutes '(#$(modulo offset 60))
+ #:hours '#$(iota 12 0 2)))
+ ((<= period (* 6 3600))
+ #~(calendar-event #:minutes '(#$(modulo offset 60))
+ #:hours '#$(iota 4 0 6)))
+ (else
+ #~(calendar-event #:minutes '(#$(modulo offset 60))
+ #:hours '(#$(modulo offset 24))))))
+
(define (record->list record)
(let ((fields (record-type-fields <static-web-site-configuration>)))
(map (lambda (n)
@@ -191,12 +210,24 @@ that's built with Haunt or similar."
;; a list representation of CONFIG, rather than over CONFIG, because
;; hash of a struct depends on the object identity of its vtable.
(let* ((period (static-web-site-configuration-period config))
- (offset (hash (record->list config) period)))
- #~(job (lambda (now)
- (let ((elapsed (modulo now #$period)))
- (+ now (- #$period elapsed) #$offset)))
- #$(update config)
- #:user "static-web-site")))
+ (offset (hash (record->list config) period))
+ (name (basename
+ (static-web-site-configuration-directory config))))
+ (shepherd-service
+ (provision (list (symbol-append 'update- (string->symbol name))))
+ (requirement '(user-processes))
+ (modules '((shepherd service timer)))
+ (start
+ #~(make-timer-constructor
+ #$(period->calendar-event period offset)
+ (command '(#$(update config))
+ #:user "static-web-site"
+ #:group "static-web-site")
+ #:log-file #$(string-append "/var/log/static-web-sites/"
+ name ".log")))
+ (stop #~(make-timer-destructor))
+ (actions (list shepherd-trigger-action))
+ (documentation "Rebuild the static web site periodically."))))
sites))
(define (static-web-site-activation sites)
@@ -229,8 +260,8 @@ that's built with Haunt or similar."
(compose concatenate)
(extend append)
(extensions
- (list (service-extension mcron-service-type
- static-web-site-mcron-jobs)
+ (list (service-extension shepherd-root-service-type
+ static-web-site-shepherd-services)
(service-extension account-service-type
static-web-site-accounts)
(service-extension activation-service-type
@@ -270,7 +301,7 @@ taken from a Git repository.")
;; XXX: Use a different cache directory to work around the fact that
;; (guix git) would use a same-named checkout directory for 'master'
- ;; and for the branch above. Since both mcron jobs run at the same
+ ;; and for the branch above. Since both timers run at the same
;; time, they would end up using one branch or the other, in a
;; non-deterministic way.
(cache-directory "guix-master-manual")
