[bug#70494] [PATCH 20/23] scripts: substitute: Simplify with-timeout usage.

["Ludovic Courtès" <ludo@gnu.org>]

Christopher Baines <mail@cbaines.net> skribis:

> To reduce the codepaths in download-nar.
>
> * guix/scripts/substitute.scm (with-timeout): Accept a #f duration and don't
> set a timeout.
> (download-nar): Remove the if for fetch-timeout.
>
> Change-Id: I4e944a425a8612e96659dd84dd0e315012f080ab

[...]

>  (define-syntax-rule (with-timeout duration handler body ...)
>    "Run BODY; when DURATION seconds have expired, call HANDLER, and run BODY
>  again."

The docstring needs updating.

> +  (if duration
> +      (begin
> +        (sigaction SIGALRM
> +          (lambda (signum)
> +            (sigaction SIGALRM SIG_DFL)
> +            handler))
> +        (alarm duration)
> +        (call-with-values
> +            (lambda ()
> +              (let try ()
> +                (catch 'system-error
> +                  (lambda ()
> +                    body ...)
> +                  (lambda args
> +                    ;; Before Guile v2.0.9-39-gfe51c7b, the SIGALRM triggers EINTR
> +                    ;; because of the bug at
> +                    ;; <http://lists.gnu.org/archive/html/guile-devel/2013-06/msg00050.html>.
> +                    ;; When that happens, try again.  Note: SA_RESTART cannot be
> +                    ;; used because of <http://bugs.gnu.org/14640>.
> +                    (if (= EINTR (system-error-errno args))
> +                        (begin
> +                          ;; Wait a little to avoid bursts.
> +                          (usleep (random 3000000 %random-state))
> +                          (try))
> +                        (apply throw args))))))
> +          (lambda result
> +            (alarm 0)
> +            (sigaction SIGALRM SIG_DFL)
> +            (apply values result))))
> +      (begin
> +        body ...)))

To avoid code bloat due to expanding BODY twice, I think this should be
something like:

  (let ((thunk (lambda () body ...)))
    (if duration
        …
        (thunk)))

Otherwise LGTM.