Re: [patch] chicken-install: finer-grained locking

[Pietro Cerutti]

Here's a revised version that only dumps debug info about the lock being 
acquired/release when `-v` is specified.

On Oct 16 2024, 20:05 +0000, Pietro Cerutti <gahr@gahr.ch> wrote:
> Of course the bug was evident after hitting "Send".
>
> Here's a revised version. The whole install phase (checking for 
> conflicts with already-installed eggs + actually installing the egg) 
> must be guarded.
>
> On Oct 16 2024, 19:58 +0000, Pietro Cerutti <gahr@gahr.ch> wrote:
> > See the patch attached, thanks.
> >
> > --
> > Pietro Cerutti
> > I have pledged to give 10% of income to effective charities
> > and invite you to join me - https://givingwhatwecan.org
>
> > From 041f97769edba2afe52f0659d510a19da491c8e5 Mon Sep 17 00:00:00 2001
> > From: Pietro Cerutti <gahr@gahr.ch>
> > Date: Wed, 16 Oct 2024 19:50:41 +0000
> > Subject: [PATCH] chicken-install: finer-grained locking
> >
> > This makes the locking in chicken-install a bit more fine-grained, just
> > as much as to make it possible to build multiple eggs in parallel.
> >
> > Instead of locking the whole fetch+build+install (i.e., the whole
> > chicken-install run), I'm locking the fetch and install phases only.
> >
> > Also, I have enhanced the logging a bit so we can see which process
> > acquires/releases/waits on the lock. Feel free to kill that part if you
> > don't like it.
> >
> > Also also, I'm making it invalid to run `chicken-install -r` :)
> > ---
> > chicken-install.scm | 23 +++++++++++++++--------
> > 1 file changed, 15 insertions(+), 8 deletions(-)
> >
> > diff --git a/chicken-install.scm b/chicken-install.scm
> > index 521eeda8..983abb2e 100644
> > --- a/chicken-install.scm
> > +++ b/chicken-install.scm
> > @@ -49,6 +49,7 @@
> > (import (chicken pathname))
> > (import (chicken process))
> > (import (chicken process-context))
> > +(import (chicken process-context posix))
> > (import (chicken pretty-print))
> > (import (chicken string))
> > (import (chicken bytevector))
> > @@ -909,7 +910,7 @@
> >                      (unless (if (member name requested-eggs) no-install 
> > no-install-dependencies)
> >                        (check-installed-files name info)
> >                        (print "installing " name)
> > -                        (run-script dir iscript platform sudo: sudo-install))
> > +                        (with-lock (cut run-script dir iscript platform sudo: 
> > sudo-install)))
> >                      (when (and (member name requested-eggs)
> >                                 run-tests
> >                                 (not (test-egg egg platform)))
> > @@ -1079,9 +1080,15 @@
> >            (create-directory cache-directory #t))
> >          (let ((fd (file-open cache-directory open/read)))
> >            (let loop ((f #t))
> > -              (cond ((file-lock fd) (thunk))
> > +              (cond ((file-lock fd)
> > +                     (fprintf (current-error-port) "[~A] cache acquired\n" 
> > (current-process-id))
> > +                     (handle-exceptions ex
> > +                       (print-error-message ex (current-error-port))
> > +                       (thunk)
> > +                       (file-close fd))
> > +                     (fprintf (current-error-port) "[~A] cache released\n" 
> > (current-process-id)))
> >                    (else
> > -                      (when f (fprintf (current-error-port) "cache locked - waiting 
> > for release ...\n"))
> > +                      (when f (fprintf (current-error-port) "[~A] cache locked - 
> > waiting for release ...\n" (current-process-id)))
> >                      (sleep 1)
> >                      (loop #f))))))))
> >
> > @@ -1094,7 +1101,7 @@
> >        (purge-mode (with-lock (cut purge-cache eggs)))
> >        (print-repository (print (install-path)))
> >        ((null? eggs)
> > -         (cond (list-versions-only
> > +         (cond ((or list-versions-only retrieve-only)
> >                 (print "no eggs specified"))
> >               (else
> >                 (let ((files (glob "*.egg" "chicken/*.egg")))
> > @@ -1106,8 +1113,8 @@
> >                   (set! requested-eggs (map car canonical-eggs))
> >                   (with-lock
> >                     (lambda ()
> > -                       (retrieve-eggs '())
> > -                       (unless retrieve-only (install-eggs))))))))
> > +                       (retrieve-eggs '())))
> > +                   (install-eggs)))))
> >        (else
> >          (let ((eggs (apply-mappings eggs)))
> >            (cond (list-versions-only (list-egg-versions eggs))
> > @@ -1115,8 +1122,8 @@
> >                    (set! requested-eggs (map (o car canonical) eggs))
> >                    (with-lock
> >                      (lambda ()
> > -                        (retrieve-eggs eggs)
> > -                        (unless retrieve-only (install-eggs))))))))))
> > +                        (retrieve-eggs eggs)))
> > +                    (unless retrieve-only (install-eggs))))))))
> >
> > (define (usage code)
> >  (print #<<EOF
> > --
> > 2.46.1
>
>
> --
> Pietro Cerutti
> I have pledged to give 10% of income to effective charities
> and invite you to join me - https://givingwhatwecan.org

> From ec788688aecb6c14fd70f3974ee5bd5dbf1d7ece Mon Sep 17 00:00:00 2001
> From: Pietro Cerutti <gahr@gahr.ch>
> Date: Wed, 16 Oct 2024 19:50:41 +0000
> Subject: [PATCH] chicken-install: finer-grained locking
>
> This makes the locking in chicken-install a bit more fine-grained, just
> as much as to make it possible to build multiple eggs in parallel.
>
> Instead of locking the whole fetch+build+install (i.e., the whole
> chicken-install run), I'm locking the fetch and install phases only.
>
> Also, I have enhanced the logging a bit so we can see which process
> acquires/releases/waits on the lock. Feel free to kill that part if you
> don't like it.
>
> Also also, I'm making it invalid to run `chicken-install -r` :)
> ---
> chicken-install.scm | 29 +++++++++++++++++++----------
> 1 file changed, 19 insertions(+), 10 deletions(-)
>
> diff --git a/chicken-install.scm b/chicken-install.scm
> index 521eeda8..0d224e7c 100644
> --- a/chicken-install.scm
> +++ b/chicken-install.scm
> @@ -49,6 +49,7 @@
> (import (chicken pathname))
> (import (chicken process))
> (import (chicken process-context))
> +(import (chicken process-context posix))
> (import (chicken pretty-print))
> (import (chicken string))
> (import (chicken bytevector))
> @@ -907,9 +908,11 @@
>                       (print "building " name)
>                       (run-script dir bscript platform)
>                       (unless (if (member name requested-eggs) no-install 
> no-install-dependencies)
> -                        (check-installed-files name info)
> -                        (print "installing " name)
> -                        (run-script dir iscript platform sudo: sudo-install))
> +                        (with-lock
> +                          (lambda ()
> +                            (check-installed-files name info)
> +                            (print "installing " name)
> +                            (run-script dir iscript platform sudo: 
> sudo-install))))
>                       (when (and (member name requested-eggs)
>                                  run-tests
>                                  (not (test-egg egg platform)))
> @@ -1079,9 +1082,15 @@
>             (create-directory cache-directory #t))
>           (let ((fd (file-open cache-directory open/read)))
>             (let loop ((f #t))
> -              (cond ((file-lock fd) (thunk))
> +              (cond ((file-lock fd)
> +                     (fprintf (current-error-port) "[~A] cache acquired\n" 
> (current-process-id))
> +                     (handle-exceptions ex
> +                       (print-error-message ex (current-error-port))
> +                       (thunk)
> +                       (file-close fd))
> +                     (fprintf (current-error-port) "[~A] cache released\n" 
> (current-process-id)))
>                     (else
> -                      (when f (fprintf (current-error-port) "cache locked - waiting 
> for release ...\n"))
> +                      (when f (fprintf (current-error-port) "[~A] cache locked - 
> waiting for release ...\n" (current-process-id)))
>                       (sleep 1)
>                       (loop #f))))))))
>
> @@ -1094,7 +1103,7 @@
>         (purge-mode (with-lock (cut purge-cache eggs)))
>         (print-repository (print (install-path)))
>         ((null? eggs)
> -         (cond (list-versions-only
> +         (cond ((or list-versions-only retrieve-only)
>                  (print "no eggs specified"))
>                (else
>                  (let ((files (glob "*.egg" "chicken/*.egg")))
> @@ -1106,8 +1115,8 @@
>                    (set! requested-eggs (map car canonical-eggs))
>                    (with-lock
>                      (lambda ()
> -                       (retrieve-eggs '())
> -                       (unless retrieve-only (install-eggs))))))))
> +                       (retrieve-eggs '())))
> +                   (install-eggs)))))
>         (else
>           (let ((eggs (apply-mappings eggs)))
>             (cond (list-versions-only (list-egg-versions eggs))
> @@ -1115,8 +1124,8 @@
>                     (set! requested-eggs (map (o car canonical) eggs))
>                     (with-lock
>                       (lambda ()
> -                        (retrieve-eggs eggs)
> -                        (unless retrieve-only (install-eggs))))))))))
> +                        (retrieve-eggs eggs)))
> +                    (unless retrieve-only (install-eggs))))))))
>
> (define (usage code)
>   (print #<<EOF
> --
> 2.46.1


--
Pietro Cerutti
I have pledged to give 10% of income to effective charities
and invite you to join me - https://givingwhatwecan.org

0001-chicken-install-finer-grained-locking.patch
Description: Text document