[PATCH v2 2/4] home-services: Add home-run-on-change-service-type

DoneSubmitted by Andrew Tropin.
Details
2 participants
  • Andrew Tropin
  • Maxime Devos
Owner
unassigned
Severity
normal
Merged with
A
A
Andrew Tropin wrote on 5 Jul 2021 17:39
(address . guix-patches@gnu.org)
875yxem679.fsf@trop.in
Service allows to trigger actions during activation if file or directory
specified by pattern is changed.
---
gnu/home-services.scm | 95 ++++++++++++++++++++++++++++++++++++++++++-
1 file changed, 94 insertions(+), 1 deletion(-)

Toggle diff (112 lines)
diff --git a/gnu/home-services.scm b/gnu/home-services.scm
index a89a061a81..fadad3133e 100644
--- a/gnu/home-services.scm
+++ b/gnu/home-services.scm
@@ -37,7 +37,8 @@
 	    home-environment-variables-service-type
 	    home-files-service-type
 	    home-run-on-first-login-service-type
-            home-activation-service-type)
+            home-activation-service-type
+            home-run-on-change-service-type)
 
   #:re-export (service
 	       service-type
@@ -326,3 +327,95 @@ directory.  @command{activate} script automatically called during
 reconfiguration or generation switching.  This service can be extended
 with one gexp, but many times, and all gexps must be idempotent.")))
 
+
+;;;
+;;; On-change.
+;;;
+
+(define (compute-on-change-gexp eval-gexps? pattern-gexp-tuples)
+  #~(begin
+      (define (equal-regulars? file1 file2)
+        "Check if FILE1 and FILE2 are bit for bit identical."
+        (let* ((cmp-binary #$(file-append
+                              (@ (gnu packages base) diffutils) "/bin/cmp"))
+               (status (system* cmp-binary file1 file2)))
+          (= status 0)))
+
+      (define (equal-symlinks? symlink1 symlink2)
+        "Check if SYMLINK1 and SYMLINK2 are pointing to the same target."
+        (string=? (readlink symlink1) (readlink symlink2)))
+
+      (define (equal-directories? dir1 dir2)
+        "Check if DIR1 and DIR2 have the same content."
+        (define (ordinary-file file)
+          (not (or (string=? file ".")
+                   (string=? file ".."))))
+        (let* ((files1 (scandir dir1 ordinary-file))
+               (files2 (scandir dir2 ordinary-file)))
+          (if (equal? files1 files2)
+              (map (lambda (file)
+                     (equal-files?
+                      (string-append dir1 "/" file)
+                      (string-append dir2 "/" file)))
+                   files1)
+              #f)))
+
+      (define (equal-files? file1 file2)
+        "Compares files, symlinks or directories of the same type."
+        (case (file-type file1)
+          ((directory) (equal-directories? file1 file2))
+          ((symlink) (equal-symlinks? file1 file2))
+          ((regular) (equal-regulars? file1 file2))
+          (else
+           (display "The file type is unsupported by on-change service.\n")
+           #f)))
+
+      (define (file-type file)
+        (stat:type (lstat file)))
+
+      (define (something-changed? file1 file2)
+        (cond
+         ((and (not (file-exists? file1))
+               (not (file-exists? file2))) #f)
+         ((or  (not (file-exists? file1))
+               (not (file-exists? file2))) #t)
+
+         ((not (eq? (file-type file1) (file-type file2))) #t)
+
+         (else
+          (not (equal-files? file1 file2)))))
+
+      (define expressions-to-eval
+        (map
+         (lambda (x)
+           (let* ((file1 (string-append (getenv "GUIX_OLD_HOME") "/" (car x)))
+                  (file2 (string-append (getenv "GUIX_NEW_HOME") "/" (car x)))
+                  (_ (format #t "Comparing ~a and\n~10t~a..." file1 file2))
+                  (any-changes? (something-changed? file1 file2))
+                  (_ (format #t " done (~a)\n"
+                             (if any-changes? "changed" "same"))))
+             (if any-changes? (cadr x) "")))
+         '#$pattern-gexp-tuples))
+
+      (if #$eval-gexps?
+          (begin
+            (display "Evaling on-change gexps.\n\n")
+            (for-each primitive-eval expressions-to-eval)
+            (display "On-change gexps evaluation finished.\n\n"))
+          (display "\
+On-change gexps won't evaluated, disabled by service configuration.\n"))))
+
+(define home-run-on-change-service-type
+  (service-type (name 'home-run-on-change)
+                (extensions
+                 (list (service-extension
+                        home-activation-service-type
+                        identity)))
+                (compose concatenate)
+                (extend compute-on-change-gexp)
+                (default-value #t)
+                (description "\
+G-expressions to run if the specified files have changed since the
+last generation.  The extension should be a list of lists where the
+first element is the pattern for file or directory that expected to be
+changed, and the second element is the G-expression to be evaluated.")))
-- 
2.32.0
A
A
Andrew Tropin wrote on 13 Jul 2021 20:26
Merging accidentially created tickets
(address . control@debbugs.gnu.org)
87pmvmkr2k.fsf@trop.in
merge 49419 49546 49547 49548 49549
M
M
Maxime Devos wrote on 14 Jul 2021 12:41
Re: [bug#49547] [PATCH v2 2/4] home-services: Add home-run-on-change-service-type
ec097a03e2df002ef04a9ad80610ed3309a8dfce.camel@telenet.be
Andrew Tropin schreef op ma 05-07-2021 om 18:39 [+0300]:
Toggle quote (7 lines)
> + (define (equal-regulars? file1 file2)
> + "Check if FILE1 and FILE2 are bit for bit identical."
> + (let* ((cmp-binary #$(file-append
> + (@ (gnu packages base) diffutils) "/bin/cmp"))
> + (status (system* cmp-binary file1 file2)))
> + (= status 0)))

Is there any particular reason to shell out to "cmp" instead
of doing the comparison in Guile? Starting a process isn't
the most efficient thing.

Try "time /run/current-system/profile/bin echo", on my system,
it takes about 2--3 milliseconds for "echo" to finish
even though it only had to print a newline character.
Compare with "time echo" (to use the shell built-in "echo"),
it takes 0.000s seconds on my system.

3 milliseconds isn't much by itself, but this can accumulate,
so I would implement the comparison in Guile.

As an optimisation, you could look at the value returned by "lstat".
If the 'size' is different, then 'equal-regulars?' can return #f
without reading the file. If the 'inode' and 'device' are equal,
then 'equal-regulars?' can return #t I think (at least on conventional
file systems like btrfs and ext4).

Greetings,
Maxime.
-----BEGIN PGP SIGNATURE-----

iI0EABYKADUWIQTB8z7iDFKP233XAR9J4+4iGRcl7gUCYO6/XxccbWF4aW1lZGV2
b3NAdGVsZW5ldC5iZQAKCRBJ4+4iGRcl7n/oAP466Q+yNDWKN85lWBzh23gFcgJl
jrkXgXv4gkpEv3VRIgD/QDFM7IlVUX9HSbQLJfKHjSZ7HfYDCsi7PabVpzizfwI=
=I3D3
-----END PGP SIGNATURE-----


A
A
Andrew Tropin wrote on 15 Jul 2021 10:46
87fswg2cd0.fsf@trop.in
Maxime Devos <maximedevos@telenet.be> writes:

Toggle quote (27 lines)
> Andrew Tropin schreef op ma 05-07-2021 om 18:39 [+0300]:
>> + (define (equal-regulars? file1 file2)
>> + "Check if FILE1 and FILE2 are bit for bit identical."
>> + (let* ((cmp-binary #$(file-append
>> + (@ (gnu packages base) diffutils) "/bin/cmp"))
>> + (status (system* cmp-binary file1 file2)))
>> + (= status 0)))
>
> Is there any particular reason to shell out to "cmp" instead
> of doing the comparison in Guile? Starting a process isn't
> the most efficient thing.
>
> Try "time /run/current-system/profile/bin echo", on my system,
> it takes about 2--3 milliseconds for "echo" to finish
> even though it only had to print a newline character.
> Compare with "time echo" (to use the shell built-in "echo"),
> it takes 0.000s seconds on my system.
>
> 3 milliseconds isn't much by itself, but this can accumulate,
> so I would implement the comparison in Guile.
>
> As an optimisation, you could look at the value returned by "lstat".
> If the 'size' is different, then 'equal-regulars?' can return #f
> without reading the file. If the 'inode' and 'device' are equal,
> then 'equal-regulars?' can return #t I think (at least on conventional
> file systems like btrfs and ext4).

No specific reason. Yep, spawning a new process can be expensive, but
it's not clear how much time will take the comparison itself and if it
worth it to optimize "startup time". I'm not very fluent with guile
internals and not sure if reimplementation of cmp in guile would improve
or worsen the performance, but it obviously could intoduce some bugs. I
found Xinglu's idea of the usage of well-tested cmp to be a reasonable
solution here.

Also, this service is expected to be used with small amount of files and
because many of them are symlinks to the store even smaller number of
them will trigger the execution of cmp, so I find the performance
optimization to be preliminary here and propose to address the issue
when and if it appear someday.

However, the ideas about size and inodes are good, easy to implement and
I find them potentially useful to prevent unecessary external process
spawning. The patch with those improvements are below:
From 8dd0c06fb64c8b516418cbdf8c385a6c817e7f26 Mon Sep 17 00:00:00 2001
From: Andrew Tropin <andrew@trop.in>
Date: Thu, 15 Jul 2021 09:44:30 +0300
Subject: [PATCH] (toberebased) home-services: Prevent unecessary system* call

---
gnu/home-services.scm | 9 +++++++--
1 file changed, 7 insertions(+), 2 deletions(-)

Toggle diff (22 lines)
diff --git a/gnu/home-services.scm b/gnu/home-services.scm
index 78e5603edf..9afb70f0a7 100644
--- a/gnu/home-services.scm
+++ b/gnu/home-services.scm
@@ -341,8 +341,13 @@ with one gexp, but many times, and all gexps must be idempotent.")))
         "Check if FILE1 and FILE2 are bit for bit identical."
         (let* ((cmp-binary #$(file-append
                               (@ (gnu packages base) diffutils) "/bin/cmp"))
-               (status (system* cmp-binary file1 file2)))
-          (= status 0)))
+               (stats1     (lstat file1))
+               (stats2     (lstat file2)))
+          (cond
+           ((= (stat:ino stats1) (stat:ino stats2))         #t)
+           ((not (= (stat:size stats1) (stat:size stats2))) #f)
+
+           (else (= (system* cmp-binary file1 file2) 0)))))
 
       (define (equal-symlinks? symlink1 symlink2)
         "Check if SYMLINK1 and SYMLINK2 are pointing to the same target."
-- 
2.32.0
Thank you for suggestions!)
-----BEGIN PGP SIGNATURE-----

iQJDBAEBCgAtFiEEKEGaxlA4dEDH6S/6IgjSCVjB3rAFAmDv9esPHGFuZHJld0B0
cm9wLmluAAoJECII0glYwd6wHH4P/RRohchbd9qOOFASUcDQS5tq0RKJ3N7hfO5X
aGRfyARItrj5oA8SYKw9OHrd1b4fIeDO0DVWScEJJ33rv8Exg+dgOkHJ0b5AN1wY
zdOKRIRRqOuCy8u5oAZwkK4jBy1Ewz6UV+5MGWO0Y5GpgHMlHiRU0A2XtEkU7Ubh
2MdP/BDTqNY4mj6sAxneA0V8PRgUIQiau3QwDEPX6f2JAJduPC/niVHUTi4nYFkS
BfCt32T6x6Z5mOO4isRMzTstwnNAtSreTapIHIxr3mLi+QAimv/1txGqxQY6dRQK
qQHwAc2P/PQ/UWgreRSzxAE4kKvFk6vl9dIAXVwdZheErflNCSzJO25ArfQz+913
hfOPv/KoILyXHL9PfzOwoEjZ2NEOs5YWd60SATYkT0VGZe0lNEhkE/uIPbo0gDTw
JrYhVBV0sYxk85LKlQIPvJ6yjipXkMHRz130vAnJuWKNgXOKL+0Gf+NtDPBnzMl/
dKI7epQ3LOebdEcGbx3sdfre47WYdEmi1NTxBS2nEb5Tzt9+KQ+Cq3AQvg/vylfG
A4+nAkTgETzSXGad6eBcvjOkQxkseverAm1zFx+kh3tjng7pSNB2AE2+kzf/W1JW
YcYwAGNJWFLCQCkZm1YuWgIzcXqjXElLRvzgK+ZWbQZv11pH3Ik8cFSBcIXRqVQa
6YPfKK9e
=d8Sg
-----END PGP SIGNATURE-----

M
M
Maxime Devos wrote on 18 Jul 2021 18:17
3e972a6c839a48edf7fecb88a3ad4fd9bc0dfcee.camel@telenet.be
Andrew Tropin schreef op do 15-07-2021 om 11:46 [+0300]:
Toggle quote (8 lines)
> No specific reason. Yep, spawning a new process can be expensive, but
> it's not clear how much time will take the comparison itself and if it
> worth it to optimize "startup time". I'm not very fluent with guile
> internals and not sure if reimplementation of cmp in guile would improve
> or worsen the performance, but it obviously could intoduce some bugs. I
> found Xinglu's idea of the usage of well-tested cmp to be a reasonable
> solution here.

Sounds reasonable to me.

Toggle quote (10 lines)
> Also, this service is expected to be used with small amount of files and
> because many of them are symlinks to the store even smaller number of
> them will trigger the execution of cmp, so I find the performance
> optimization to be preliminary here and propose to address the issue
> when and if it appear someday.
>
> However, the ideas about size and inodes are good, easy to implement and
> I find them potentially useful to prevent unecessary external process
> spawning. The patch with those improvements are below: [...]

Greetings,
Maxime.
-----BEGIN PGP SIGNATURE-----

iI0EABYKADUWIQTB8z7iDFKP233XAR9J4+4iGRcl7gUCYPRUGxccbWF4aW1lZGV2
b3NAdGVsZW5ldC5iZQAKCRBJ4+4iGRcl7hIgAPsExp+jqfgfoKVMHgODzJREQOdI
yT8ZpvE3XC/p2J51bwEA0Hj3KBHI2TnyUq0uZUkpRrsGFKF9tB/9gdb4IjCF5gA=
=sLoh
-----END PGP SIGNATURE-----


?
Your comment

This issue is archived.

To comment on this conversation send email to 49547@debbugs.gnu.org