From patchwork Mon Jul 5 15:39:44 2021 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Andrew Tropin X-Patchwork-Id: 31507 Return-Path: X-Original-To: patchwork@mira.cbaines.net Delivered-To: patchwork@mira.cbaines.net Received: by mira.cbaines.net (Postfix, from userid 113) id 1783027BC78; Mon, 19 Jul 2021 18:17:11 +0100 (BST) X-Spam-Checker-Version: SpamAssassin 3.4.2 (2018-09-13) on mira.cbaines.net X-Spam-Level: X-Spam-Status: No, score=-2.8 required=5.0 tests=BAYES_00,DKIM_SIGNED, MAILING_LIST_MULTI,RCVD_IN_MSPIKE_H4,RCVD_IN_MSPIKE_WL,SPF_HELO_PASS, T_DKIM_INVALID,URIBL_BLOCKED autolearn=unavailable autolearn_force=no version=3.4.2 Received: from lists.gnu.org (lists.gnu.org [209.51.188.17]) by mira.cbaines.net (Postfix) with ESMTPS id 9110F27BC6B for ; Mon, 19 Jul 2021 18:17:10 +0100 (BST) Received: from localhost ([::1]:53164 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1m5WtB-0001qT-Jp for patchwork@mira.cbaines.net; Mon, 19 Jul 2021 13:17:09 -0400 Received: from eggs.gnu.org ([2001:470:142:3::10]:42806) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1m5WsC-0000FK-0t for guix-patches@gnu.org; Mon, 19 Jul 2021 13:16:09 -0400 Received: from debbugs.gnu.org ([209.51.188.43]:48672) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1m5Ws6-0004bD-NQ for guix-patches@gnu.org; Mon, 19 Jul 2021 13:16:07 -0400 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1m5Ws6-0000vO-GQ for guix-patches@gnu.org; Mon, 19 Jul 2021 13:16:02 -0400 X-Loop: help-debbugs@gnu.org Subject: [bug#49419] [PATCH v3 2/4] home-services: Add home-run-on-change-service-type References: <87y2akhiz1.fsf@trop.in> Resent-From: Andrew Tropin Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Mon, 19 Jul 2021 17:16:02 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 49419 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: patch To: 49419@debbugs.gnu.org Received: via spool by 49419-submit@debbugs.gnu.org id=B49419.16267149371936 (code B ref 49419); Mon, 19 Jul 2021 17:16:02 +0000 Received: (at 49419) by debbugs.gnu.org; 19 Jul 2021 17:15:37 +0000 Received: from localhost ([127.0.0.1]:60210 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1m5Wrh-0000Ud-0M for submit@debbugs.gnu.org; Mon, 19 Jul 2021 13:15:37 -0400 Received: from mail-lf1-f51.google.com ([209.85.167.51]:45719) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1m5Wre-0000Mo-S1 for 49419@debbugs.gnu.org; Mon, 19 Jul 2021 13:15:35 -0400 Received: by mail-lf1-f51.google.com with SMTP id s13so9973956lfi.12 for <49419@debbugs.gnu.org>; Mon, 19 Jul 2021 10:15:34 -0700 (PDT) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=trop-in.20150623.gappssmtp.com; s=20150623; h=from:to:subject:in-reply-to:date:message-id:mime-version; bh=4T1NvBI/PBjgT7dYtoDFyHLWKROkJqiISaqS3KrtH4M=; b=byObvKyvh7JyRQIf7jIgzzgCkdixnJuN8fgL960XfnKaKwwqiz/x2BAjEUVh4/7Dad 6FEqotJBJa+uTEatR46eVhhNkS5eEKGbxJCD88iWLH45jNx0GKMzisJZE6YO4FF7/CqH Yr8uR/ivaEd3fhbDjqxr5qSYoXuvX+/k4F696APGrICzdPCERwTh4oL2BXQ427fhjiuH Val6Vc2W3V/YCuZuERFhBg1U1Ea0UkYn8eyMRKiRsH+VZjBnkWxl6ovPrAlC+zJTguqM TTB2h18l59MFOMOem4RmeuY7dXRadQ0AhTZLWy6yj17OugxBenQOo9HtLLTvpfvIObhE r8/g== X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20161025; h=x-gm-message-state:from:to:subject:in-reply-to:date:message-id :mime-version; bh=4T1NvBI/PBjgT7dYtoDFyHLWKROkJqiISaqS3KrtH4M=; b=iu8MEYcqaE8N0bn8EmWAWnZyVeETLi/Q3/2+ULRN0/97bgwdRCKUCXk9nnd/EEGftf 20fKl8dlV0C0YMAlKbNUFQtdUv0xbAP3piEs0yc8OVyMFkYR6s3rwVMxH3W9LTdPe2Y3 sRi4KEqRlZ73z8eHf+V73bGYz3WI4s7Jh3xEo20bO8Di1etNYjaBPxVgROWGzrBsqO8s ETyWzfmZ/S8AoFz+N779Z3H2nZfeH6TbGc6FGERx2rjFZmBR5e+nxpz4L1qcE1521XyL etaLaAII7dSL6O7Mw694zncaiRRNC/A07nO+4gKr/8mPSNjMmxnI80JsS1qYIxUpADer mEDA== X-Gm-Message-State: AOAM531hyhH1XpGAoJ3Pp6cohcZT/Nxkj5oUK4N8RC/6C8EtmhCB4Jli sUQKKAbH60aaB2yQenHOKa2vgfGHBguD9g== X-Google-Smtp-Source: ABdhPJwpPVOQc5sovcU4Xyma7Rq5M1me3at9F/mwKO2OEQckIQcDqvzYamGDoYbzhfkThjt1jwPmoA== X-Received: by 2002:ac2:4187:: with SMTP id z7mr18572970lfh.574.1626714928816; Mon, 19 Jul 2021 10:15:28 -0700 (PDT) Received: from localhost ([85.249.24.60]) by smtp.gmail.com with ESMTPSA id x19sm1331004lfd.275.2021.07.19.10.15.27 for <49419@debbugs.gnu.org> (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256); Mon, 19 Jul 2021 10:15:28 -0700 (PDT) From: Andrew Tropin In-Reply-To: <87v956g1g5.fsf@trop.in> Date: Mon, 5 Jul 2021 18:39:44 +0300 Message-ID: <87sg0ag19m.fsf@trop.in> MIME-Version: 1.0 X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-BeenThere: guix-patches@gnu.org List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guix-patches-bounces+patchwork=mira.cbaines.net@gnu.org Sender: "Guix-patches" X-getmail-retrieved-from-mailbox: Patches Service allows to trigger actions during activation if file or directory specified by pattern is changed. --- gnu/home-services.scm | 100 +++++++++++++++++++++++++++++++++++++++++- 1 file changed, 99 insertions(+), 1 deletion(-) diff --git a/gnu/home-services.scm b/gnu/home-services.scm index a89a061a81..bcb6dd80df 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,100 @@ 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")) + (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." + (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.")))