Reproducer for failing shepherd startup

[Felix Lechner via "Development of GNU Guix and the GNU System distribution." <guix-devel@gnu.org>]

Hi Maya, Ludo' and Attila,

On Thu, Jun 27 2024, Maya wrote:

> I still don't know how to fix the issue properly, but at least I can
> reconfigure my system now <3

I have a reproducer!  In the code below, please change "sunday" to "0",
together with this line in your "services":

     (service mdadm-resync-service-type)

When reconfiguring, you should see something like:

    guix deploy: warning: an error occurred while upgrading services on
    'YOUR-FQDN': %exception #<inferior-object #<&action-exception-error
    service: root action: eval key: %exception args: ("#<&message
    message: \"calendar-event: 0: invalid day of week\">")>>

That system should refuse to boot.  Interestingly, the Shepherd will
block in such a way that even the Magic SysRq key 'i' which is normally
enough will not stop it.  I have to go all the way *backwards* to 'b' in
the sequence B-U-S-I-E-R. [1]

Ludo', thank you for making the #:days-of the week symbolic [2] and also
for fixing the Shepherd to be able to show status and reboot again! [3]

Kind regards
Felix

[1] https://lists.gnu.org/archive/html/guix-devel/2024-04/msg00214.html
[2] https://git.savannah.gnu.org/cgit/shepherd.git/commit/?h=devel&id=2e844430ec8aa4aebb7a8c185f54d6f91bbc3cfe
[3] https://lists.gnu.org/archive/html/info-gnu/2024-06/msg00009.html

* * *

(define (mdadm-resync-shepherd-service config)
  (shepherd-service
   (provision '(mdadm-resync))
   (requirement '(file-systems user-processes))
   (modules '((ice-9 ftw)
              (ice-9 regex)
              (shepherd service timer)))
   (start #~(make-timer-constructor
             ;; Every first Sunday of the month at 1 AM.
             (calendar-event #:days-of-month '(1 2 3 4 5 6 7)
                             #:days-of-week '(sunday)
                             #:hours '(1))
             (lambda _
               ;; some helpers and error handling
               (define (info message)
                 (let ((timestamp (strftime "%Y-%m-%dT%H:%M:%S%zZ" (localtime (current-time)))))
                   (format (current-error-port) "~a ~a~%" timestamp message)))

               (define (resync array)
                 (let ((port (open-output-file (string-append "/sys/block/" array "/md/sync_action"))))
                   (display "check" port)
                   (close-port port))
                 (info (string-append "Started MD resync for " array ".")))

               (let* ((is-mdadm-device? (lambda (file)
                                          (string-match "^md.+" file)))
                      (arrays (scandir "/dev" is-mdadm-device?)))
                 (map resync arrays)))))
   (stop #~(make-timer-destructor))
   ;; (actions
   ;;  (list (shepherd-action
   ;;         (name 'trigger)
   ;;         (documentation "Trigger the action associated with this timer.")
   ;;         (procedure #~(identity trigger-timer)))))
   (documentation "MD array resync")))

(define mdadm-resync-service-type
  (service-type
   (name 'mdadm-resync)
   (description "MD array resync")
   (extensions
    (list
     (service-extension shepherd-root-service-type
                        (compose list mdadm-resync-shepherd-service))))
   (default-value #f)))