Received: (at 51359) by debbugs.gnu.org; 8 Jun 2022 17:03:03 +0000 From debbugs-submit-bounces <at> debbugs.gnu.org Wed Jun 08 13:03:03 2022 Received: from localhost ([127.0.0.1]:44130 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from <debbugs-submit-bounces <at> debbugs.gnu.org>) id 1nyz5D-00037x-L1 for submit <at> debbugs.gnu.org; Wed, 08 Jun 2022 13:03:03 -0400 Received: from mail-lf1-f49.google.com ([209.85.167.49]:46007) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from <go.wigust@HIDDEN>) id 1nyz59-00037Q-NE for 51359 <at> debbugs.gnu.org; Wed, 08 Jun 2022 13:03:02 -0400 Received: by mail-lf1-f49.google.com with SMTP id c4so2117490lfj.12 for <51359 <at> debbugs.gnu.org>; Wed, 08 Jun 2022 10:02:59 -0700 (PDT) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gmail.com; s=20210112; h=from:to:cc:subject:references:date:in-reply-to:message-id :user-agent:mime-version; bh=AMCkz14vaeNQUcBQSpxw6qX4xzduZk2iXRwXZMB31b8=; b=jM7ud5opKv0hE+CGbHamWCwiuQlchC/kTZaHtU8Zyc2+J+V/BFW3m6Ok9ccfvz0yr6 hwGws6GiWO9D3EsVUic+UlWmhuafhFE8dEBuXt6uveapN0L7W3q04LaPgv9GS2eDkHPi 57b0af7wOzWRIj6GBEyMnTiLOQlJrW4SSdDOVcmX1W5R7QJTgn6FO9SRqeniCzL+JqDM R99vW2TIs9PmLkpuS/LcISXnQ6yuZM5czMeaxTvi8eu8QTC6NTjRKkauZiU1Og3evoPD /WsKrk0WF70jGjT3kTGJCYgmExNeMG9oIhm3g1RGBenGAI1aqwAYspBF7TtPqi1tf9ej dcrQ== X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20210112; h=x-gm-message-state:from:to:cc:subject:references:date:in-reply-to :message-id:user-agent:mime-version; bh=AMCkz14vaeNQUcBQSpxw6qX4xzduZk2iXRwXZMB31b8=; b=A1bZGDCqcUantkjNTkes56DSo9JU8nfeDYMv1t4XfQVHfmk7hduu6dqmQzI/v1topy EIuIfTC6ru1QUP1HPTvK7B/aQukS4Y+vz5jsey/b1hFANjr+XVLZZKolwdtvfkl9hM8K GPVA+QimTnSI89/aJTyTyvZvws7WgUkFKFfZaQGJeRPZVwa4GAxGrXL9la4t0gXH4IxX 8R7O3AeqbG5r88Sj3xicc8I3H19OaddES3xMygCFNJatcAg0wcLJejW+B1SFvcIop8Uv buvsKFK3p4gV3QWAaD+8A/wr8pBHHd+fpKhwSMmIWOOn/4/9075DRAsPERgCUr35uhxW rifQ== X-Gm-Message-State: AOAM532JHqHZtwA7vjTkvRyrMGX320jEQ/jRq1M95bmU9A4+0vUirOqc 0Fg1tezIaVxB9pePMXhylAw= X-Google-Smtp-Source: ABdhPJxRsG09qOgA9qv+7vLXbvJF3+E8lAZtPmA/J0pyElgZ4mAiCZ7D4zz/0F4G2UTlNSSqObwi7A== X-Received: by 2002:a05:6512:702:b0:479:3bb1:8992 with SMTP id b2-20020a056512070200b004793bb18992mr11706164lfs.361.1654707773384; Wed, 08 Jun 2022 10:02:53 -0700 (PDT) Received: from localhost ([88.201.161.72]) by smtp.gmail.com with ESMTPSA id bu40-20020a05651216a800b004791cc90ab4sm2446656lfb.179.2022.06.08.10.02.52 (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256); Wed, 08 Jun 2022 10:02:52 -0700 (PDT) From: Oleg Pykhalov <go.wigust@HIDDEN> To: Andrew Tropin <andrew@HIDDEN> Subject: Re: [bug#51359] [PATCH 0/1] home-state-service-type and tests suite References: <20211023180446.3362-1-go.wigust@HIDDEN> <87edzz9lvv.fsf@HIDDEN> Date: Wed, 08 Jun 2022 20:02:50 +0300 In-Reply-To: <87edzz9lvv.fsf@HIDDEN> (Andrew Tropin's message of "Wed, 08 Jun 2022 19:10:28 +0300") Message-ID: <871qvzgkat.fsf@HIDDEN> User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/28.0.50 (gnu/linux) MIME-Version: 1.0 Content-Type: multipart/signed; boundary="=-=-="; micalg=pgp-sha512; protocol="application/pgp-signature" X-Spam-Score: -0.0 (/) X-Debbugs-Envelope-To: 51359 Cc: 51359 <at> debbugs.gnu.org X-BeenThere: debbugs-submit <at> debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: <debbugs-submit.debbugs.gnu.org> List-Unsubscribe: <https://debbugs.gnu.org/cgi-bin/mailman/options/debbugs-submit>, <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=unsubscribe> List-Archive: <https://debbugs.gnu.org/cgi-bin/mailman/private/debbugs-submit/> List-Post: <mailto:debbugs-submit <at> debbugs.gnu.org> List-Help: <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=help> List-Subscribe: <https://debbugs.gnu.org/cgi-bin/mailman/listinfo/debbugs-submit>, <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=subscribe> Errors-To: debbugs-submit-bounces <at> debbugs.gnu.org Sender: "Debbugs-submit" <debbugs-submit-bounces <at> debbugs.gnu.org> X-Spam-Score: -1.0 (-) --=-=-= Content-Type: text/plain; charset=utf-8 Content-Transfer-Encoding: quoted-printable Hi Andrew, Andrew Tropin <andrew@HIDDEN> writes: [=E2=80=A6] > Thank you for the patch, but states are very WIP and not ready for > upstream yet IMO. Also, I would like to reevaluate implementation of > git service-type and probably merge it separately. > > Hope I will get back to states in foreseable future and will carefully > rethink, refactor and cleanup the code. If the user's configuration will stay the same, we probably could merge. > BTW, do you use states? Can you share your experience with it? I tried the git state and it worked, don't remember rsync. Also I don't use it since the patch submitting day, because of plans to rewrite it. Oleg. --=-=-= Content-Type: application/pgp-signature; name="signature.asc" -----BEGIN PGP SIGNATURE----- iQJIBAEBCgAyFiEEcjhxI46s62NFSFhXFn+OpQAa+pwFAmKg1joUHGdvLndpZ3Vz dEBnbWFpbC5jb20ACgkQFn+OpQAa+pw4kg/+JcyqdlTuvpSOiB+XR4htTaQ6WqqS dCaQT92As8vnFYGXgclSEdvtlPxiKfUzudvksaZ4FMBhzITzfdVMHupBoORwxem9 oTmnzErEmKwexcMJytoRyiIU/Kbzld1KREmS0f78e2N+d3NJD04fdGsGGrSqgJn2 WA4/Q7Zm7HIkMmeBrSY284aQ5oFuW9rNHjKVV7erSQoPqytfSa7wYq3e2RENu9jt LTkxE1HQ5cTyvk9kciXOnBJBjnZw0VcZAeXUwRFDriEDJM7TXDxserCd2EZATACg oFxRR6OPgTeXrfTxW/nDnSaj0rVjmMmj4UgPuyYSSniZMBw6wc2gDbb5Ing2qihG GkujXbDuUP5z+OWN6VaDyIU/idIZVXuGFNKj5eU75SNpDSt/VoWvw37bSrBKrd/C zXQcf4hVC7Z7sP3yHdO+CzZHTWQ+W0bfqqJ6lvMQ4yf/WAgSOr+wVPteovMCiQu1 YWz8+YElccp3QcMy9FLOes7iGjg4Vssr4z5UcbhIozRvSV9D694lZ5mu4RQutlkU BSIejd632t/tuqtVKelV8zs90biRMHIii0sHsDFv51MhATzY6R+yFCXo3/sqRnAR ThJds3BIkzz37x9Q4StWIqTzac9MAJ1zk8J3bWf80J3Is3FxiHiXjlXLV7xDdGMk b+LAJ+hJ4RnJHLA= =5Kuq -----END PGP SIGNATURE----- --=-=-=--
guix-patches@HIDDEN:bug#51359; Package guix-patches.
Full text available.Received: (at 51359) by debbugs.gnu.org; 8 Jun 2022 16:10:45 +0000 From debbugs-submit-bounces <at> debbugs.gnu.org Wed Jun 08 12:10:44 2022 Received: from localhost ([127.0.0.1]:44036 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from <debbugs-submit-bounces <at> debbugs.gnu.org>) id 1nyyGa-0007wW-Le for submit <at> debbugs.gnu.org; Wed, 08 Jun 2022 12:10:44 -0400 Received: from relay5-d.mail.gandi.net ([217.70.183.197]:32811) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from <andrew@HIDDEN>) id 1nyyGV-0007wD-Rb for 51359 <at> debbugs.gnu.org; Wed, 08 Jun 2022 12:10:43 -0400 Received: (Authenticated sender: andrew@HIDDEN) by mail.gandi.net (Postfix) with ESMTPSA id 32B7F1C000B; Wed, 8 Jun 2022 16:10:31 +0000 (UTC) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=trop.in; s=gm1; t=1654704633; h=from:from:reply-to:subject:subject:date:date:message-id:message-id: to:to:cc:cc:mime-version:mime-version:content-type:content-type: in-reply-to:in-reply-to:references:references; bh=rtzSwe9YzvFKDNat26jQKWg2zDIkeAKUyDfyYOr7IF0=; b=G8SqJaRFa3V/MaAHSjQmpK7NRn2+859NitFhVUWZM3aAzGNhNKLUU92JXIEDuOOag29W3r mvSafjookxsH+oe3Ad2dezuOP0UdqhJ9s9R/Nkz3lSTRWLxn3Y74ux162b8QuwEq+HGqaA 48poJKpHACI0hsS4gmQydrWdRv2N0hLZ/I8QQlLTIfWgKJNlVf04HG5kwanjkM2zPj19jU 5Wo4BOlZ2DC2oJU1NZgWdJpgolZs9QdonRT4J1Tcl/lx7LtU+8OylHWmf+V7mWgzS3OG1O zd0qYiD6wWF315GG2iiiIM1qYs2zFo6JDZhxLCFwkzEmAa3WFTjCvukEhMydvw== From: Andrew Tropin <andrew@HIDDEN> To: Oleg Pykhalov <go.wigust@HIDDEN>, 51359 <at> debbugs.gnu.org Subject: Re: [bug#51359] [PATCH 0/1] home-state-service-type and tests suite In-Reply-To: <20211023180446.3362-1-go.wigust@HIDDEN> References: <20211023180446.3362-1-go.wigust@HIDDEN> Date: Wed, 08 Jun 2022 19:10:28 +0300 Message-ID: <87edzz9lvv.fsf@HIDDEN> MIME-Version: 1.0 Content-Type: multipart/signed; boundary="=-=-="; micalg=pgp-sha512; protocol="application/pgp-signature" X-Spam-Score: -0.7 (/) X-Debbugs-Envelope-To: 51359 Cc: Oleg Pykhalov <go.wigust@HIDDEN> X-BeenThere: debbugs-submit <at> debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: <debbugs-submit.debbugs.gnu.org> List-Unsubscribe: <https://debbugs.gnu.org/cgi-bin/mailman/options/debbugs-submit>, <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=unsubscribe> List-Archive: <https://debbugs.gnu.org/cgi-bin/mailman/private/debbugs-submit/> List-Post: <mailto:debbugs-submit <at> debbugs.gnu.org> List-Help: <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=help> List-Subscribe: <https://debbugs.gnu.org/cgi-bin/mailman/listinfo/debbugs-submit>, <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=subscribe> Errors-To: debbugs-submit-bounces <at> debbugs.gnu.org Sender: "Debbugs-submit" <debbugs-submit-bounces <at> debbugs.gnu.org> X-Spam-Score: -1.7 (-) --=-=-= Content-Type: text/plain Content-Transfer-Encoding: quoted-printable On 2021-10-23 21:04, Oleg Pykhalov wrote: > Hi Guix, > > This patch adds support for home-state-service-type which copied from the= rde > project [1]. The introduction to home state services in documentation is > copied from discussion [2]. > > Tests passed: > > make check-system TESTS=3D"home-state-git" > make check-system TESTS=3D"home-state-rsync" > > [1] https://github.com/abcdw/rde/ > [2] https://lists.sr.ht/~abcdw/rde-devel/%3C87pmzze9nn.fsf%40trop.in%3E#%= 3CCABrWRW1Fq-8mS=3DMbWJedUpayj1vFg-YE0oNF3zVTYWBMnp29Lg@HIDDEN%3E > > Oleg Pykhalov (1): > home: services: Add state services. > > doc/guix.texi | 32 ++ > gnu/home.scm | 12 + > gnu/home/services/state.scm | 210 ++++++++++++ > gnu/home/services/utils.scm | 81 ++++- > gnu/home/services/version-control.scm | 442 ++++++++++++++++++++++++++ > gnu/local.mk | 2 + > gnu/tests/rsync.scm | 158 ++++++++- > gnu/tests/version-control.scm | 140 +++++++- > guix/scripts/home.scm | 100 +++++- > 9 files changed, 1163 insertions(+), 14 deletions(-) > create mode 100644 gnu/home/services/state.scm > create mode 100644 gnu/home/services/version-control.scm Hi Oleg! Thank you for the patch, but states are very WIP and not ready for upstream yet IMO. Also, I would like to reevaluate implementation of git service-type and probably merge it separately. Sorry for replying slowly :)=20=20 Hope I will get back to states in foreseable future and will carefully rethink, refactor and cleanup the code. BTW, do you use states? Can you share your experience with it? =2D-=20 Best regards, Andrew Tropin --=-=-= Content-Type: application/pgp-signature; name="signature.asc" -----BEGIN PGP SIGNATURE----- iQIzBAEBCgAdFiEEKEGaxlA4dEDH6S/6IgjSCVjB3rAFAmKgyfQACgkQIgjSCVjB 3rD4mA/+MZzns8/aijc/JD83z1xIWwgI/Iq6sv/+TPGKEkVPfzzlAI0OqApKsE/m Sj8H7nnQdbttS/xLp0V5aPC2MZpO1qY10msSi2iFaKSivVgLGVYbOkmdXLqIHgp4 4SXeHQKZ/t19DT3UfoUDGz4eGGjQ38K19qlZdb2GX5K1WdYv5k/TtQRe7bIZGAAh cYLXv2ShoqghJ0zMkulMfxr2+3mBY4mCnv5d7q7WQQdM+nrtSLT+5SDKgQu5FwRn d/0kFLk/QwjIpXApeCJWNjp0eF0EsyVQXMNp+aOYdwcR1CfCOtJTWUs5ODR3exb7 /EuXd44fXI1rt46n/XBjFpMPQctH7bpG2NDUNrdzZExBhyFVf57uVO1Sc1TDysUa uEX0mGT7eq87FJTCFDqF9i4obxlkVZwriIBnJx/UPHxs7s17eXDv7C2yN8wMzP1D xGeiPwqRQbMnnxFOrAZ8INvaCFjqgErOzak/t3O27zIAv1S9PNUYfwf1tMqqTHit uZi6f4pc8a8V0F1k7RNtD3N4Ip9OueeZYskf4K+/t3CMTGOqcRcrtZ4itmrMeC6K 8Ybik7t6Q4rSM69YifyJ6/5e0GZDMWLLH21nSG7LwL3CZH6DdPKs91BFCGI7sHmB ZQi/+0tBTLv1Tgd5Wkx2AgglWzW2F90dbhSsKp7e6cW7E1j/wbU= =oncn -----END PGP SIGNATURE----- --=-=-=--
guix-patches@HIDDEN:bug#51359; Package guix-patches.
Full text available.Ludovic Courtès <ludo@HIDDEN>
to control <at> debbugs.gnu.org.
Full text available.
Received: (at 51359) by debbugs.gnu.org; 30 Oct 2021 11:10:59 +0000
From debbugs-submit-bounces <at> debbugs.gnu.org Sat Oct 30 07:10:59 2021
Received: from localhost ([127.0.0.1]:56774 helo=debbugs.gnu.org)
by debbugs.gnu.org with esmtp (Exim 4.84_2)
(envelope-from <debbugs-submit-bounces <at> debbugs.gnu.org>)
id 1mgmGJ-0003Tn-7O
for submit <at> debbugs.gnu.org; Sat, 30 Oct 2021 07:10:59 -0400
Received: from h87-96-130-155.cust.a3fiber.se ([87.96.130.155]:35706
helo=mail.yoctocell.xyz) by debbugs.gnu.org with esmtp (Exim 4.84_2)
(envelope-from <public@HIDDEN>) id 1mgmGH-0003TY-60
for 51359 <at> debbugs.gnu.org; Sat, 30 Oct 2021 07:10:57 -0400
From: Xinglu Chen <public@HIDDEN>
DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/simple; d=yoctocell.xyz;
s=mail; t=1635592251;
bh=z5YV3U9dAz+AtdiyZQQxS2QhjIJlQijRJ9XTfbE5t4A=;
h=From:To:Cc:Subject:In-Reply-To:References:Date;
b=heg026SkOHUg2avn+BE4yP0qWSk8JtgIr/joh3OffLm+xqsZZDYEvlNQtWf36P9XB
oQ+dnVxyzswYyWyQ1QK0J5I+uYAAVVznbwfQ9WMYnsz31ykLTbwEH5c8yv6/P8LoLn
pH1btFAcQCBQ3fyQUuwtgF7TqZ91aRVazN2mfGtQ=
To: Oleg Pykhalov <go.wigust@HIDDEN>, 51359 <at> debbugs.gnu.org
Subject: Re: [bug#51359] [PATCH 0/1] home-state-service-type and tests suite
In-Reply-To: <20211023180446.3362-1-go.wigust@HIDDEN>
References: <20211023180446.3362-1-go.wigust@HIDDEN>
Date: Sat, 30 Oct 2021 13:10:50 +0200
Message-ID: <87h7cy7op1.fsf@HIDDEN>
MIME-Version: 1.0
Content-Type: multipart/signed; boundary="=-=-=";
micalg=pgp-sha256; protocol="application/pgp-signature"
X-Spam-Score: 2.9 (++)
X-Spam-Report: Spam detection software, running on the system "debbugs.gnu.org",
has NOT identified this incoming email as spam. The original
message has been attached to this so you can view it or label
similar future email. If you have any questions, see
the administrator of that system for details.
Content preview: On Sat, Oct 23 2021, Oleg Pykhalov wrote: > Hi Guix, > > This
patch adds support for home-state-service-type which copied from the rde
> project [1]. The introduction to home state services in documentation is
> copied from discussion [2].
Content analysis details: (2.9 points, 10.0 required)
pts rule name description
---- ---------------------- --------------------------------------------------
-0.0 SPF_PASS SPF: sender matches SPF record
2.0 PDS_OTHER_BAD_TLD Untrustworthy TLDs
[URI: yoctocell.xyz (xyz)]
0.0 SPF_HELO_NONE SPF: HELO does not publish an SPF Record
0.5 FROM_SUSPICIOUS_NTLD From abused NTLD
0.4 RDNS_DYNAMIC Delivered to internal network by host with
dynamic-looking rDNS
0.0 PDS_RDNS_DYNAMIC_FP RDNS_DYNAMIC with FP steps
X-Debbugs-Envelope-To: 51359
Cc: Oleg Pykhalov <go.wigust@HIDDEN>
X-BeenThere: debbugs-submit <at> debbugs.gnu.org
X-Mailman-Version: 2.1.18
Precedence: list
List-Id: <debbugs-submit.debbugs.gnu.org>
List-Unsubscribe: <https://debbugs.gnu.org/cgi-bin/mailman/options/debbugs-submit>,
<mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=unsubscribe>
List-Archive: <https://debbugs.gnu.org/cgi-bin/mailman/private/debbugs-submit/>
List-Post: <mailto:debbugs-submit <at> debbugs.gnu.org>
List-Help: <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=help>
List-Subscribe: <https://debbugs.gnu.org/cgi-bin/mailman/listinfo/debbugs-submit>,
<mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=subscribe>
Errors-To: debbugs-submit-bounces <at> debbugs.gnu.org
Sender: "Debbugs-submit" <debbugs-submit-bounces <at> debbugs.gnu.org>
X-Spam-Score: 2.9 (++)
X-Spam-Report: Spam detection software, running on the system "debbugs.gnu.org",
has NOT identified this incoming email as spam. The original
message has been attached to this so you can view it or label
similar future email. If you have any questions, see
the administrator of that system for details.
Content preview: On Sat, Oct 23 2021, Oleg Pykhalov wrote: > Hi Guix, > > This
patch adds support for home-state-service-type which copied from the rde
> project [1]. The introduction to home state services in documentation is
> copied from discussion [2].
Content analysis details: (2.9 points, 10.0 required)
pts rule name description
---- ---------------------- --------------------------------------------------
-0.0 SPF_PASS SPF: sender matches SPF record
2.0 PDS_OTHER_BAD_TLD Untrustworthy TLDs
[URI: yoctocell.xyz (xyz)]
0.0 SPF_HELO_NONE SPF: HELO does not publish an SPF Record
0.5 FROM_SUSPICIOUS_NTLD From abused NTLD
0.4 RDNS_DYNAMIC Delivered to internal network by host with
dynamic-looking rDNS
1.0 BULK_RE_SUSP_NTLD Precedence bulk and RE: from a suspicious TLD
-1.0 MAILING_LIST_MULTI Multiple indicators imply a widely-seen list
manager
0.0 PDS_RDNS_DYNAMIC_FP RDNS_DYNAMIC with FP steps
--=-=-=
Content-Type: text/plain
On Sat, Oct 23 2021, Oleg Pykhalov wrote:
> Hi Guix,
>
> This patch adds support for home-state-service-type which copied from the rde
> project [1]. The introduction to home state services in documentation is
> copied from discussion [2].
There are still quite a few things that have to be fixed with Guix
Home[1][2][3][4], so I suggest we fix those before adding new services.
Also, Andrew mentioned a while a go that he was going to re-design the
state services; maybe he has some updates on that.
[1]: <https://issues.guix.gnu.org/50945> and <https://issues.guix.gnu.org/50941>
[2]: <https://issues.guix.gnu.org/51141>
[3]: <https://issues.guix.gnu.org/50978>
[4]: <https://issues.guix.gnu.org/50990>
--=-=-=
Content-Type: application/pgp-signature; name="signature.asc"
-----BEGIN PGP SIGNATURE-----
iQJJBAEBCAAzFiEEAVhh4yyK5+SEykIzrPUJmaL7XHkFAmF9KDoVHHB1YmxpY0B5
b2N0b2NlbGwueHl6AAoJEKz1CZmi+1x5KnsQALh3PW/BNgTEYKo+69Bh0rWUrZ9o
fBghLvhbvXloqXsZRbsHaIlVMv7Un6ekG/ZM/WCujRmfnr5uHbeRLsPRZZFiOQ3+
kqywVHraY6n/lE4fEZnqiMYww4wdJa+mutZs6z19JZUpBy64QWGHbAPe8gqCNJJV
rY42TyCgH/e2AnDB/48T2r+L6tk0uFE0HWr4nurFWaRCjrDK4hDXyr9bbPRd5dV1
sONaimXCOvwX9IcORhbSYpCJ/tKWWrUM5Z+JIvrdEUaMAW57RYLmrzjNMB2FTMby
dTfPJlJhV0igbjUMdDEIv4R7YBkHcDI9B6+KN4qEJqUPBS4qKNlj+llbuQ3J0PzW
qFoGBMzhKU4UG9RkvTiNZn50cnr5sl8lPdd9mrjivic+IIbtSavHouk243YLOvgl
4grKnNOzuDKZUv85Q4IoyPW1bmIGTNtf/5b44qA38fhVUND876mvn50rfUCFEJ3Y
J1JJLGXoqNXdI8hC+wkfw0Nn5I1D4T2TLYs6LvuhTx48j1amrrZJcVy8x6Iz+VlQ
oH2M9hDmypfx/aSBEINSbYiSzPLPnHKJOCMCk7RD+XKlT2cFjUuJTGczj9wqWjA6
6UtaYerAV0ftMjYvR3lzu7YS3lcpKtDOKxvncU0oQiY8IBXuoaXogpmAxp07cz7z
DZur0acc9Itzf3zl
=wBY0
-----END PGP SIGNATURE-----
--=-=-=--
guix-patches@HIDDEN:bug#51359; Package guix-patches.
Full text available.
Received: (at 51359) by debbugs.gnu.org; 23 Oct 2021 18:07:22 +0000
From debbugs-submit-bounces <at> debbugs.gnu.org Sat Oct 23 14:07:22 2021
Received: from localhost ([127.0.0.1]:37183 helo=debbugs.gnu.org)
by debbugs.gnu.org with esmtp (Exim 4.84_2)
(envelope-from <debbugs-submit-bounces <at> debbugs.gnu.org>)
id 1meLQL-0005U3-4t
for submit <at> debbugs.gnu.org; Sat, 23 Oct 2021 14:07:22 -0400
Received: from mail-lf1-f52.google.com ([209.85.167.52]:38809)
by debbugs.gnu.org with esmtp (Exim 4.84_2)
(envelope-from <go.wigust@HIDDEN>) id 1meLQH-0005Tn-Dx
for 51359 <at> debbugs.gnu.org; Sat, 23 Oct 2021 14:07:15 -0400
Received: by mail-lf1-f52.google.com with SMTP id x27so182432lfu.5
for <51359 <at> debbugs.gnu.org>; Sat, 23 Oct 2021 11:07:13 -0700 (PDT)
DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gmail.com; s=20210112;
h=from:to:cc:subject:date:message-id:mime-version
:content-transfer-encoding;
bh=p1N5eGIcIAPDesvroNuxwf3eg/vywLrFLoTRv2UJ7yU=;
b=b52XcmxWzhPt7CJTqxavolhFBhSOVf0wE5c7XhsqK2LD5IGdsZsuDwN0PdwtPudVrP
ho/4CG3lfdBxueIf1J/zpUSzi5kiysN9AnRlMdPhCO8FLF8vWjMc1nayZni/vbdmbY6Z
PZNB2MKKgJYb5i00KoUN3xi29dCbxaSlarT4EHOV37HYZnKBRlaCVgbXVZ36aLbBrxmp
LyfHo/856WM4dv9fJTJ3bXOHziS8s45vBQB/5CzX3ACah9FM1iL33vdADCTfYtxSgR9K
O/fKBWPed1njITNmu52FwDhDLah6OavRaPTokwKuQK3f8QVNnomY88BgfKcYAVeNaioI
4zdA==
X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed;
d=1e100.net; s=20210112;
h=x-gm-message-state:from:to:cc:subject:date:message-id:mime-version
:content-transfer-encoding;
bh=p1N5eGIcIAPDesvroNuxwf3eg/vywLrFLoTRv2UJ7yU=;
b=T/k8tg1uv1fI2XG4s1hcijsA8zIyQ0UR4YZrIRaQManPENSAP9F+yTUglpgamV6pwS
YGn+SpSjcyvPL0X/TDw+Zf3kiMVJOZL0ICJW9mkzhj7S8xzSOZ3UNtZegFdHxhuBPLmD
elJtpCYfhf8olxt7BHAUVuhqrTTuL0u8dwH7PKHTm0fIL5XtUjKm/uMdN2SSILlSssTd
WaTUZe4+FoCsMY0HFhS+XsyyD9BKgXxwnft+xKTZ9kqlRpx4JbMP87uRn+4tf4AAcWHq
RIUtQpBpnDLaMatXiXhg7/54XtZPMloGuWgsmqtosLzmv239e1hQp5H78eZW0jYyHuHD
i1WA==
X-Gm-Message-State: AOAM531sG7kahJ5vVNqaU9tkrzBD1FpAGiUkyW7IGrrS5UoOcowRmsbC
nRdZ9IFRNdKJTaO44SzI0bb3VehV2GI=
X-Google-Smtp-Source: ABdhPJzy+6MKwAK58Y0RB+7ASlzo3Ea0t7MV0UqsMab6nklUeSp4KNcOHXegjisrvWTIS/WVKt8f2Q==
X-Received: by 2002:a05:6512:314f:: with SMTP id
s15mr6751877lfi.60.1635012425995;
Sat, 23 Oct 2021 11:07:05 -0700 (PDT)
Received: from localhost.localdomain ([88.201.161.72])
by smtp.gmail.com with ESMTPSA id j8sm794171lfe.33.2021.10.23.11.07.05
(version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256);
Sat, 23 Oct 2021 11:07:05 -0700 (PDT)
From: Oleg Pykhalov <go.wigust@HIDDEN>
To: 51359 <at> debbugs.gnu.org
Subject: [PATCH 1/1] home: services: Add state services.
Date: Sat, 23 Oct 2021 21:06:54 +0300
Message-Id: <20211023180654.3760-1-go.wigust@HIDDEN>
X-Mailer: git-send-email 2.33.1
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
X-Spam-Score: 0.0 (/)
X-Debbugs-Envelope-To: 51359
Cc: Oleg Pykhalov <go.wigust@HIDDEN>
X-BeenThere: debbugs-submit <at> debbugs.gnu.org
X-Mailman-Version: 2.1.18
Precedence: list
List-Id: <debbugs-submit.debbugs.gnu.org>
List-Unsubscribe: <https://debbugs.gnu.org/cgi-bin/mailman/options/debbugs-submit>,
<mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=unsubscribe>
List-Archive: <https://debbugs.gnu.org/cgi-bin/mailman/private/debbugs-submit/>
List-Post: <mailto:debbugs-submit <at> debbugs.gnu.org>
List-Help: <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=help>
List-Subscribe: <https://debbugs.gnu.org/cgi-bin/mailman/listinfo/debbugs-submit>,
<mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=subscribe>
Errors-To: debbugs-submit-bounces <at> debbugs.gnu.org
Sender: "Debbugs-submit" <debbugs-submit-bounces <at> debbugs.gnu.org>
X-Spam-Score: -1.0 (-)
* gnu/home.scm (home-environment-compiler): New procedure.
* gnu/home/services/state.scm: New file.
* doc/guix.texi (State Home Services): Document this.
* gnu/home/services/version-control.scm: New file.
* gnu/local.mk (GNU_SYSTEM_MODULES): Add those.
* gnu/home/services/utils.scm
(ini-config?, default-ini-format-section, generic-serialize-ini-config,
generic-serialize-git-ini-config): New procedures.
* gnu/tests/version-control.scm (run-home-state-git-test): New procedure.
(%home-state-git-os, %test-home-state-git): New variables.
* guix/scripts/home.scm
(not-config?, switch-home-program, switch-to-home, local-eval): New procedures.
(save-load-path-excursion): New macro.
(switch-home-program): Use switch-to-home procedure.
* gnu/tests/rsync.scm (run-home-state-rsync-test): New procedures.
(%home-state-rsync-os, %test-home-state-rsync): New variables.
---
doc/guix.texi | 32 ++
gnu/home.scm | 12 +
gnu/home/services/state.scm | 210 ++++++++++++
gnu/home/services/utils.scm | 81 ++++-
gnu/home/services/version-control.scm | 442 ++++++++++++++++++++++++++
gnu/local.mk | 2 +
gnu/tests/rsync.scm | 158 ++++++++-
gnu/tests/version-control.scm | 140 +++++++-
guix/scripts/home.scm | 100 +++++-
9 files changed, 1163 insertions(+), 14 deletions(-)
create mode 100644 gnu/home/services/state.scm
create mode 100644 gnu/home/services/version-control.scm
diff --git a/doc/guix.texi b/doc/guix.texi
index 63bb22764a..c79f3acfa3 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -35548,6 +35548,7 @@ services)}.
* Shells: Shells Home Services. POSIX shells, Bash, Zsh.
* Mcron: Mcron Home Service. Scheduled User's Job Execution.
* Shepherd: Shepherd Home Service. Managing User's Daemons.
+* State: State Home Services. Managing User's states.
@end menu
@c In addition to that Home Services can provide
@@ -35875,6 +35876,37 @@ mechanism instead (@pxref{Shepherd Services}).
@end table
@end deftp
+@node State Home Services
+@subsection Managing User's states
+
+@cindex state
+@cindex rsync
+@cindex git
+@cindex hg
+
+@command{herd init state} will create all the neccessary dirs, will clone the
+Git repos with projects you work on, restore wallpapers dir from backup
+server via Rsync and so on. That helps at least control and init state
+your software depends on, when you switching to new machine for example.
+
+@defvr {Scheme Variable} home-state-service-type
+This is the type of the @code{state} home service, whose value is a list
+of @code{shepherd-service} objects.
+@end defvr
+
+The following examples demonstrate Git and Rsync configuration:
+
+@example
+(home-environment
+ (services
+ (list
+ (service home-state-service-type
+ (list (state-git "/home/alice/guix-maintenance"
+ "https://git.savannah.gnu.org/git/guix/maintenance.git")
+ (state-rsync "/home/alice/output"
+ "rsync://localhost:873/files/input"))))))
+@end example
+
@node Invoking guix home
@section Invoking @code{guix home}
diff --git a/gnu/home.scm b/gnu/home.scm
index d8134693e5..87d4d54b8e 100644
--- a/gnu/home.scm
+++ b/gnu/home.scm
@@ -23,8 +23,10 @@ (define-module (gnu home)
#:use-module (gnu home services xdg)
#:use-module (gnu home services fontutils)
#:use-module (gnu services)
+ #:use-module (guix gexp)
#:use-module (guix records)
#:use-module (guix diagnostics)
+ #:use-module (guix store)
#:export (home-environment
home-environment?
@@ -104,3 +106,13 @@ (define* (home-environment-with-provenance he config-file)
(inherit he)
(services (cons (service home-provenance-service-type config-file)
(home-environment-user-services he)))))
+
+(define-gexp-compiler (home-environment-compiler (he <home-environment>)
+ system target)
+ ((store-lift
+ (lambda (store)
+ ;; XXX: This is not super elegant but we can't pass SYSTEM and TARGET to
+ ;; 'home-environment-derivation'.
+ (run-with-store store (home-environment-derivation he)
+ #:system system
+ #:target target)))))
diff --git a/gnu/home/services/state.scm b/gnu/home/services/state.scm
new file mode 100644
index 0000000000..f78751b10f
--- /dev/null
+++ b/gnu/home/services/state.scm
@@ -0,0 +1,210 @@
+(define-module (gnu home services state)
+ #:use-module (srfi srfi-1)
+ #:use-module (ice-9 match)
+ #:use-module (gnu home services)
+ #:use-module (gnu home services utils)
+ #:use-module (gnu home services shepherd)
+ #:use-module (gnu home services version-control)
+ #:use-module (gnu packages rsync)
+ #:use-module (gnu packages version-control)
+ #:use-module (gnu services shepherd)
+ #:use-module (gnu services configuration)
+ #:use-module (gnu packages ssh)
+ #:use-module (guix packages)
+ #:use-module (guix gexp)
+ #:use-module (guix monads)
+ #:use-module (guix modules)
+ #:use-module (guix records)
+
+ #:export (home-state-service-type
+ state-generic
+ state-git
+ state-hg
+ state-rsync))
+
+(define* (state-hg path remote #:key (config #f))
+ (state-generic
+ path
+ #:init-gexp
+ #~(lambda* (_ self)
+ (let* ((meta (car (action self 'metadata)))
+ (path (assoc-ref meta 'path))
+ (remote (assoc-ref meta 'remote)))
+ (format #t "Initializing ~a.\n" self)
+ (let* ((port ((@@ (guix build utils) open-pipe-with-stderr)
+ #$(file-append mercurial "/bin/hg") "clone" remote path)))
+ (waitpid WAIT_ANY)
+ (display ((@@ (ice-9 rdelim) read-delimited) "" port))
+ (close-port port))
+
+ (when '#$config
+ (call-with-output-file (string-append path "/.hg/hgrc")
+ (lambda (port) (display (string-append
+ #$@(serialize-hg-config config)) port))))))
+ #:additional-metadata `((remote . ,remote)
+ (general-sync? . #f))))
+
+(define* (state-git path remote #:key (config #f))
+ (state-generic
+ path
+ #:init-gexp
+ #~(lambda* (_ self)
+ (let* ((meta (car (action self 'metadata)))
+ (path (assoc-ref meta 'path))
+ (remote (assoc-ref meta 'remote)))
+ (format #t "Initializing ~a.\n" self)
+ ;; TODO: revisit git clone implementation
+ ;; FIXME: Hang up shepherd if username/password asked
+ (let* ((port ((@@ (guix build utils) open-pipe-with-stderr)
+ #$(file-append git "/bin/git") "clone" remote path)))
+ (waitpid WAIT_ANY)
+ (display ((@@ (ice-9 rdelim) read-delimited) "" port))
+ (close-port port))
+
+ (when #$config
+ (call-with-output-file (string-append path "/.git/config")
+ (lambda (port) (display #$config port))))))
+ #:additional-metadata `((remote . ,remote)
+ (general-sync? . #f))))
+
+(define* (state-rsync path remote)
+ (state-generic
+ path
+ #:init-gexp
+ #~(lambda* (_ self)
+ (let* ((meta (car (action self 'metadata)))
+ (path (assoc-ref meta 'path))
+ (remote (assoc-ref meta 'remote)))
+ (format #t "Initializing ~a.\n" self)
+ ;; TODO: revisit git clone implementation
+ (let* ((port ((@@ (guix build utils) open-pipe-with-stderr)
+ #$(file-append rsync "/bin/rsync") "-aP" remote path)))
+ (waitpid WAIT_ANY)
+ (display ((@@ (ice-9 rdelim) read-delimited) "" port))
+ (close-port port))))
+ #:sync-gexp
+ #~(lambda* (_ self)
+ (let* ((meta (car (action self 'metadata)))
+ (path (assoc-ref meta 'path))
+ (remote (assoc-ref meta 'remote)))
+ (format #t "Synchronizing ~a.\n" self)
+ (let* ((port ((@@ (guix build utils) open-pipe-with-stderr)
+ #$(file-append rsync "/bin/rsync") "-aP" path remote)))
+ (waitpid WAIT_ANY)
+ (display ((@@ (ice-9 rdelim) read-delimited) "" port))
+ (close-port port))))
+ #:additional-metadata `((remote . ,remote)
+ (general-sync? . #t))))
+
+(define* (state-generic
+ path
+ #:key
+ (init-gexp
+ #~(lambda* (_ self)
+ (let ((path (assoc-ref (car (action self 'metadata)) 'path)))
+ (format #t "Initializing ~a.\n" self)
+ (format #t "Creating ~a directory..." path)
+ (mkdir-p path)
+ (display " done\n"))))
+ (sync-gexp
+ #~(lambda* (_ self)
+ (let ((path (assoc-ref (car (action self 'metadata)) 'path)))
+ (format #t "Synchronizing ~a.\n" self)
+ (format #t "Nothing to synchronize.\n"))))
+ (additional-metadata '((general-sync? . #f))))
+ "A function which returns a shepherd-service with all required
+actions for state management, should be used as a basis for other
+state related items like git-state, rsync-state, etc."
+ (let ((self (string->symbol
+ (format #f "state-~a" path))))
+ (shepherd-service
+ (documentation (format #f "Managing state at ~a." path))
+ (provision (list self))
+ (auto-start? #f)
+ (start #~(lambda ()
+ (if (car (action '#$self 'state-exists?))
+ #t
+ (begin
+ (format #t "~a is not initilized yet." '#$self)
+ #f))))
+ (actions (list
+ (shepherd-action
+ (name 'state-exists?)
+ (documentation "Check if state file/directory exists.")
+ (procedure #~(lambda* (#:rest rest)
+ (file-exists? #$path))))
+ (shepherd-action
+ (name 'unchecked-init)
+ (documentation "Do not use this action directly.")
+ (procedure init-gexp))
+ (shepherd-action
+ (name 'metadata)
+ (documentation "Returns metadata related to the state.")
+ (procedure #~(lambda* _
+ (append
+ '((path . #$path)
+ (self . #$self))
+ '#$additional-metadata))))
+ (shepherd-action
+ (name 'sync)
+ (documentation "Sync the state.")
+ (procedure sync-gexp))
+ (shepherd-action
+ (name 'init)
+ (documentation "Generic initialize.")
+ (procedure #~(lambda* (#:rest rest)
+ (if (car (action '#$self 'state-exists?))
+ (format #t "~a already initialized.\n" '#$self)
+ (begin
+ (action '#$self 'unchecked-init '#$self)
+ (start '#$self)))))))))))
+
+(define (add-shepherd-services services)
+ (let* ((service-names
+ (map
+ (lambda (service) (car (shepherd-service-provision service)))
+ services)))
+ (append
+ services
+ (list
+ (shepherd-service
+ (documentation "Init, update and maybe destroy state.")
+ (provision '(state))
+ (auto-start? #t)
+ (start #~(lambda ()
+ (map (lambda (name)
+ (when (car (action name 'state-exists?))
+ (start name)))
+ '#$service-names)))
+ (actions (list
+ (shepherd-action
+ (name 'sync)
+ (documentation
+ "Sync all the state. Highly dependent on state type.")
+ (procedure
+ #~(lambda _
+ (map (lambda (name)
+ (when (assoc-ref (car (action name 'metadata))
+ 'general-sync?)
+ (action name 'sync name)))
+ '#$service-names))))
+ (shepherd-action
+ (name 'init)
+ (documentation "Initialize all the state.")
+ (procedure #~(lambda _
+ (map (lambda (name)
+ (when (not (car (action name 'state-exists?)))
+ (action name 'init)
+ (start name)))
+ '#$service-names)))))))))))
+
+(define home-state-service-type
+ (service-type (name 'home-state)
+ (extensions
+ (list (service-extension
+ home-shepherd-service-type
+ add-shepherd-services)))
+ (default-value '())
+ (compose concatenate)
+ (extend append)
+ (description "A toolset for initializing state.")))
diff --git a/gnu/home/services/utils.scm b/gnu/home/services/utils.scm
index cea75ee896..8f2122dda9 100644
--- a/gnu/home/services/utils.scm
+++ b/gnu/home/services/utils.scm
@@ -21,11 +21,17 @@ (define-module (gnu home services utils)
#:use-module (ice-9 string-fun)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-26)
+ #:use-module (ice-9 match)
+ #:use-module (gnu services configuration)
#:export (maybe-object->string
object->snake-case-string
object->camel-case-string
- list->human-readable-list))
+ list->human-readable-list
+
+ ini-config?
+ generic-serialize-ini-config
+ generic-serialize-git-ini-config))
(define (maybe-object->string object)
"Like @code{object->string} but don't do anyting if OBJECT already is
@@ -103,3 +109,76 @@ (define* (list->human-readable-list lst
word
(maybe-object->string (proc (last lst)))))))
+
+;;;
+;;; Serializers.
+;;;
+
+(define ini-config? list?)
+(define (generic-serialize-ini-config-section section proc)
+ "Format a section from SECTION for an INI configuration.
+Apply the procedure PROC on SECTION after it has been converted to a string"
+ (format #f "[~a]\n" (proc section)))
+
+(define default-ini-format-section
+ (match-lambda
+ ((section subsection)
+ (string-append (maybe-object->string section) " "
+ (maybe-object->string subsection)))
+ (section
+ (maybe-object->string section))))
+
+(define* (generic-serialize-ini-config
+ #:key
+ (combine-ini string-join)
+ (combine-alist string-append)
+ (combine-section-alist string-append)
+ (format-section default-ini-format-section)
+ serialize-field
+ fields)
+ "Create an INI configuration from nested lists FIELDS. This uses
+@code{generic-serialize-ini-config-section} and @{generic-serialize-alist} to
+serialize the section and the association lists, respectively.
+
+@example
+(generic-serialize-ini-config
+ #:serialize-field (lambda (a b) (format #f \"~a = ~a\n\" a b))
+ #:format-section (compose string-capitalize symbol->string)
+ #:fields '((application ((key . value)))))
+@end example
+
+@result{} \"[Application]\nkey = value\n\""
+ (combine-ini
+ (map (match-lambda
+ ((section alist)
+ (combine-section-alist
+ (generic-serialize-ini-config-section section format-section)
+ (generic-serialize-alist combine-alist serialize-field alist))))
+ fields)
+ "\n"))
+
+(define* (generic-serialize-git-ini-config
+ #:key
+ (combine-ini string-join)
+ (combine-alist string-append)
+ (combine-section-alist string-append)
+ (format-section default-ini-format-section)
+ serialize-field
+ fields)
+ "Like @code{generic-serialize-ini-config}, but the section can also
+have a @dfn{subsection}. FORMAT-SECTION will take a list of two
+elements: the section and the subsection."
+ (combine-ini
+ (map (match-lambda
+ ((section subsection alist)
+ (combine-section-alist
+ (generic-serialize-ini-config-section
+ (list section subsection) format-section)
+ (generic-serialize-alist combine-alist serialize-field alist)))
+ ((section alist)
+ (combine-section-alist
+ (generic-serialize-ini-config-section section format-section)
+ (generic-serialize-alist combine-alist serialize-field alist))))
+ fields)
+ "\n"))
+
diff --git a/gnu/home/services/version-control.scm b/gnu/home/services/version-control.scm
new file mode 100644
index 0000000000..afc9c539a7
--- /dev/null
+++ b/gnu/home/services/version-control.scm
@@ -0,0 +1,442 @@
+(define-module (gnu home services version-control)
+ #:use-module (srfi srfi-1)
+ #:use-module (srfi srfi-9)
+ #:use-module (srfi srfi-11)
+ #:use-module (srfi srfi-26)
+ #:use-module (ice-9 match)
+ #:use-module (gnu home services)
+ #:use-module (gnu home services utils)
+ #:use-module (gnu services configuration)
+ #:use-module (gnu packages version-control)
+ #:use-module (guix packages)
+ #:use-module (guix gexp)
+ #:use-module (guix records)
+ #:use-module ((guix import utils) #:select (flatten))
+
+ #:export (home-git-configuration
+ home-git-extension
+ home-git-service-type
+ serialize-git-config
+
+ home-hg-configuration
+ home-hg-extension
+ serialize-hg-config
+ home-hg-service-type))
+
+;;; Commentary:
+;;;
+;;; Version control related services.
+;;;
+;;; Code:
+
+;;;
+;;; Git.
+;;;
+;;; (service home-git-service-type
+;;; (home-git-configuration
+;;; (attributes
+;;; '((* . text=auto)
+;;; (*.sh . "text eol=lf")))
+;;; (ignore
+;;; '("*.so" "*.o"))
+;;; (ignore-extra-content
+;;; "*.dll\n*.exe\n")
+;;; (config
+;;; `((http "https://weak.example.com"
+;;; ((ssl-verify . #f)))
+;;; (gpg
+;;; ((program . ,(file-append gnupg "/bin/gpg"))))
+;;; (sendmail
+;;; ((annotate . #t))))
+;;; (config-extra-content (slurp-file-gexp
+;;; (local-file "./gitconfig")))))
+;;;
+;;; (simple-service
+;;; 'add-something-to-git
+;;; home-git-service-type
+;;; (home-git-extension
+;;; (config
+;;; `((sendmail
+;;; ((annotate . #t)))))))
+
+
+(define (uglify-field-name field-name)
+ "Convert symbol FIELD-NAME to a camel case string.
+@code{symbol-name} => \"@code{symbolName}\"."
+ (let* ((str (symbol->string field-name))
+ (spl-str (string-split str #\-)))
+ (apply string-append
+ (car spl-str)
+ (map string-capitalize (cdr spl-str)))))
+
+(define (serialize-field field-name val)
+ (cond
+ ((boolean? val) (serialize-boolean field-name val))
+ (else
+ (list (format #f "\t~a = " (uglify-field-name field-name))
+ val "\n"))))
+
+(define (serialize-alist field-name val)
+ (generic-serialize-alist append serialize-field val))
+
+(define (serialize-boolean field-name val)
+ (serialize-field field-name (if val "true" "false")))
+
+(define serialize-string serialize-field)
+(define git-config? list?)
+
+(define (serialize-git-section-header name value)
+ (format #f "[~a~a]\n" (uglify-field-name name)
+ (if value (format #f " \"~a\"" value) "")))
+
+(define serialize-git-section
+ (match-lambda
+ ((name options)
+ (cons
+ (serialize-git-section-header name #f)
+ (serialize-alist #f options)))
+ ((name value options)
+ (cons
+ (serialize-git-section-header name value)
+ (serialize-alist #f options)))))
+
+;; TODO: cover it with tests
+(define (serialize-git-config field-name val)
+ #~(string-append #$@(append-map serialize-git-section val)))
+
+(define (git-ignore? patterns)
+ (list-of-strings? patterns))
+(define (serialize-git-ignore field-name val)
+ (string-join val "\n" 'suffix))
+
+(define (git-attributes? attrs)
+ (list? attrs))
+(define (serialize-git-attributes field-name val)
+ (string-join
+ (map
+ (match-lambda
+ ((key . value) (format #f "~a\t~a" key value)))
+ val)
+ "\n"
+ 'suffix))
+
+(define-configuration home-git-extension
+ (attributes
+ (git-attributes '())
+ "Alist of pattern attribute pairs for @file{git/attributes.}")
+ (ignore
+ (git-ignore '())
+ "List of patterns for @file{git/ignore.}")
+ (config
+ (git-config '())
+ "List of git sections. The same format as in
+@code{home-git-configuration}."))
+
+(define-configuration home-git-configuration
+ (package
+ (package git)
+ "The Git package to use.")
+ (attributes
+ (git-attributes '())
+ "Alist of pattern attribute pairs for @file{git/attributes.}")
+ (attributes-extra-content
+ (text-config "")
+ "String or value of string-valued g-exps will be added to the end
+of the @file{git/attributes} file.")
+ (ignore
+ (git-ignore '())
+ "List of patterns for git/ignore.")
+ (ignore-extra-content
+ (text-config "")
+ "String or value of string-valued g-exps will be added to the end
+of the git/ignore file.")
+ (config
+ (git-config '())
+ "List of sections and corresponding options. Something like this:
+
+@lisp
+`((sendmail
+ ((annotate . #t))))
+@end lisp
+
+will turn into this:
+
+@example
+[sendmail]
+ annotate = true
+@end example")
+ (config-extra-content
+ (text-config "")
+ "String or value of string-valued g-exps will be added to the end
+of the configuration file."))
+
+(define (add-git-configuration config)
+ (define (filter-fields fields)
+ (filter-configuration-fields home-git-configuration-fields fields))
+ `(("config/git/attributes"
+ ,(mixed-text-file
+ "git-attributes"
+ (serialize-configuration
+ config
+ (filter-fields '(attributes)))
+ (home-git-configuration-attributes-extra-content config)))
+ ("config/git/ignore"
+ ,(mixed-text-file
+ "git-ignore"
+ (serialize-configuration
+ config
+ (filter-fields '(ignore)))
+ (home-git-configuration-ignore-extra-content config)))
+ ("config/git/config"
+ ,(mixed-text-file
+ "git-config"
+ (serialize-configuration
+ config
+ (filter-fields '(config)))
+ (home-git-configuration-config-extra-content config)))))
+
+(define (add-git-packages config)
+ (list (home-git-configuration-package config)))
+
+(define (home-git-extensions original-config extension-configs)
+ (home-git-configuration
+ (inherit original-config)
+ (attributes
+ (append (home-git-configuration-attributes original-config)
+ (append-map
+ home-git-extension-attributes extension-configs)))
+ (ignore
+ (append (home-git-configuration-ignore original-config)
+ (append-map
+ home-git-extension-ignore extension-configs)))
+ (config
+ (append (home-git-configuration-config original-config)
+ (append-map
+ home-git-extension-config extension-configs)))))
+
+(define home-git-service-type
+ (service-type (name 'home-git)
+ (extensions
+ (list (service-extension
+ home-files-service-type
+ add-git-configuration)
+ (service-extension
+ home-profile-service-type
+ add-git-packages)))
+ (compose identity)
+ (extend home-git-extensions)
+ (default-value (home-git-configuration))
+ (description "Install and configure Git.")))
+
+(define (generate-home-git-documentation)
+ (generate-documentation
+ `((home-git-configuration
+ ,home-git-configuration-fields))
+ 'home-git-configuration))
+
+
+;;;
+;;; Mercurial.
+;;;
+;;; (home-hg-configuration
+;;; (regexp-ignore '("^\\.pc/"))
+;;; (glob-ignore '("*.elc" "*~"))
+;;; (config
+;;; '((commands
+;;; ((commit.post-status . #t)))
+;;; (ui
+;;; ((username . "Alice Bobson <charlie@HIDDEN")))
+;;; (defaults
+;;; (log . "-v")))))
+;;;
+
+;; TODO: Add separate field for name and email?
+(define-configuration/no-serialization home-hg-configuration
+ (package
+ (package mercurial)
+ "The Mercurial package to use.")
+ (regexp-ignore
+ (list-of-strings '())
+ "List of regular expressions to ignore globally. The default syntax
+is Python/Perl-style regular expression (see @command{man 5 hgignore}).
+
+The @code{*-ignore} fields are equivalent to adding @code{ui.ignore =
+/file/with/ignore/rules} in your @file{hgrc}.")
+ (glob-ignore
+ (list-of-strings '())
+ "List of globs to ignore globally.")
+ (rootglob-ignore
+ (list-of-strings '())
+ "List of @dfn{rootglobs} to ignore globally.")
+ (config
+ (ini-config '())
+ "List of list representing the contents of the @file{hgrc}
+configuration file. The syntax is similar to that of the Git service.
+The key of a pair can be a symbol or string, and the value can be a
+boolean, string, symbol, number, gexp (@pxref{gexp,,,guix.info}), or a
+list of one the above.
+
+@lisp
+(config
+ `((commands
+ ((commit.post-status . #t)))
+ (graph
+ ((width . 4)))
+ (hooks
+ ((incoming.email . ,(local-file \"/path/to/email/hook\"))))))
+@end lisp
+
+will turn into this:
+
+@example
+[commands]
+ commit.post-status = True
+[graph]
+ width = 4
+[hooks]
+ incoming.email = /gnu/store/123...-email-hook
+@end example"))
+
+(define (serialize-hg-config config)
+ (define (serialize-boolean val)
+ (list (if val "True" "False")))
+
+ (define (serialize-list val)
+ (interpose (map serialize-val val) ", "))
+
+ (define (serialize-val val)
+ (cond
+ ((list? val) (serialize-list val))
+ ((boolean? val) (serialize-boolean val))
+ ((or (number? val) (symbol? val)) (list (maybe-object->string val)))
+ (else (list val))))
+
+ (define (serialize-field key val)
+ (let ((val (serialize-val val))
+ (key (symbol->string key)))
+ `(,key " = " ,@val "\n")))
+
+ (flatten (generic-serialize-ini-config
+ #:combine-ini interpose
+ #:combine-alist list
+ #:combine-section-alist cons
+ #:serialize-field serialize-field
+ #:fields config)))
+
+(define* (serialize-hg-ignores #:key regexp glob rootglob)
+ (define (add-ignore lst type)
+ (if (not (null? lst))
+ (string-append (format #f "syntax: ~a\n" type)
+ (string-join lst "\n" 'suffix))
+ ""))
+
+ (string-join (map (cut add-ignore <> <>)
+ (list regexp glob rootglob)
+ '(regexp glob rootglob))
+ "\n"))
+
+(define (home-hg-files-service config)
+ (define rest cdr)
+
+ (define (compare-sections section1 section2)
+ (string<? (symbol->string (first section1))
+ (symbol->string (first section2))))
+
+ (define (fold-sections section1 section2)
+ (cond
+ ((equal? (first section1) (first section2))
+ (list (list (first section1)
+ (append (second section1) (second section2)))))
+ (else
+ (list section1 section2))))
+
+ (define (merge-sections config)
+ (let ((sorted-config (sort config compare-sections)))
+ (fold (lambda (section acc)
+ (if (null? acc)
+ (list section)
+ (append (fold-sections section (first acc))
+ (rest acc))))
+ '()
+ sorted-config)))
+
+ (let* ((ignores (serialize-hg-ignores
+ #:regexp
+ (home-hg-configuration-regexp-ignore config)
+ #:glob
+ (home-hg-configuration-glob-ignore config)
+ #:rootglob
+ (home-hg-configuration-rootglob-ignore config)))
+ (final-config (merge-sections
+ (append (home-hg-configuration-config config)
+ `((ui
+ ((ignore . ,(plain-file "hg-ignores"
+ ignores)))))))))
+ `(("config/hg/hgrc"
+ ,(apply mixed-text-file
+ "hgrc"
+ (serialize-hg-config final-config))))))
+
+(define-configuration/no-serialization home-hg-extension
+ (regexp-ignore
+ (list-of-strings '())
+ "List of regular expressions to ignore globally.")
+ (glob-ignore
+ (list-of-strings '())
+ "List of glob expressions to ignore globally.")
+ (rootglob-ignore
+ (list-of-strings '())
+ "List of @dfn{rootglobs} to ignore globally.")
+ (config
+ (ini-config '())
+ "List of lists representing the contents of the @file{hgrc} file."))
+
+(define (home-hg-extensions original-config extension-configs)
+ (home-hg-configuration
+ (inherit original-config)
+ (regexp-ignore
+ (append (home-hg-configuration-regexp-ignore original-config)
+ (append-map
+ home-hg-extension-regexp-ignore extension-configs)))
+ (glob-ignore
+ (append (home-hg-configuration-glob-ignore original-config)
+ (append-map
+ home-hg-extension-glob-ignore extension-configs)))
+ (rootglob-ignore
+ (append (home-hg-configuration-rootglob-ignore original-config)
+ (append-map
+ home-hg-extension-rootglob-ignore extension-configs)))
+ (config
+ (append (home-hg-configuration-config original-config)
+ (append-map
+ home-hg-extension-config extension-configs)))))
+
+(define (home-hg-profile-service config)
+ (list (home-hg-configuration-package config)))
+
+(define home-hg-service-type
+ (service-type (name 'home-hg)
+ (extensions
+ (list (service-extension
+ home-files-service-type
+ home-hg-files-service)
+ (service-extension
+ home-profile-service-type
+ home-hg-profile-service)))
+ (compose identity)
+ (extend home-hg-extensions)
+ (default-value (home-hg-configuration))
+ (description "\
+Install and configure the Mercurial version control system.")))
+
+(define (generate-home-hg-documentation)
+ (string-append
+ (generate-documentation
+ `((home-hg-configuration
+ ,home-hg-configuration-fields))
+ 'home-hg-configuration)
+ "\n\n"
+ (generate-documentation
+ `((home-hg-extension
+ ,home-hg-extension-fields))
+ 'home-hg-extension)))
diff --git a/gnu/local.mk b/gnu/local.mk
index d432829e2d..4ac1083158 100644
--- a/gnu/local.mk
+++ b/gnu/local.mk
@@ -79,7 +79,9 @@ GNU_SYSTEM_MODULES = \
%D%/home/services/fontutils.scm \
%D%/home/services/shells.scm \
%D%/home/services/shepherd.scm \
+ %D%/home/services/state.scm \
%D%/home/services/mcron.scm \
+ %D%/home/services/version-control.scm \
%D%/home/services/utils.scm \
%D%/home/services/xdg.scm \
%D%/image.scm \
diff --git a/gnu/tests/rsync.scm b/gnu/tests/rsync.scm
index 24e60d9d9d..8b4768a38a 100644
--- a/gnu/tests/rsync.scm
+++ b/gnu/tests/rsync.scm
@@ -1,6 +1,7 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2017 Christopher Baines <mail@HIDDEN>
;;; Copyright © 2018 Clément Lassieur <clement@HIDDEN>
+;;; Copyright © 2021 Oleg Pykhalov <go.wigust@HIDDEN>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -29,7 +30,13 @@ (define-module (gnu tests rsync)
#:use-module (gnu services networking)
#:use-module (guix gexp)
#:use-module (guix store)
- #:export (%test-rsync))
+ #:use-module (gnu home)
+ #:use-module (gnu services)
+ #:use-module (gnu home services)
+ #:use-module (gnu home services state)
+ #:use-module (guix scripts home)
+ #:export (%test-rsync
+ %test-home-state-rsync))
(define* (run-rsync-test rsync-os #:optional (rsync-port 873))
"Run tests in %RSYNC-OS, which has rsync running and listening on
@@ -127,3 +134,152 @@ (define %test-rsync
(name "rsync")
(description "Connect to a running RSYNC server.")
(value (run-rsync-test %rsync-os))))
+
+
+;;;
+;;; Home
+;;;
+
+(define* (run-home-state-rsync-test home-state-rsync-os #:optional (rsync-port 873))
+ "Run tests in %HOME-STATE-RSYNC-OS, which has rsync running and listening on
+PORT."
+ (define os
+ (marionette-operating-system
+ home-state-rsync-os
+ #:imported-modules '((gnu services herd)
+ (guix combinators))))
+
+ (define vm
+ (virtual-machine
+ (operating-system os)
+ (port-forwardings '())))
+
+ (define he
+ (home-environment
+ (services
+ (list
+ (service home-state-service-type
+ (list
+ (state-rsync "/home/alice/test"
+ (string-append "rsync://localhost:"
+ (number->string rsync-port)
+ "/files/input"))))))))
+
+ (define (test script)
+ (with-imported-modules '((gnu build marionette)
+ (guix build utils))
+ #~(begin
+ (use-modules (srfi srfi-11)
+ (srfi srfi-64)
+ (gnu build marionette)
+ (guix build utils))
+
+ (define marionette
+ (make-marionette (list #$vm)))
+
+ (mkdir #$output)
+ (chdir #$output)
+
+ (test-begin "home-state-rsync")
+
+ ;; Wait for rsync to be up and running.
+ (test-assert "service running"
+ (marionette-eval
+ '(begin
+ (use-modules (gnu services herd))
+
+ ;; Make sure the 'rsync' command is found.
+ (setenv "PATH" "/run/current-system/profile/bin")
+
+ (start-service 'rsync))
+ marionette))
+
+ ;; Make sure the PID file is created.
+ (test-assert "PID file"
+ (marionette-eval
+ '(file-exists? "/var/run/rsyncd/rsyncd.pid")
+ marionette))
+
+ (test-assert "Test file copied to share"
+ (marionette-eval
+ '(begin
+ (call-with-output-file "/tmp/input"
+ (lambda (port)
+ (display "test-file-contents\n" port)))
+ (zero?
+ (system* "rsync" "/tmp/input"
+ (string-append "rsync://localhost:"
+ (number->string #$rsync-port)
+ "/files/input"))))
+ marionette))
+
+ ;; XXX: Create /run/user/1000 and /var/guix/profiles/per-user/alice
+ ;; directories.
+ (test-assert "profile and XDG_RUNTIME_DIR directories"
+ (marionette-eval
+ '(begin
+ (for-each (lambda (directory)
+ (mkdir directory)
+ (chown directory
+ (passwd:uid (getpw "alice"))
+ (group:gid (getpw "alice"))))
+ '("/var/guix/profiles/per-user/alice"
+ "/run/user"
+ "/run/user/1000")))
+ marionette))
+
+ ;; Add /run/setuid-programs to $PATH so that the scripts
+ ;; can find 'env' and 'sudo'.
+ (marionette-eval
+ '(setenv "PATH"
+ "/run/setuid-programs:/run/current-system/profile/bin")
+ marionette)
+
+ (test-assert "script successfully evaluated"
+ (marionette-eval
+ '(begin
+ (system* "sudo" "--user" "alice" "--login"
+ "XDG_RUNTIME_DIR=/run/user/1000" "--" #$script))
+ marionette))
+
+ ;; Clone the repo.
+ (test-assert "herd init state"
+ (marionette-eval
+ '(begin
+ (invoke "sudo" "--user" "alice" "--login"
+ "--" "herd" "init" "state"))
+ marionette))
+
+ (test-equal "Test file correctly received from share"
+ "test-file-contents"
+ (marionette-eval
+ '(begin
+ (use-modules (ice-9 rdelim))
+ (call-with-input-file "/home/alice/test"
+ (lambda (port)
+ (read-line port))))
+ marionette))
+
+ (test-end)
+ (exit (= (test-runner-fail-count (test-runner-current)) 0)))))
+
+ (gexp->derivation "home-state-rsync-test"
+ (test
+ (switch-home-program he "/var/guix/profiles/per-user/alice/guix-home"))))
+
+(define* %home-state-rsync-os
+ ;; Return operating system under test.
+ (let ((base-os
+ (simple-operating-system
+ (service dhcp-client-service-type)
+ (service rsync-service-type))))
+ (operating-system
+ (inherit base-os)
+ (packages (cons* rsync
+ (operating-system-packages base-os))))))
+
+(define %test-home-state-rsync
+ (system-test
+ (name "home-state-rsync")
+ (description "Connect to a running RSYNC server.")
+ (value (run-home-state-rsync-test %home-state-rsync-os))))
diff --git a/gnu/tests/version-control.scm b/gnu/tests/version-control.scm
index a7cde1f163..9b461d3877 100644
--- a/gnu/tests/version-control.scm
+++ b/gnu/tests/version-control.scm
@@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2017, 2018 Oleg Pykhalov <go.wigust@HIDDEN>
+;;; Copyright © 2017, 2018, 2021 Oleg Pykhalov <go.wigust@HIDDEN>
;;; Copyright © 2017, 2018, 2020 Ludovic Courtès <ludo@HIDDEN>
;;; Copyright © 2017, 2018 Clément Lassieur <clement@HIDDEN>
;;; Copyright © 2018 Christopher Baines <mail@HIDDEN>
@@ -36,10 +36,16 @@ (define-module (gnu tests version-control)
#:use-module (guix gexp)
#:use-module (guix store)
#:use-module (guix modules)
+ #:use-module (gnu home)
+ #:use-module (gnu services)
+ #:use-module (gnu home services)
+ #:use-module (gnu home services state)
+ #:use-module (guix scripts home)
#:export (%test-cgit
%test-git-http
%test-gitolite
- %test-gitile))
+ %test-gitile
+ %test-home-state-git))
(define README-contents
"Hello! This is what goes inside the 'README' file.")
@@ -550,3 +556,133 @@ (define %test-gitile
(name "gitile")
(description "Connect to a running Gitile server.")
(value (run-gitile-test))))
+
+
+;;;
+;;; Home
+;;;
+
+(define* (run-home-state-git-test home-state-git-os)
+ "Run tests in %HOME-STATE-GIT-OS, which has Guix home configuration with
+service for Git repository management."
+ (define os
+ (marionette-operating-system
+ home-state-git-os
+ #:imported-modules '((gnu services herd)
+ (guix combinators))))
+
+ (define vm
+ (virtual-machine
+ (operating-system os)
+ (port-forwardings '())))
+
+ (define he
+ (home-environment
+ (services
+ (list
+ (service home-state-service-type
+ (list (state-git "/home/alice/test"
+ "file:///srv/git/test")))))))
+
+ (define (test script)
+ (with-imported-modules '((gnu build marionette)
+ (guix build utils))
+ #~(begin
+ (use-modules (gnu build marionette)
+ (guix build utils)
+ (ice-9 popen)
+ (ice-9 rdelim)
+ (rnrs io ports)
+ (srfi srfi-64))
+
+ (define marionette
+ (make-marionette (list #$vm)))
+
+ (mkdir #$output)
+ (chdir #$output)
+
+ (test-begin "home-state-git")
+
+ ;; Make sure Git test repository is created.
+ (test-assert "Git test repository"
+ (marionette-eval
+ '(file-exists? "/srv/git/test")
+ marionette))
+
+ ;; XXX: Create /run/user/1000 and /var/guix/profiles/per-user/alice
+ ;; directories.
+ (test-assert "profile and XDG_RUNTIME_DIR directories"
+ (marionette-eval
+ '(begin
+ (for-each (lambda (directory)
+ (mkdir directory)
+ (chown directory
+ (passwd:uid (getpw "alice"))
+ (group:gid (getpw "alice"))))
+ '("/var/guix/profiles/per-user/alice"
+ "/run/user"
+ "/run/user/1000")))
+ marionette))
+
+ ;; Add /run/setuid-programs to $PATH so that the scripts
+ ;; can find 'env' and 'sudo'.
+ (marionette-eval
+ '(setenv "PATH"
+ "/run/setuid-programs:/run/current-system/profile/bin")
+ marionette)
+
+ (test-assert "script successfully evaluated"
+ (marionette-eval
+ '(begin
+ (system* "sudo" "--user" "alice" "--login"
+ "XDG_RUNTIME_DIR=/run/user/1000" "--" #$script))
+ marionette))
+
+ ;; Clone the repo.
+ (test-assert "herd init state"
+ (marionette-eval
+ '(begin
+ (invoke "sudo" "--user" "alice" "--login"
+ "--" "herd" "init" "state"))
+ marionette))
+
+ (test-equal "repo clonned"
+ '#$README-contents
+ (marionette-eval
+ '(begin
+ (call-with-input-file "/home/alice/test/README"
+ get-string-all))
+ marionette))
+
+ (test-end)
+ (exit (= (test-runner-fail-count (test-runner-current)) 0)))))
+
+ (gexp->derivation "home-state-git-test"
+ (test
+ (switch-home-program he "/var/guix/profiles/per-user/alice/guix-home"))))
+
+(define* %home-state-git-os
+ ;; Return operating system under test.
+ (let ((base-os
+ (simple-operating-system
+ (service dhcp-client-service-type)
+ %test-repository-service)))
+ (operating-system
+ (inherit base-os)
+
+ ;; Set a user account; the test needs it.
+ (users (cons (user-account
+ (name "alice")
+ (group "users")
+ (uid 1000)
+ (home-directory "/home/alice"))
+ %base-user-accounts))
+
+ (packages (cons* git
+ (operating-system-packages base-os))))))
+
+(define %test-home-state-git
+ (system-test
+ (name "home-state-git")
+ (description "Manage Git repository via Guix home.")
+ (value (run-home-state-git-test %home-state-git-os))))
diff --git a/guix/scripts/home.scm b/guix/scripts/home.scm
index 55e7b436c1..0136dd3afc 100644
--- a/guix/scripts/home.scm
+++ b/guix/scripts/home.scm
@@ -25,9 +25,12 @@ (define-module (guix scripts home)
#:use-module (gnu packages)
#:use-module (gnu home)
#:use-module (gnu home services)
+ #:use-module ((guix self) #:select (make-config.scm))
+ #:use-module (gnu packages gnupg)
#:use-module (guix channels)
#:use-module (guix derivations)
#:use-module (guix ui)
+ #:use-module (guix modules)
#:use-module (guix grafts)
#:use-module (guix packages)
#:use-module (guix profiles)
@@ -47,7 +50,8 @@ (define-module (guix scripts home)
#:use-module (srfi srfi-35)
#:use-module (srfi srfi-37)
#:use-module (ice-9 match)
- #:export (guix-home))
+ #:export (guix-home
+ switch-home-program))
;;;
@@ -139,11 +143,94 @@ (define %default-options
(verbosity . 3)
(debug . 0)))
+
+;;;
+;;; Profile creation.
+;;;
+
+(define not-config?
+ ;; Select (guix …) and (gnu …) modules, except (guix config).
+ (match-lambda
+ (('guix 'config) #f)
+ (('guix rest ...) #t)
+ (('gnu rest ...) #t)
+ (_ #f)))
+
+(define* (switch-home-program he-out-path #:optional (profile %guix-home))
+ "Return an executable store item that, upon being evaluated, will create a
+new generation of PROFILE pointing to the directory of HOME, switch to it
+atomically, and run HOME's activation script."
+ (program-file
+ "switch-to-home.scm"
+ (with-extensions (list guile-gcrypt)
+ (with-imported-modules `(,@(source-module-closure
+ '((guix profiles)
+ (guix utils))
+ #:select? not-config?)
+ ((guix config) => ,(make-config.scm)))
+ #~(begin
+ (use-modules (guix config)
+ (guix profiles)
+ (guix utils))
+ (let* ((number (generation-number #$profile))
+ (generation (generation-file-name
+ #$profile (+ 1 number))))
+ (use-modules (ice-9 rdelim)
+ (ice-9 popen))
+ (with-output-to-file "/tmp/out.txt"
+ (lambda ()
+ (display "he-out-path:\n")
+ (display #$he-out-path)
+ (display "\nprofile:\n")
+ (display #$profile)
+ (display "\ngeneration:\n")
+ (display generation)
+ (let* ((port
+ (open-pipe (format #f "/run/current-system/profile/bin/ls -laR ~a" #$he-out-path)
+ OPEN_READ))
+ (output (read-string port)))
+ (close-port port)
+ (pk (string-trim-right output #\newline)))))
+ (switch-symlinks generation #$he-out-path)
+ (switch-symlinks #$profile generation)
+ (setenv "GUIX_NEW_HOME" #$he-out-path)
+ (primitive-load (string-append #$he-out-path "/activate"))
+ (setenv "GUIX_NEW_HOME" #f)))))))
+
+(define* (switch-to-home eval he-out-path)
+ "Using EVAL, a monadic procedure taking a single G-Expression as an argument,
+create a new generation of PROFILE pointing to the directory of HOME, switch to
+it atomically, and run HOME's activation script."
+ (eval #~(parameterize ((current-warning-port (%make-void-port "w")))
+ (primitive-load #$(switch-home-program he-out-path)))))
+
;;;
;;; Actions.
;;;
+(define-syntax-rule (save-load-path-excursion body ...)
+ "Save the current values of '%load-path' and '%load-compiled-path', run
+BODY..., and restore them."
+ (let ((path %load-path)
+ (cpath %load-compiled-path))
+ (dynamic-wind
+ (const #t)
+ (lambda ()
+ body ...)
+ (lambda ()
+ (set! %load-path path)
+ (set! %load-compiled-path cpath)))))
+
+(define (local-eval exp)
+ "Evaluate EXP, a G-Expression, in-place."
+ (mlet* %store-monad ((lowered (lower-gexp exp))
+ (_ (built-derivations (lowered-gexp-inputs lowered))))
+ (save-load-path-excursion
+ (set! %load-path (lowered-gexp-load-path lowered))
+ (set! %load-compiled-path (lowered-gexp-load-compiled-path lowered))
+ (return (primitive-eval (lowered-gexp-sexp lowered))))))
+
(define* (perform-action action he
#:key
dry-run?
@@ -170,15 +257,8 @@ (define println
(case action
((reconfigure)
- (let* ((number (generation-number %guix-home))
- (generation (generation-file-name
- %guix-home (+ 1 number))))
-
- (switch-symlinks generation he-out-path)
- (switch-symlinks %guix-home generation)
- (setenv "GUIX_NEW_HOME" he-out-path)
- (primitive-load (string-append he-out-path "/activate"))
- (setenv "GUIX_NEW_HOME" #f)
+ (mbegin %store-monad
+ (switch-to-home local-eval he-out-path)
(return he-out-path)))
(else
(newline)
--
2.33.1
guix-patches@HIDDEN:bug#51359; Package guix-patches.
Full text available.
Received: (at submit) by debbugs.gnu.org; 23 Oct 2021 18:05:14 +0000
From debbugs-submit-bounces <at> debbugs.gnu.org Sat Oct 23 14:05:14 2021
Received: from localhost ([127.0.0.1]:37178 helo=debbugs.gnu.org)
by debbugs.gnu.org with esmtp (Exim 4.84_2)
(envelope-from <debbugs-submit-bounces <at> debbugs.gnu.org>)
id 1meLOL-0005QJ-J1
for submit <at> debbugs.gnu.org; Sat, 23 Oct 2021 14:05:13 -0400
Received: from lists.gnu.org ([209.51.188.17]:60354)
by debbugs.gnu.org with esmtp (Exim 4.84_2)
(envelope-from <go.wigust@HIDDEN>) id 1meLOJ-0005Q8-Bh
for submit <at> debbugs.gnu.org; Sat, 23 Oct 2021 14:05:13 -0400
Received: from eggs.gnu.org ([2001:470:142:3::10]:54396)
by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256)
(Exim 4.90_1) (envelope-from <go.wigust@HIDDEN>)
id 1meLOH-00033f-UE
for guix-patches@HIDDEN; Sat, 23 Oct 2021 14:05:11 -0400
Received: from mail-lf1-x135.google.com ([2a00:1450:4864:20::135]:41839)
by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128)
(Exim 4.90_1) (envelope-from <go.wigust@HIDDEN>)
id 1meLOF-00026W-5x
for guix-patches@HIDDEN; Sat, 23 Oct 2021 14:05:09 -0400
Received: by mail-lf1-x135.google.com with SMTP id u21so3291430lff.8
for <guix-patches@HIDDEN>; Sat, 23 Oct 2021 11:05:05 -0700 (PDT)
DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gmail.com; s=20210112;
h=from:to:cc:subject:date:message-id:mime-version
:content-transfer-encoding;
bh=7AeuwcPXmQBf2FKTRYvP4CiVWd25EqYOQhaqCUftjgQ=;
b=Kya335JOCj0xt2ko9Wb1C3Z461D03zZf18d7ttTSVzo09Ys7VzSiRbl9TYEhtHyoj2
R6GU3lm1Kk3GB/AimjqroXyhy7eaxtTAegtxPGV5XkU3r775gbYyhCd7BUKhP/KIATbJ
jIhUit5H52vqdHK0eOEXCgyHPUZeQjkHlB/HpGcbwv1DaQ8C6KD9Ed9FkOoIJR23OXcx
kKqCKeDYL+glTm/NavYYStnB9AWF0GZU5aY+hC+s97MCopXbtqmHP0YATgF2sYUD/SU3
WykjXBAFSKcaR65/D+wZTA2REru0zZaFw3p+rPRL/26Ng4E3TVCuT6jnoj0x1qQlg9aW
g6gw==
X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed;
d=1e100.net; s=20210112;
h=x-gm-message-state:from:to:cc:subject:date:message-id:mime-version
:content-transfer-encoding;
bh=7AeuwcPXmQBf2FKTRYvP4CiVWd25EqYOQhaqCUftjgQ=;
b=hu1kn0ivbKtsdR7qKF+HAWgzqAMF+erZ4hGWaHO3Va97LsSC/d8PV8zJCr3eXlbxaU
o+c+ipHjttHmTcvV5uugP3rFPHTUSx7cpQjPzjLAWzW2K59d1kSYb/PpjuV2GSMO1rHx
/w1VI4glFX5vYy2WoOI0TqwxFWo+Eg9kidnpqXQeGJFgAGlHmlUeWFC6gx+3ycvPxwG/
jVz3QnAjexP0/RK/A7TOiRuAKmZuZruerHeFIUtzgIAqk2fbqcT2h44jb21NKeQPdhnA
/Z5Bmgtyy8g4wC0t/g1UB7OTSY9w9l84oG/JWmRbtIDQTaLya6Ra3pq07xWTkmwyKy12
PVug==
X-Gm-Message-State: AOAM533Og8XtNyBLf2llR8pBROxh439+85irJ6S/y760ZCz4lxfK9h15
TL4EgX/XzqiIxkscnlBt/jVAAVB8VNI=
X-Google-Smtp-Source: ABdhPJzXjV8+PI8RZjrjRvqQ9pjGxSIoD4IXab3tIW3jvuA3dJkGPhIZ7pcWVl5rspCLnzU6in39rg==
X-Received: by 2002:a05:6512:2115:: with SMTP id
q21mr7015235lfr.659.1635012304366;
Sat, 23 Oct 2021 11:05:04 -0700 (PDT)
Received: from localhost.localdomain ([88.201.161.72])
by smtp.gmail.com with ESMTPSA id y26sm860942lja.91.2021.10.23.11.05.03
(version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256);
Sat, 23 Oct 2021 11:05:04 -0700 (PDT)
From: Oleg Pykhalov <go.wigust@HIDDEN>
To: guix-patches@HIDDEN
Subject: [PATCH 0/1] home-state-service-type and tests suite
Date: Sat, 23 Oct 2021 21:04:46 +0300
Message-Id: <20211023180446.3362-1-go.wigust@HIDDEN>
X-Mailer: git-send-email 2.33.1
MIME-Version: 1.0
Content-Transfer-Encoding: 8bit
Received-SPF: pass client-ip=2a00:1450:4864:20::135;
envelope-from=go.wigust@HIDDEN; helo=mail-lf1-x135.google.com
X-Spam_score_int: -20
X-Spam_score: -2.1
X-Spam_bar: --
X-Spam_report: (-2.1 / 5.0 requ) BAYES_00=-1.9, DKIM_SIGNED=0.1,
DKIM_VALID=-0.1, DKIM_VALID_AU=-0.1, DKIM_VALID_EF=-0.1, FREEMAIL_FROM=0.001,
RCVD_IN_DNSWL_NONE=-0.0001, SPF_HELO_NONE=0.001,
SPF_PASS=-0.001 autolearn=ham autolearn_force=no
X-Spam_action: no action
X-Spam-Score: -1.3 (-)
X-Debbugs-Envelope-To: submit
Cc: Oleg Pykhalov <go.wigust@HIDDEN>
X-BeenThere: debbugs-submit <at> debbugs.gnu.org
X-Mailman-Version: 2.1.18
Precedence: list
List-Id: <debbugs-submit.debbugs.gnu.org>
List-Unsubscribe: <https://debbugs.gnu.org/cgi-bin/mailman/options/debbugs-submit>,
<mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=unsubscribe>
List-Archive: <https://debbugs.gnu.org/cgi-bin/mailman/private/debbugs-submit/>
List-Post: <mailto:debbugs-submit <at> debbugs.gnu.org>
List-Help: <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=help>
List-Subscribe: <https://debbugs.gnu.org/cgi-bin/mailman/listinfo/debbugs-submit>,
<mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=subscribe>
Errors-To: debbugs-submit-bounces <at> debbugs.gnu.org
Sender: "Debbugs-submit" <debbugs-submit-bounces <at> debbugs.gnu.org>
X-Spam-Score: -2.3 (--)
Hi Guix,
This patch adds support for home-state-service-type which copied from the rde
project [1]. The introduction to home state services in documentation is
copied from discussion [2].
Tests passed:
make check-system TESTS="home-state-git"
make check-system TESTS="home-state-rsync"
[1] https://github.com/abcdw/rde/
[2] https://lists.sr.ht/~abcdw/rde-devel/%3C87pmzze9nn.fsf%40trop.in%3E#%3CCABrWRW1Fq-8mS=MbWJedUpayj1vFg-YE0oNF3zVTYWBMnp29Lg@HIDDEN%3E
Oleg Pykhalov (1):
home: services: Add state services.
doc/guix.texi | 32 ++
gnu/home.scm | 12 +
gnu/home/services/state.scm | 210 ++++++++++++
gnu/home/services/utils.scm | 81 ++++-
gnu/home/services/version-control.scm | 442 ++++++++++++++++++++++++++
gnu/local.mk | 2 +
gnu/tests/rsync.scm | 158 ++++++++-
gnu/tests/version-control.scm | 140 +++++++-
guix/scripts/home.scm | 100 +++++-
9 files changed, 1163 insertions(+), 14 deletions(-)
create mode 100644 gnu/home/services/state.scm
create mode 100644 gnu/home/services/version-control.scm
--
2.33.1
Oleg Pykhalov <go.wigust@HIDDEN>:guix-patches@HIDDEN.
Full text available.guix-patches@HIDDEN:bug#51359; Package guix-patches.
Full text available.
GNU bug tracking system
Copyright (C) 1999 Darren O. Benham,
1997 nCipher Corporation Ltd,
1994-97 Ian Jackson.