From patchwork Sat Dec 21 17:04:05 2024 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 8bit X-Patchwork-Submitter: Herman Rimm X-Patchwork-Id: 35116 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 8363127BBEA; Sat, 21 Dec 2024 17:06:49 +0000 (GMT) X-Spam-Checker-Version: SpamAssassin 3.4.6 (2021-04-09) on mira.cbaines.net X-Spam-Level: X-Spam-Status: No, score=-6.4 required=5.0 tests=BAYES_00,DKIM_INVALID, DKIM_SIGNED,MAILING_LIST_MULTI,RCVD_IN_DNSWL_BLOCKED, RCVD_IN_VALIDITY_CERTIFIED,RCVD_IN_VALIDITY_RPBL,RCVD_IN_VALIDITY_SAFE, SPF_HELO_PASS,URIBL_BLOCKED autolearn=unavailable autolearn_force=no version=3.4.6 Received: from lists.gnu.org (lists.gnu.org [209.51.188.17]) by mira.cbaines.net (Postfix) with ESMTPS id 48AEF27BBE2 for ; Sat, 21 Dec 2024 17:06:49 +0000 (GMT) Received: from localhost ([::1] helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1tP2vZ-0005Rh-8H; Sat, 21 Dec 2024 12:06:09 -0500 Received: from eggs.gnu.org ([2001:470:142:3::10]) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1tP2vY-0005RT-Lf for guix-patches@gnu.org; Sat, 21 Dec 2024 12:06:08 -0500 Received: from debbugs.gnu.org ([2001:470:142:5::43]) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1tP2vY-0003QQ-1D; Sat, 21 Dec 2024 12:06:08 -0500 DKIM-Signature: v=1; a=rsa-sha256; q=dns/txt; c=relaxed/relaxed; d=debbugs.gnu.org; s=debbugs-gnu-org; h=MIME-Version:References:In-Reply-To:Date:From:To:Subject; bh=XBnWVgPt+dXrwelp+ecr17pGs1zoO5nRvpNKyO4JC0o=; b=ZXrEkrz8xfHLNHWt8zgKfO6azqMQNnK16zt5o93VTZ0u807NAwc6k9BvnFt/a21lwUjgBZs0pFw+NpIY37LSIyDkufqkJg5/f6NxKx2IB/dGx50H79qYHxG4JefSFzcjVuPkMKbOZPV9tjepucg+HJnTBPiYh/FBV9kNWnb0EjnXuA3gqPE+j/UOX/JfiEvP6zenW3X5DRY5P+gnLWEgwLQp6TcwENXWIIfA+h+QRTjxD7OSXn75PZ9SgMkUYiNnqGr5KLcgr2wsowvYxHFM1lhQNdXGgDAfyn9F2YxSsPpdqK+1RoIEYEsSze0zjCMQyhSVeweyvI6rNYptOVnUqg==; Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1tP2vS-0005Qz-Ir; Sat, 21 Dec 2024 12:06:02 -0500 X-Loop: help-debbugs@gnu.org Subject: [bug#75010] [PATCH 1/7] monads: Add 'mmatch'. Resent-From: Herman Rimm Original-Sender: "Debbugs-submit" Resent-CC: guix@cbaines.net, dev@jpoiret.xyz, ludo@gnu.org, othacehe@gnu.org, maxim.cournoyer@gmail.com, zimon.toutoune@gmail.com, me@tobias.gr, guix-patches@gnu.org Resent-Date: Sat, 21 Dec 2024 17:06:02 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 75010 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: patch To: 75010@debbugs.gnu.org Cc: Christopher Baines , Josselin Poiret , Ludovic =?utf-8?q?Court=C3=A8s?= , Mathieu Othacehe , Maxim Cournoyer , Simon Tournier , Tobias Geerinckx-Rice X-Debbugs-Original-Xcc: Christopher Baines , Josselin Poiret , Ludovic =?utf-8?q?Court=C3=A8s?= , Mathieu Othacehe , Maxim Cournoyer , Simon Tournier , Tobias Geerinckx-Rice Received: via spool by 75010-submit@debbugs.gnu.org id=B75010.173480070920659 (code B ref 75010); Sat, 21 Dec 2024 17:06:02 +0000 Received: (at 75010) by debbugs.gnu.org; 21 Dec 2024 17:05:09 +0000 Received: from localhost ([127.0.0.1]:47509 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1tP2ua-0005Mj-MS for submit@debbugs.gnu.org; Sat, 21 Dec 2024 12:05:09 -0500 Received: from 81-205-150-117.fixed.kpn.net ([81.205.150.117]:38121 helo=email.rimm.ee) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1tP2uY-0005I2-Bd for 75010@debbugs.gnu.org; Sat, 21 Dec 2024 12:05:07 -0500 DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=rimm.ee; s=herman; t=1734800696; h=from:from:reply-to:subject:subject:date:date:message-id:message-id: to:to:cc:mime-version:mime-version:content-type:content-type: content-transfer-encoding:content-transfer-encoding: in-reply-to:in-reply-to:references:references; bh=XBnWVgPt+dXrwelp+ecr17pGs1zoO5nRvpNKyO4JC0o=; b=DH+pAVrZ7HAbYWtDndS5FRIBPhlzp4nq1BrN5dF1r2SNXjqRarAWh5aL+JZJ7MIgeDcYgS lSGTnIst7QBmb1RG1Lb1gXBcCnhngUTRKQ7p3PMczg28QOXEI5ysYzmJp8//39cps4CSbH cE2Zet2ONQW6chpTElZ73HTv1A566ymHteGmred+/a/iDgRL9LFs6DzSxAzumeeeBnWfBw hFimLDdtOjSRh9TQ6n+NZbAd7t4DoOKouqnBKj74U+SYlbA6pAUn3U0u7BNlm7Gy2gnn/Q TL8AxRJwCfu1aV8fb2arF3eTfs6zMJGaPJapWe+diaIE8SOQXtjptIfOiNL3pg== Received: by 81-205-150-117.fixed.kpn.net (OpenSMTPD) with ESMTPSA id 32d18722 (TLSv1.3:TLS_CHACHA20_POLY1305_SHA256:256:NO) for <75010@debbugs.gnu.org>; Sat, 21 Dec 2024 17:04:56 +0000 (UTC) Date: Sat, 21 Dec 2024 18:04:05 +0100 Message-ID: <4bfa279cae2316d7a7a4e0640d13a0763ad86f92.1734798943.git.herman@rimm.ee> X-Mailer: git-send-email 2.45.2 In-Reply-To: References: 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: , Reply-to: Herman Rimm X-ACL-Warn: , Herman Rimm via Guix-patches X-Patchwork-Original-From: Herman Rimm via Guix-patches via From: Herman Rimm Errors-To: guix-patches-bounces+patchwork=mira.cbaines.net@gnu.org Sender: guix-patches-bounces+patchwork=mira.cbaines.net@gnu.org X-getmail-retrieved-from-mailbox: Patches * doc/guix.texi (The Store Monad): Document mmatch. * guix/monads.scm (mmatch): Add macro. Change-Id: I558f8e025f6cf788c9fc475e99d49690d7a98f41 --- doc/guix.texi | 6 ++++++ guix/monads.scm | 11 +++++++++++ 2 files changed, 17 insertions(+) diff --git a/doc/guix.texi b/doc/guix.texi index f7b7569887..c86f644360 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -11814,6 +11814,12 @@ The Store Monad (@pxref{Local Bindings,,, guile, GNU Guile Reference Manual}). @end defmac +@defmac mmatch monad mexp (pattern body) @dots{} +Match monadic object @var{mexp} against clause @var{pattern}s, in the +order in which they appear. The last expression of each clause +@var{body} must be a monadic expression. +@end defmac + @defmac mbegin monad mexp @dots{} Bind @var{mexp} and the following monadic expressions in sequence, returning the result of the last expression. Every expression in the diff --git a/guix/monads.scm b/guix/monads.scm index 0bd8ac9315..0e8ca868ce 100644 --- a/guix/monads.scm +++ b/guix/monads.scm @@ -1,5 +1,6 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2013, 2014, 2015, 2017, 2022 Ludovic Courtès +;;; Copyright © 2024 Herman Rimm ;;; ;;; This file is part of GNU Guix. ;;; @@ -37,6 +38,7 @@ (define-module (guix monads) with-monad mlet mlet* + mmatch mbegin mwhen munless @@ -355,6 +357,15 @@ (define-syntax mlet (let ((var temp) ...) body ...))))))) +(define-syntax mmatch + (syntax-rules () + "Match the monadic object MEXP against the patterns of CLAUSES ... +in the order in which they appear. The last expression of each clause +body must be a monadic expression." + ((_ monad mexp clauses ...) + (with-monad monad + (>>= mexp (match-lambda clauses ...)))))) + (define-syntax mbegin (syntax-rules (%current-monad) "Bind MEXP and the following monadic expressions in sequence, returning From patchwork Sat Dec 21 17:04:06 2024 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 8bit X-Patchwork-Submitter: Herman Rimm X-Patchwork-Id: 35111 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 71A4927BBEA; Sat, 21 Dec 2024 17:06:25 +0000 (GMT) X-Spam-Checker-Version: SpamAssassin 3.4.6 (2021-04-09) on mira.cbaines.net X-Spam-Level: X-Spam-Status: No, score=-6.4 required=5.0 tests=BAYES_00,DKIM_INVALID, DKIM_SIGNED,MAILING_LIST_MULTI,RCVD_IN_DNSWL_BLOCKED, RCVD_IN_VALIDITY_CERTIFIED,RCVD_IN_VALIDITY_RPBL,RCVD_IN_VALIDITY_SAFE, SPF_HELO_PASS,URIBL_BLOCKED autolearn=ham autolearn_force=no version=3.4.6 Received: from lists.gnu.org (lists.gnu.org [209.51.188.17]) by mira.cbaines.net (Postfix) with ESMTPS id 3652B27BBE9 for ; Sat, 21 Dec 2024 17:06:24 +0000 (GMT) Received: from localhost ([::1] helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1tP2vV-0005Qx-3b; Sat, 21 Dec 2024 12:06:05 -0500 Received: from eggs.gnu.org ([2001:470:142:3::10]) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1tP2vT-0005QR-PO for guix-patches@gnu.org; Sat, 21 Dec 2024 12:06:03 -0500 Received: from debbugs.gnu.org ([2001:470:142:5::43]) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1tP2vT-0003Od-HF for guix-patches@gnu.org; Sat, 21 Dec 2024 12:06:03 -0500 DKIM-Signature: v=1; a=rsa-sha256; q=dns/txt; c=relaxed/relaxed; d=debbugs.gnu.org; s=debbugs-gnu-org; h=MIME-Version:References:In-Reply-To:Date:From:To:Subject; bh=r8gc31SeqeNK8QNFZkQtXIF7baF85+feQQZYPYWR5FU=; b=KUmvcxNSNap/2xYv0fozfSNG9XjBY8KNW9k4368L+NbKKqu6BJ3WBorfjT+aOMMP54U6Q7+watdMLZP63H6pKacMc+5wh1WnWseT3fORzi+2c4fmRzBBcQIxprulhp2sciMWx4OesaH0uffIEnutO14c+bcl/VOWFzzEeLZO2qWzuzN2O1UGHc+ohOWlNNq3CJQz/dal4IgOsp3x8YDngh9U+FGIF2k/O+2BsiEbPL5lr6YWsLMIbzy99jb3Hi2dFOjIgDti05TnWJPHEA36BYPfHyhB+1Ix1YrizvNpgHPbu2hsB7nSciHHaYZUx2ErNaq6jPOyjbSr1JtCD/ToOg==; Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1tP2vT-0005RA-6Z for guix-patches@gnu.org; Sat, 21 Dec 2024 12:06:03 -0500 X-Loop: help-debbugs@gnu.org Subject: [bug#75010] [PATCH 2/7] gnu: machine: ssh: Refactor roll-back-managed-host. Resent-From: Herman Rimm Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Sat, 21 Dec 2024 17:06:03 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 75010 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: patch To: 75010@debbugs.gnu.org Received: via spool by 75010-submit@debbugs.gnu.org id=B75010.173480071520785 (code B ref 75010); Sat, 21 Dec 2024 17:06:03 +0000 Received: (at 75010) by debbugs.gnu.org; 21 Dec 2024 17:05:15 +0000 Received: from localhost ([127.0.0.1]:47517 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1tP2ug-0005PA-GS for submit@debbugs.gnu.org; Sat, 21 Dec 2024 12:05:14 -0500 Received: from 81-205-150-117.fixed.kpn.net ([81.205.150.117]:38121 helo=email.rimm.ee) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1tP2uZ-0005I2-CI for 75010@debbugs.gnu.org; Sat, 21 Dec 2024 12:05:08 -0500 DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=rimm.ee; s=herman; t=1734800696; h=from:from:reply-to:subject:subject:date:date:message-id:message-id: to:to:cc:mime-version:mime-version:content-type:content-type: content-transfer-encoding:content-transfer-encoding: in-reply-to:in-reply-to:references:references; bh=ZTYy1cD46r8aq1jDrZf65hzcr3HDQHHFFvlUl8fXvto=; b=vN1DEqTjNoBYnNwy4Oay68R+N36O6mMiWxCCAEyBy8oDCHBzkwxyXHuiY/rJ2SnvySClI9 we+t4xgtFQy/U2RTQ05pWOW5AC8SdqUTA8rzqOWB8l4pAt+kWPZq7PF3Qqvn0kSaOHrz56 T/AsVid02uDXy5ibnzhuQqocXsrqIxkUrD2r9Meb+Q4DVPxznqurPbS0h17Kc7K2E8fBfU 4hcpD2RstBLDCgM4MrAduX5MCtr8sXSDYoYiHPbFY+6uep451/PcWrH87WjEp+CNbMfemo 0s3zdGcf4J5Rv7gilaKY5S/lHy8E/WMx/GtOXPxc+hdCrkZ1R7Il8d7V50bYIw== Received: by 81-205-150-117.fixed.kpn.net (OpenSMTPD) with ESMTPSA id 7c4c3846 (TLSv1.3:TLS_CHACHA20_POLY1305_SHA256:256:NO) for <75010@debbugs.gnu.org>; Sat, 21 Dec 2024 17:04:56 +0000 (UTC) Date: Sat, 21 Dec 2024 18:04:06 +0100 Message-ID: X-Mailer: git-send-email 2.45.2 In-Reply-To: References: 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: , Reply-to: Herman Rimm X-ACL-Warn: , Herman Rimm via Guix-patches X-Patchwork-Original-From: Herman Rimm via Guix-patches via From: Herman Rimm Errors-To: guix-patches-bounces+patchwork=mira.cbaines.net@gnu.org Sender: guix-patches-bounces+patchwork=mira.cbaines.net@gnu.org X-getmail-retrieved-from-mailbox: Patches * gnu/machine/ssh.scm (roll-back-managed-host): Use let* and mbegin. Change-Id: Ic3d5039ecf01e1e965dce8a696e7dbd625d2b3c5 --- gnu/machine/ssh.scm | 53 ++++++++++++++++++++++----------------------- 1 file changed, 26 insertions(+), 27 deletions(-) diff --git a/gnu/machine/ssh.scm b/gnu/machine/ssh.scm index 3e10d984e7..24c36a1936 100644 --- a/gnu/machine/ssh.scm +++ b/gnu/machine/ssh.scm @@ -2,6 +2,8 @@ ;;; Copyright © 2019 Jakob L. Kreuze ;;; Copyright © 2020-2023 Ludovic Courtès ;;; Copyright © 2024 Ricardo +;;; Copyright © 2024 Felix Lechner +;;; Copyright © 2024 Herman Rimm ;;; ;;; This file is part of GNU Guix. ;;; @@ -589,33 +591,30 @@ (define (roll-back-managed-host machine) (define roll-back-failure (condition (&message (message (G_ "could not roll-back machine"))))) - (mlet* %store-monad ((boot-parameters (machine-boot-parameters machine)) - (_ -> (if (< (length boot-parameters) 2) - (raise roll-back-failure))) - (entries -> (map boot-parameters->menu-entry - (list (second boot-parameters)))) - (locale -> (boot-parameters-locale - (second boot-parameters))) - (crypto-dev -> (boot-parameters-store-crypto-devices - (second boot-parameters))) - (store-dir -> (boot-parameters-store-directory-prefix - (second boot-parameters))) - (old-entries -> (map boot-parameters->menu-entry - (drop boot-parameters 2))) - (bootloader -> (operating-system-bootloader - (machine-operating-system machine))) - (bootcfg (lower-object - ((bootloader-configuration-file-generator - (bootloader-configuration-bootloader - bootloader)) - bootloader entries - #:locale locale - #:store-crypto-devices crypto-dev - #:store-directory-prefix store-dir - #:old-entries old-entries))) - (remote-result (machine-remote-eval machine remote-exp))) - (when (eqv? 'error remote-result) - (raise roll-back-failure)))) + (mmatch %store-monad (machine-boot-parameters machine) + ((_ params rest ...) + (let* ((entries (list (boot-parameters->menu-entry params))) + (locale (boot-parameters-locale params)) + (crypto-dev (boot-parameters-store-crypto-devices params)) + (store-dir (boot-parameters-store-directory-prefix params)) + (old-entries (map boot-parameters->menu-entry rest)) + (bootloader (operating-system-bootloader + (machine-operating-system machine))) + (generate-bootloader-configuration-file + (bootloader-configuration-file-generator + (bootloader-configuration-bootloader bootloader)))) + (mbegin %store-monad + (lower-object (generate-bootloader-configuration-file + bootloader entries + #:locale locale + #:store-crypto-devices crypto-dev + #:store-directory-prefix store-dir + #:old-entries old-entries))) + (mlet %store-monad + ((remote-result (machine-remote-eval machine remote-exp))) + (when (eqv? 'error remote-result) + (raise roll-back-failure))))) + (_ (raise roll-back-failure)))) ;;; From patchwork Sat Dec 21 17:04:07 2024 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Herman Rimm X-Patchwork-Id: 35113 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 276A227BBE2; Sat, 21 Dec 2024 17:06:39 +0000 (GMT) X-Spam-Checker-Version: SpamAssassin 3.4.6 (2021-04-09) on mira.cbaines.net X-Spam-Level: X-Spam-Status: No, score=-6.4 required=5.0 tests=BAYES_00,DKIM_INVALID, DKIM_SIGNED,MAILING_LIST_MULTI,RCVD_IN_DNSWL_BLOCKED, RCVD_IN_VALIDITY_CERTIFIED,RCVD_IN_VALIDITY_RPBL,RCVD_IN_VALIDITY_SAFE, SPF_HELO_PASS,URIBL_BLOCKED autolearn=ham autolearn_force=no version=3.4.6 Received: from lists.gnu.org (lists.gnu.org [209.51.188.17]) by mira.cbaines.net (Postfix) with ESMTPS id D89C327BBE9 for ; Sat, 21 Dec 2024 17:06:38 +0000 (GMT) Received: from localhost ([::1] helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1tP2vX-0005RK-BD; Sat, 21 Dec 2024 12:06:07 -0500 Received: from eggs.gnu.org ([2001:470:142:3::10]) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1tP2vU-0005Qb-E0 for guix-patches@gnu.org; Sat, 21 Dec 2024 12:06:04 -0500 Received: from debbugs.gnu.org ([2001:470:142:5::43]) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1tP2vU-0003Os-5H for guix-patches@gnu.org; Sat, 21 Dec 2024 12:06:04 -0500 DKIM-Signature: v=1; a=rsa-sha256; q=dns/txt; c=relaxed/relaxed; d=debbugs.gnu.org; s=debbugs-gnu-org; h=MIME-Version:References:In-Reply-To:Date:From:To:Subject; bh=Mw+ehuOp4qN5OjjC6W+smX2JhCbLDNj/BpSr9ONpyeA=; b=GfV5cOele0O5+gSzEg9SibXcS6HeEnc6Dt1Vh9ehuVLOsUMdFAuuNsVnGdNK/OBX4U43EfyZoT0gltz3AwdazzP7UyOZG8x3NcGosOi7iA9yF4M205LDNsYP9GLzC5Uh46k0LTZ/mhRM6kHTXtXhCB+qCb5xZpvZ6+FAH1f4iWv4Fs46ZEtjP5KY5nEwJl1rXsIV6CReKk+6mr4VV1L6Po6l0+D424LF+DSKOwLo3fzLkuAvvqJDoyPnlGB5m53eFrSweltMHYirUcPbXz+1yHy7JY0LMbS6DDsy3IwdEd/BekN64QeU3aJyYaUYt9sqYOrBEtGnIZglf/AoNbtXrg==; Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1tP2vT-0005RH-Q9 for guix-patches@gnu.org; Sat, 21 Dec 2024 12:06:03 -0500 X-Loop: help-debbugs@gnu.org Subject: [bug#75010] [PATCH 3/7] gnu: machine: ssh: Return monadic value from roll-back-managed-host. Resent-From: Herman Rimm Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Sat, 21 Dec 2024 17:06:03 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 75010 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: patch To: 75010@debbugs.gnu.org Received: via spool by 75010-submit@debbugs.gnu.org id=B75010.173480071520793 (code B ref 75010); Sat, 21 Dec 2024 17:06:03 +0000 Received: (at 75010) by debbugs.gnu.org; 21 Dec 2024 17:05:15 +0000 Received: from localhost ([127.0.0.1]:47519 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1tP2uh-0005PC-1C for submit@debbugs.gnu.org; Sat, 21 Dec 2024 12:05:15 -0500 Received: from 81-205-150-117.fixed.kpn.net ([81.205.150.117]:38121 helo=email.rimm.ee) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1tP2ua-0005I2-Eq for 75010@debbugs.gnu.org; Sat, 21 Dec 2024 12:05:09 -0500 DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=rimm.ee; s=herman; t=1734800697; h=from:from:reply-to:subject:subject:date:date:message-id:message-id: to:to:cc:mime-version:mime-version: content-transfer-encoding:content-transfer-encoding: in-reply-to:in-reply-to:references:references; bh=Q/q4Qebf9NGtSGG6njgIa5LiFgClro62TGrj78Uwy1g=; b=GlCjO/yyh+uSImac/iZTFcRIk7MFuqPlr8ERPFu43KOZlLMBNa+YTXvTDFi0PVVg/iTmJx +bB4mi+QZPi06Ud8lKZkgEs3JALCvJUCCBDmQRvQjctFkCZWT0BEqVogDt4coQrxaJH4cK UTyn7LnbTMTwCJu57WnmQU7jmk0264Yl6jy21lqNWQWJxH688zAcvDkm/j22/B5YVGusUB 18232AmswaSckhyrH+22RCxHWTw4I/F0jxXVTwqS0qMpFLR+eYtb1pptmfFwajekKfDwik sz2X0IG4Yrf4tb/o98mSpcJz3kMIuuof8X9wUyEFvmuDa80dqap+SOY9/RCJUw== Received: by 81-205-150-117.fixed.kpn.net (OpenSMTPD) with ESMTPSA id f6bd2c01 (TLSv1.3:TLS_CHACHA20_POLY1305_SHA256:256:NO) for <75010@debbugs.gnu.org>; Sat, 21 Dec 2024 17:04:57 +0000 (UTC) Date: Sat, 21 Dec 2024 18:04:07 +0100 Message-ID: <9d7e69af958b651dd463d93822c0b493e201387a.1734798943.git.herman@rimm.ee> X-Mailer: git-send-email 2.45.2 In-Reply-To: References: 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: , Reply-to: Herman Rimm X-ACL-Warn: , Herman Rimm via Guix-patches X-Patchwork-Original-From: Herman Rimm via Guix-patches via From: Herman Rimm Errors-To: guix-patches-bounces+patchwork=mira.cbaines.net@gnu.org Sender: guix-patches-bounces+patchwork=mira.cbaines.net@gnu.org X-getmail-retrieved-from-mailbox: Patches * gnu/machine/ssh.scm (roll-back-managed-host): Use return. Change-Id: Ibe7ddd5758173a6835d8796c9c5ae5ba306b3334 --- gnu/machine/ssh.scm | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/gnu/machine/ssh.scm b/gnu/machine/ssh.scm index 24c36a1936..c76b51c757 100644 --- a/gnu/machine/ssh.scm +++ b/gnu/machine/ssh.scm @@ -612,9 +612,9 @@ (define (roll-back-managed-host machine) #:old-entries old-entries))) (mlet %store-monad ((remote-result (machine-remote-eval machine remote-exp))) - (when (eqv? 'error remote-result) - (raise roll-back-failure))))) - (_ (raise roll-back-failure)))) + (mwhen (eqv? 'error remote-result) + (return (raise roll-back-failure)))))) + (_ (return (raise roll-back-failure))))) ;;; From patchwork Sat Dec 21 17:04:08 2024 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Herman Rimm X-Patchwork-Id: 35114 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 5041627BBEC; Sat, 21 Dec 2024 17:06:41 +0000 (GMT) X-Spam-Checker-Version: SpamAssassin 3.4.6 (2021-04-09) on mira.cbaines.net X-Spam-Level: X-Spam-Status: No, score=-6.4 required=5.0 tests=BAYES_00,DKIM_INVALID, DKIM_SIGNED,MAILING_LIST_MULTI,RCVD_IN_DNSWL_BLOCKED, RCVD_IN_VALIDITY_CERTIFIED,RCVD_IN_VALIDITY_RPBL,RCVD_IN_VALIDITY_SAFE, SPF_HELO_PASS,URIBL_BLOCKED autolearn=ham autolearn_force=no version=3.4.6 Received: from lists.gnu.org (lists.gnu.org [209.51.188.17]) by mira.cbaines.net (Postfix) with ESMTPS id 0F4F327BBEA for ; Sat, 21 Dec 2024 17:06:41 +0000 (GMT) Received: from localhost ([::1] helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1tP2vX-0005RN-LX; Sat, 21 Dec 2024 12:06:07 -0500 Received: from eggs.gnu.org ([2001:470:142:3::10]) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1tP2vU-0005Qj-Ng for guix-patches@gnu.org; Sat, 21 Dec 2024 12:06:04 -0500 Received: from debbugs.gnu.org ([2001:470:142:5::43]) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1tP2vU-0003P2-F0 for guix-patches@gnu.org; Sat, 21 Dec 2024 12:06:04 -0500 DKIM-Signature: v=1; a=rsa-sha256; q=dns/txt; c=relaxed/relaxed; d=debbugs.gnu.org; s=debbugs-gnu-org; h=MIME-Version:References:In-Reply-To:Date:From:To:Subject; bh=EREHFR3ipWhtTXlI/zC1e2OV5zlEkHLR82/AvIEdK+o=; b=Uuhez/xgawYwJkBTR+q1deeF6qyKiYW3lbOigOQox+u7enrXOtX+NwdN4KKeu0WzDuqHeg8LqZqV5NABdBDOTLTke1dFvi1biy+yzNAcKkspPlJ/tmPLvIyGCSPA8S59FrKSpJIs1KfPpyWG8OXuha3/4qFsLEuWtw+FFhG9wogS+owQrrghKb1Zu/EhuYH8RLriWsmjQGkeD9pidQkAorN2aCoFXXIdcVuZA7t15Nmx9Wp9sqZVs59DtMbkybd+IxmZV3DMUpmsHw4GoYHRAja7/g6yj5xzWJwURfEMYdS3JtxiCFpUmOR8g/6ravYZWQdoFiCS1y6T9ACzGGTOcg==; Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1tP2vU-0005RP-9q for guix-patches@gnu.org; Sat, 21 Dec 2024 12:06:04 -0500 X-Loop: help-debbugs@gnu.org Subject: [bug#75010] [PATCH 4/7] Rename two remote variables confusingly named 'generations'. Resent-From: Herman Rimm Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Sat, 21 Dec 2024 17:06:04 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 75010 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: patch To: 75010@debbugs.gnu.org Cc: Felix Lechner Received: via spool by 75010-submit@debbugs.gnu.org id=B75010.173480071520800 (code B ref 75010); Sat, 21 Dec 2024 17:06:04 +0000 Received: (at 75010) by debbugs.gnu.org; 21 Dec 2024 17:05:15 +0000 Received: from localhost ([127.0.0.1]:47521 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1tP2uh-0005PK-Bb for submit@debbugs.gnu.org; Sat, 21 Dec 2024 12:05:15 -0500 Received: from 81-205-150-117.fixed.kpn.net ([81.205.150.117]:38121 helo=email.rimm.ee) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1tP2ub-0005I2-Ab for 75010@debbugs.gnu.org; Sat, 21 Dec 2024 12:05:09 -0500 DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=rimm.ee; s=herman; t=1734800698; h=from:from:reply-to:subject:subject:date:date:message-id:message-id: to:to:cc:cc:mime-version:mime-version: content-transfer-encoding:content-transfer-encoding: in-reply-to:in-reply-to:references:references; bh=EREHFR3ipWhtTXlI/zC1e2OV5zlEkHLR82/AvIEdK+o=; b=fxJVef1q+g2bHak/MbVtqICsjyu2K7C/7Qvdf38euotmhZaUGw1SCB+hoQ0hF9eu9pctze UghAaXE+RnhCVkk1ix0nc3i/jPvHTWANPhcXvhEihzsC7d8EIqzdyjZo6nymEMeKW/i+ZD 30eti20X8uccUoCoNjlgN3QsVm9hLu9Hf35kkZS3uWNvhHD3JVlLKxqzot8rMFgcamFA8n Dwufqw2AQvM1gz3OR1BANgzKlJVDWDATLPlcYHXMmuu7QGAllqXFqIKxIODlLtdgeVI2FN 5ak944QK7GhQhXJgr3UO+fOYj08gZ30msSaoWIC8G3TwQ84h8cthrfASjMz+Bg== Received: by 81-205-150-117.fixed.kpn.net (OpenSMTPD) with ESMTPSA id 6d2af424 (TLSv1.3:TLS_CHACHA20_POLY1305_SHA256:256:NO); Sat, 21 Dec 2024 17:04:58 +0000 (UTC) Date: Sat, 21 Dec 2024 18:04:08 +0100 Message-ID: <9ae59065234a1d8215f94f2df13752cbfa438595.1734798943.git.herman@rimm.ee> X-Mailer: git-send-email 2.45.2 In-Reply-To: References: 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: , Reply-to: Herman Rimm X-ACL-Warn: , Herman Rimm via Guix-patches X-Patchwork-Original-From: Herman Rimm via Guix-patches via From: Herman Rimm Errors-To: guix-patches-bounces+patchwork=mira.cbaines.net@gnu.org Sender: guix-patches-bounces+patchwork=mira.cbaines.net@gnu.org X-getmail-retrieved-from-mailbox: Patches From: Felix Lechner Both refer to data sets returned from the remote expression, and one of them shadowed an element of itself. * gnu/machine/ssh.scm (machine-boot-parameters): Rename generations to remote-results. Change-Id: Ibd8a3036126d9da1215cfc191884c0f54df637df --- gnu/machine/ssh.scm | 9 +++++---- 1 file changed, 5 insertions(+), 4 deletions(-) diff --git a/gnu/machine/ssh.scm b/gnu/machine/ssh.scm index c76b51c757..3e69d4b9a3 100644 --- a/gnu/machine/ssh.scm +++ b/gnu/machine/ssh.scm @@ -455,10 +455,11 @@ (define (machine-boot-parameters machine) (read-file boot-parameters-path)))) (reverse (generation-numbers %system-profile))))))) - (mlet* %store-monad ((generations (machine-remote-eval machine remote-exp))) + (mlet %store-monad + ((remote-results (machine-remote-eval machine remote-exp))) (return - (map (lambda (generation) - (match generation + (map (lambda (remote-result) + (match remote-result ((generation system-path time serialized-params) (let* ((params (call-with-input-string serialized-params read-boot-parameters)) @@ -477,7 +478,7 @@ (define (machine-boot-parameters machine) (kernel-arguments (append (bootable-kernel-arguments system-path root version) (boot-parameters-kernel-arguments params)))))))) - generations)))) + remote-results)))) (define-syntax-rule (with-roll-back should-roll-back? mbody ...) "Catch exceptions that arise when binding MBODY, a monadic expression in From patchwork Sat Dec 21 17:04:09 2024 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Herman Rimm X-Patchwork-Id: 35115 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 05D7A27BBEA; Sat, 21 Dec 2024 17:06:42 +0000 (GMT) X-Spam-Checker-Version: SpamAssassin 3.4.6 (2021-04-09) on mira.cbaines.net X-Spam-Level: X-Spam-Status: No, score=-6.4 required=5.0 tests=BAYES_00,DKIM_INVALID, DKIM_SIGNED,MAILING_LIST_MULTI,RCVD_IN_DNSWL_BLOCKED, RCVD_IN_VALIDITY_CERTIFIED,RCVD_IN_VALIDITY_RPBL,RCVD_IN_VALIDITY_SAFE, SPF_HELO_PASS,URIBL_BLOCKED autolearn=unavailable autolearn_force=no version=3.4.6 Received: from lists.gnu.org (lists.gnu.org [209.51.188.17]) by mira.cbaines.net (Postfix) with ESMTPS id 0214E27BBE2 for ; Sat, 21 Dec 2024 17:06:41 +0000 (GMT) Received: from localhost ([::1] helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1tP2ve-0005TW-Dq; Sat, 21 Dec 2024 12:06:15 -0500 Received: from eggs.gnu.org ([2001:470:142:3::10]) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1tP2vY-0005RS-OO for guix-patches@gnu.org; Sat, 21 Dec 2024 12:06:08 -0500 Received: from debbugs.gnu.org ([2001:470:142:5::43]) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1tP2vV-0003PS-JJ; Sat, 21 Dec 2024 12:06:06 -0500 DKIM-Signature: v=1; a=rsa-sha256; q=dns/txt; c=relaxed/relaxed; d=debbugs.gnu.org; s=debbugs-gnu-org; h=MIME-Version:References:In-Reply-To:Date:From:To:Subject; bh=wA07eaLkQ4B3lVWMM51rM1bssBd0q3oVs5rlUk0PLOY=; b=auqc52R01g+8VRmKhXsG/aRz+7MLauM/J00CTppFRgxBHgdqLK3SkfCXj+w94dmmjUvsrLn9R1f9gvIGpIX0ZCq65Ztd9laL9w+lqCsMr6TafrzyNaUxrKQsL7IERSdBT/h3+JFHyR8wo+Uixmc3/gQGZZFzpYDvo98Iunu/u2Y42Yr6AdBlEk2Tjhp+prtDwOm8H2yKX6EUZlNb2MHO+TApgC/5sPEf4R+M5Br2VYnvgwFjoXNimQQ1TrMBLcutPwTfPpo9FbLyQ57ra3F8ACJTcq1y6OcQeop5bCXTz89zt7Ycb3E6Zn8Aop01d+/yioLEkZDXwzSA/Va6HHxzmQ==; Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1tP2vU-0005RW-SI; Sat, 21 Dec 2024 12:06:04 -0500 X-Loop: help-debbugs@gnu.org Subject: [bug#75010] [PATCH 5/7] gnu: machine: Remove &deploy-error. Resent-From: Herman Rimm Original-Sender: "Debbugs-submit" Resent-CC: guix@cbaines.net, dev@jpoiret.xyz, ludo@gnu.org, othacehe@gnu.org, zimon.toutoune@gmail.com, me@tobias.gr, guix-patches@gnu.org Resent-Date: Sat, 21 Dec 2024 17:06:04 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 75010 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: patch To: 75010@debbugs.gnu.org Cc: Christopher Baines , Josselin Poiret , Ludovic =?utf-8?q?Court=C3=A8s?= , Mathieu Othacehe , Simon Tournier , Tobias Geerinckx-Rice X-Debbugs-Original-Xcc: Christopher Baines , Josselin Poiret , Ludovic =?utf-8?q?Court=C3=A8s?= , Mathieu Othacehe , Simon Tournier , Tobias Geerinckx-Rice Received: via spool by 75010-submit@debbugs.gnu.org id=B75010.173480071620808 (code B ref 75010); Sat, 21 Dec 2024 17:06:04 +0000 Received: (at 75010) by debbugs.gnu.org; 21 Dec 2024 17:05:16 +0000 Received: from localhost ([127.0.0.1]:47523 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1tP2uh-0005PR-OI for submit@debbugs.gnu.org; Sat, 21 Dec 2024 12:05:16 -0500 Received: from 81-205-150-117.fixed.kpn.net ([81.205.150.117]:38121 helo=email.rimm.ee) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1tP2uc-0005I2-4r for 75010@debbugs.gnu.org; Sat, 21 Dec 2024 12:05:10 -0500 DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=rimm.ee; s=herman; t=1734800700; h=from:from:reply-to:subject:subject:date:date:message-id:message-id: to:to:cc:mime-version:mime-version: content-transfer-encoding:content-transfer-encoding: in-reply-to:in-reply-to:references:references; bh=GILwmmbUV5cxDgm2vE7mgAMn6SS5HAWz45VRyyCkjIU=; b=mnd73a6TS7e1pqVgvtQRNtFq38wE5BhUm/Yj2HEIdgAhHXOtqmtIzGY7PNFq5DL8+rMyeR 0usEneEv0XZ3ZB+qf/FIpQAiDPVA3Qg76vfkJ57J9RWHqWq0PDL8rO3G2QyGN9zTF/os+/ RwYUYLaM7DDfG9ot/eLDen2tiVEfPoUOhol/eviW2BAMKHQ8vFKkQUrVvw3d/WbWQZL1qX 0Vuo8OIUm26UoH+Yk4bWxm/gK2AomNfqkhwPin2zUtazj2NSbpHUaH9cnpn/6iFmHN2jBW 8WKSeJ9fWT4P4Y/6cdl4C+WnGJG//QZxdQzGJtBYsE+QqE3DnX84lkD2ZJz6bA== Received: by 81-205-150-117.fixed.kpn.net (OpenSMTPD) with ESMTPSA id 75f982c0 (TLSv1.3:TLS_CHACHA20_POLY1305_SHA256:256:NO) for <75010@debbugs.gnu.org>; Sat, 21 Dec 2024 17:05:00 +0000 (UTC) Date: Sat, 21 Dec 2024 18:04:09 +0100 Message-ID: X-Mailer: git-send-email 2.45.2 In-Reply-To: References: 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: , Reply-to: Herman Rimm X-ACL-Warn: , Herman Rimm via Guix-patches X-Patchwork-Original-From: Herman Rimm via Guix-patches via From: Herman Rimm Errors-To: guix-patches-bounces+patchwork=mira.cbaines.net@gnu.org Sender: guix-patches-bounces+patchwork=mira.cbaines.net@gnu.org X-getmail-retrieved-from-mailbox: Patches * gnu/machine.scm (&deploy-error): Remove. * gnu/machine/ssh.scm (with-roll-back): Remove. (deploy-managed-host): Remove with-roll-back. * guix/scripts/deploy.scm (deploy-machine*): Remove deploy-error? case. Change-Id: I719eafda0f5d12e1f4e3795631e78378f5376745 --- gnu/machine.scm | 17 +------------- gnu/machine/ssh.scm | 51 +++++++++++++++-------------------------- guix/scripts/deploy.scm | 8 +------ 3 files changed, 20 insertions(+), 56 deletions(-) diff --git a/gnu/machine.scm b/gnu/machine.scm index 60be674972..ede595d053 100644 --- a/gnu/machine.scm +++ b/gnu/machine.scm @@ -41,12 +41,7 @@ (define-module (gnu machine) deploy-machine roll-back-machine - machine-remote-eval - - &deploy-error - deploy-error? - deploy-error-should-roll-back - deploy-error-captured-args)) + machine-remote-eval)) ;;; Commentary: ;;; @@ -122,13 +117,3 @@ (define (roll-back-machine machine) and the new generation number." (let ((environment (machine-environment machine))) ((environment-type-roll-back-machine environment) machine))) - - -;;; -;;; Error types. -;;; - -(define-condition-type &deploy-error &error - deploy-error? - (should-roll-back deploy-error-should-roll-back) - (captured-args deploy-error-captured-args)) diff --git a/gnu/machine/ssh.scm b/gnu/machine/ssh.scm index 3e69d4b9a3..b954620b69 100644 --- a/gnu/machine/ssh.scm +++ b/gnu/machine/ssh.scm @@ -480,18 +480,6 @@ (define (machine-boot-parameters machine) (boot-parameters-kernel-arguments params)))))))) remote-results)))) -(define-syntax-rule (with-roll-back should-roll-back? mbody ...) - "Catch exceptions that arise when binding MBODY, a monadic expression in -%STORE-MONAD, and collect their arguments in a &deploy-error condition, with -the 'should-roll-back' field set to SHOULD-ROLL-BACK?" - (catch #t - (lambda () - mbody ...) - (lambda args - (raise (condition (&deploy-error - (should-roll-back should-roll-back?) - (captured-args args))))))) - (define (deploy-managed-host machine) "Internal implementation of 'deploy-machine' for MACHINE instances with an environment type of 'managed-host." @@ -536,32 +524,29 @@ (define (deploy-managed-host machine) store))))) (mbegin %store-monad - (with-roll-back #f - (switch-to-system (eval/error-handling c - (raise (formatted-message - (G_ "\ + (switch-to-system (eval/error-handling c + (raise (formatted-message + (G_ "\ failed to switch systems while deploying '~a':~%~{~s ~}") - host - (inferior-exception-arguments c)))) - os)) + host + (inferior-exception-arguments c)))) + os) (parameterize ((%current-system system) (%current-target-system #f)) - (with-roll-back #t - (mbegin %store-monad - (upgrade-shepherd-services (eval/error-handling c - (warning (G_ "\ + (mbegin %store-monad + (upgrade-shepherd-services + (eval/error-handling c + (warning (G_ "\ an error occurred while upgrading services on '~a':~%~{~s ~}~%") - host - (inferior-exception-arguments - c))) - os) - (install-bootloader (eval/error-handling c - (raise (formatted-message - (G_ "\ + host (inferior-exception-arguments c))) + os) + (install-bootloader + (eval/error-handling c + (raise (formatted-message + (G_ "\ failed to install bootloader on '~a':~%~{~s ~}~%") - host - (inferior-exception-arguments c)))) - bootloader-configuration bootcfg))))))))) + host (inferior-exception-arguments c)))) + bootloader-configuration bootcfg)))))))) ;;; diff --git a/guix/scripts/deploy.scm b/guix/scripts/deploy.scm index 4b1a603049..ca0e1c4023 100644 --- a/guix/scripts/deploy.scm +++ b/guix/scripts/deploy.scm @@ -156,13 +156,7 @@ (define (deploy-machine* store machine) (apply format #f (gettext (formatted-message-string c) %gettext-domain) - (formatted-message-arguments c)))) - ((deploy-error? c) - (when (deploy-error-should-roll-back c) - (info (G_ "rolling back ~a...~%") - (machine-display-name machine)) - (run-with-store store (roll-back-machine machine))) - (apply throw (deploy-error-captured-args c)))) + (formatted-message-arguments c))))) (run-with-store store (deploy-machine machine)) (info (G_ "successfully deployed ~a~%") From patchwork Sat Dec 21 17:04:10 2024 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Herman Rimm X-Patchwork-Id: 35117 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 DF59927BBEA; Sat, 21 Dec 2024 17:06:53 +0000 (GMT) X-Spam-Checker-Version: SpamAssassin 3.4.6 (2021-04-09) on mira.cbaines.net X-Spam-Level: X-Spam-Status: No, score=-6.4 required=5.0 tests=BAYES_00,DKIM_INVALID, DKIM_SIGNED,MAILING_LIST_MULTI,RCVD_IN_DNSWL_BLOCKED, RCVD_IN_VALIDITY_CERTIFIED,RCVD_IN_VALIDITY_RPBL,RCVD_IN_VALIDITY_SAFE, SPF_HELO_PASS,URIBL_BLOCKED autolearn=ham autolearn_force=no version=3.4.6 Received: from lists.gnu.org (lists.gnu.org [209.51.188.17]) by mira.cbaines.net (Postfix) with ESMTPS id 9C12127BBE2 for ; Sat, 21 Dec 2024 17:06:53 +0000 (GMT) Received: from localhost ([::1] helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1tP2vZ-0005Ri-8t; Sat, 21 Dec 2024 12:06:09 -0500 Received: from eggs.gnu.org ([2001:470:142:3::10]) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1tP2vW-0005R5-N4 for guix-patches@gnu.org; Sat, 21 Dec 2024 12:06:06 -0500 Received: from debbugs.gnu.org ([2001:470:142:5::43]) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1tP2vV-0003PR-Fk for guix-patches@gnu.org; Sat, 21 Dec 2024 12:06:06 -0500 DKIM-Signature: v=1; a=rsa-sha256; q=dns/txt; c=relaxed/relaxed; d=debbugs.gnu.org; s=debbugs-gnu-org; h=MIME-Version:References:In-Reply-To:Date:From:To:Subject; bh=sg+tzSoNpo4NreLrmz4j1tsSAkk4dcN12IGGjeWhksU=; b=iumlX6M/A6AZfC9j7emSLove8F3q2w9H8hH/RbmECHpNOpeTCOJv8X+3cyNQ2K6z1dAedtjGywNfEMNcs/BU786PPhtbqgvWjK7jSCNu7VV4jfTDabR+8+V0XT80rYQh84ihWQt421XiNO32m4ijGlqcfwNgtlJzJwqxcPfH01dBs73hGSRJAXsa9Mjrn7NldY/u3uCeVT4RQ8eRwlt+wqPKTIGehHzzLCij32iLViDzwCDxg4amZX5TbeqRkK9C43PShE5tXY4IVJuHTyxVG7Tm5r5d940i/LXpArFOlhSvEd5T7r5+tfQTYv/1Nun0Fxmwyi+kVa3/zKKqiFaCWg==; Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1tP2vV-0005Rd-9l for guix-patches@gnu.org; Sat, 21 Dec 2024 12:06:05 -0500 X-Loop: help-debbugs@gnu.org Subject: [bug#75010] [PATCH 6/7] gnu: machine: ssh: Roll-back on failure. Resent-From: Herman Rimm Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Sat, 21 Dec 2024 17:06:05 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 75010 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: patch To: 75010@debbugs.gnu.org Received: via spool by 75010-submit@debbugs.gnu.org id=B75010.173480071720815 (code B ref 75010); Sat, 21 Dec 2024 17:06:05 +0000 Received: (at 75010) by debbugs.gnu.org; 21 Dec 2024 17:05:17 +0000 Received: from localhost ([127.0.0.1]:47525 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1tP2ui-0005PZ-Bh for submit@debbugs.gnu.org; Sat, 21 Dec 2024 12:05:16 -0500 Received: from 81-205-150-117.fixed.kpn.net ([81.205.150.117]:38121 helo=email.rimm.ee) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1tP2ud-0005I2-10 for 75010@debbugs.gnu.org; Sat, 21 Dec 2024 12:05:11 -0500 DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=rimm.ee; s=herman; t=1734800700; h=from:from:reply-to:subject:subject:date:date:message-id:message-id: to:to:cc:mime-version:mime-version: content-transfer-encoding:content-transfer-encoding: in-reply-to:in-reply-to:references:references; bh=sg+tzSoNpo4NreLrmz4j1tsSAkk4dcN12IGGjeWhksU=; b=uzC3I+wp5im80GUQLs+gLQN8j9bLPSfA7yLGIRK0nG2a0pDr7Rtllwys9+yHZmwbQmE7G5 4LJ2sLdABhcIWtYSf+Mhtg7cvI7eGBDwqSYqNco4temizhmkUreYQ78SKAlqiY9EVpagtT O/j0sPg0wfNFZo0HhzQEEwv5B1ICfkHVRfn8tm4XAl6DRXUbTpq2IXdrIIFiLypdOVceXW Oo6BKim9eRIpjkpoenUjX9bPrfK5saMkgZXfNmaIywZcmLvcumHnzgPLR65XI8v7Pu51hF 4Wf7A1+lJbpcjSFnQipFxAfqkQJG9Sl7NDhiHvDvugqSbwBjfaIxiCmKFSDFgQ== Received: by 81-205-150-117.fixed.kpn.net (OpenSMTPD) with ESMTPSA id 981c04c1 (TLSv1.3:TLS_CHACHA20_POLY1305_SHA256:256:NO) for <75010@debbugs.gnu.org>; Sat, 21 Dec 2024 17:05:00 +0000 (UTC) Date: Sat, 21 Dec 2024 18:04:10 +0100 Message-ID: X-Mailer: git-send-email 2.45.2 In-Reply-To: References: 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: , Reply-to: Herman Rimm X-ACL-Warn: , Herman Rimm via Guix-patches X-Patchwork-Original-From: Herman Rimm via Guix-patches via From: Herman Rimm Errors-To: guix-patches-bounces+patchwork=mira.cbaines.net@gnu.org Sender: guix-patches-bounces+patchwork=mira.cbaines.net@gnu.org X-getmail-retrieved-from-mailbox: Patches This restores the roll-back behaviour which was disabled in 2885c35. * gnu/machine/ssh.scm (deploy-managed-host): Use roll-back-machine. Change-Id: I8636347541ee1e4e30da15dd43455329a46c3bdb --- gnu/machine/ssh.scm | 15 +++++++++++---- 1 file changed, 11 insertions(+), 4 deletions(-) diff --git a/gnu/machine/ssh.scm b/gnu/machine/ssh.scm index b954620b69..9cc9c8f099 100644 --- a/gnu/machine/ssh.scm +++ b/gnu/machine/ssh.scm @@ -512,7 +512,8 @@ (define (deploy-managed-host machine) (menu-entries (map boot-parameters->menu-entry boot-parameters)) (bootloader-configuration (operating-system-bootloader os)) (bootcfg (operating-system-bootcfg os menu-entries))) - (define-syntax-rule (eval/error-handling condition handler ...) + (define-syntax-rule (eval/error-handling condition store + handler ...) ;; Return a wrapper around EVAL such that HANDLER is evaluated if an ;; exception is raised. (lambda (exp) @@ -524,7 +525,7 @@ (define (deploy-managed-host machine) store))))) (mbegin %store-monad - (switch-to-system (eval/error-handling c + (switch-to-system (eval/error-handling c store (raise (formatted-message (G_ "\ failed to switch systems while deploying '~a':~%~{~s ~}") @@ -535,13 +536,19 @@ (define (deploy-managed-host machine) (%current-target-system #f)) (mbegin %store-monad (upgrade-shepherd-services - (eval/error-handling c + (eval/error-handling c store + (info (G_ "rolling back ~a...~%") host) + (run-with-store store (roll-back-machine machine) + #:system system) (warning (G_ "\ an error occurred while upgrading services on '~a':~%~{~s ~}~%") host (inferior-exception-arguments c))) os) (install-bootloader - (eval/error-handling c + (eval/error-handling c store + (info (G_ "rolling back ~a...~%") host) + (run-with-store store (roll-back-machine machine) + #:system system) (raise (formatted-message (G_ "\ failed to install bootloader on '~a':~%~{~s ~}~%") From patchwork Sat Dec 21 17:04:11 2024 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 8bit X-Patchwork-Submitter: Herman Rimm X-Patchwork-Id: 35112 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 C549F27BBEA; Sat, 21 Dec 2024 17:06:37 +0000 (GMT) X-Spam-Checker-Version: SpamAssassin 3.4.6 (2021-04-09) on mira.cbaines.net X-Spam-Level: X-Spam-Status: No, score=-6.4 required=5.0 tests=BAYES_00,DKIM_INVALID, DKIM_SIGNED,MAILING_LIST_MULTI,RCVD_IN_DNSWL_BLOCKED, RCVD_IN_VALIDITY_CERTIFIED,RCVD_IN_VALIDITY_RPBL,RCVD_IN_VALIDITY_SAFE, SPF_HELO_PASS,URIBL_BLOCKED autolearn=ham autolearn_force=no version=3.4.6 Received: from lists.gnu.org (lists.gnu.org [209.51.188.17]) by mira.cbaines.net (Postfix) with ESMTPS id 1D5FF27BBE2 for ; Sat, 21 Dec 2024 17:06:37 +0000 (GMT) Received: from localhost ([::1] helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1tP2ve-0005TV-DK; Sat, 21 Dec 2024 12:06:15 -0500 Received: from eggs.gnu.org ([2001:470:142:3::10]) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1tP2vW-0005R6-NJ for guix-patches@gnu.org; Sat, 21 Dec 2024 12:06:06 -0500 Received: from debbugs.gnu.org ([2001:470:142:5::43]) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1tP2vV-0003PZ-UD for guix-patches@gnu.org; Sat, 21 Dec 2024 12:06:06 -0500 DKIM-Signature: v=1; a=rsa-sha256; q=dns/txt; c=relaxed/relaxed; d=debbugs.gnu.org; s=debbugs-gnu-org; h=MIME-Version:References:In-Reply-To:Date:From:To:Subject; bh=q8l2CGW8ua0o6eD68houCMsDsSN0DbJ0eXCyDxg2/X8=; b=BJ8Iy9Fz5iNG3hin17OfQyxAhR3sb/JIMIqrQnbU8N4xpEQ3liNBEUGTCffK6XrBf5vbCQ2RG5Cl9aXu4KrhcPSwA1Vlwxg3tIyEztE+ZBOR2rRm09UH9FUWveHHiSz+d6Uq1f4iNnh3qwkav+U862q/YT1QMQRiYsCojqTQECehkLRsmzJYzo9i0sKx/ep3xa/7nhlWnSmPAXTzEap2RcdnRXIdV21sztfvO9sq0yCp3JXkId6qCehjW/lNbYVx9hjTsVfdcPYHM2OfRblIYufuxXi/ngHzZ1yRLArnAEO/NCJVVaUbWEEjTlVydrZZkk9Bs85OOEDNoJKhusaqXA==; Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1tP2vV-0005Rn-Ob for guix-patches@gnu.org; Sat, 21 Dec 2024 12:06:05 -0500 X-Loop: help-debbugs@gnu.org Subject: [bug#75010] [PATCH 7/7] WIP: gnu: tests: Add module for guix deploy tests. Resent-From: Herman Rimm Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Sat, 21 Dec 2024 17:06:05 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 75010 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: patch To: 75010@debbugs.gnu.org Received: via spool by 75010-submit@debbugs.gnu.org id=B75010.173480071720822 (code B ref 75010); Sat, 21 Dec 2024 17:06:05 +0000 Received: (at 75010) by debbugs.gnu.org; 21 Dec 2024 17:05:17 +0000 Received: from localhost ([127.0.0.1]:47527 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1tP2ui-0005Pg-Qs for submit@debbugs.gnu.org; Sat, 21 Dec 2024 12:05:17 -0500 Received: from 81-205-150-117.fixed.kpn.net ([81.205.150.117]:43315 helo=email.rimm.ee) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1tP2ud-0005Kx-Jc for 75010@debbugs.gnu.org; Sat, 21 Dec 2024 12:05:12 -0500 DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=rimm.ee; s=herman; t=1734800700; h=from:from:reply-to:subject:subject:date:date:message-id:message-id: to:to:cc:mime-version:mime-version:content-type:content-type: content-transfer-encoding:content-transfer-encoding: in-reply-to:in-reply-to:references:references; bh=q8l2CGW8ua0o6eD68houCMsDsSN0DbJ0eXCyDxg2/X8=; b=eTWF4QOMTkmXKcYONocuNLyjGHAloL4444ByhYZJJuxovnRsVPjTrXnr5KR+J2oIR34U1i c1OBtNZHMJzs6XwLH/dK21+BDN+gOy+aWiI7DuES4WHhWJqWgxLouYjtYR3xnYcFlDigBx 0gNHu8rjCOYmHr4oyF0mlr734I/iETrkdafoe8j5qyZLxDf1PGjfI2kvuT1/CPr7Aks1bS MTzsJFT7/bzIuei7n3GRFkBWKVxDV582zulKwHXpg0c5u+FBAwN7lmwKHvZG5ufi/E0orY 062JhGuAFdVB69/vVU4gT8CNNls2StC2ruDlbdVgndUakkvn80QINv5DMAUm9A== Received: by 81-205-150-117.fixed.kpn.net (OpenSMTPD) with ESMTPSA id bdd870d6 (TLSv1.3:TLS_CHACHA20_POLY1305_SHA256:256:NO) for <75010@debbugs.gnu.org>; Sat, 21 Dec 2024 17:05:00 +0000 (UTC) Date: Sat, 21 Dec 2024 18:04:11 +0100 Message-ID: <6438a457713360741155104b3b2c8af6fda50ee4.1734798943.git.herman@rimm.ee> X-Mailer: git-send-email 2.45.2 In-Reply-To: References: 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: , Reply-to: Herman Rimm X-ACL-Warn: , Herman Rimm via Guix-patches X-Patchwork-Original-From: Herman Rimm via Guix-patches via From: Herman Rimm Errors-To: guix-patches-bounces+patchwork=mira.cbaines.net@gnu.org Sender: guix-patches-bounces+patchwork=mira.cbaines.net@gnu.org X-getmail-retrieved-from-mailbox: Patches * gnu/tests/deploy.scm: Add file. Change-Id: I348c8bf2e518ec6c00af126993eaca3fcd453901 --- gnu/tests/deploy.scm | 203 +++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 203 insertions(+) create mode 100644 gnu/tests/deploy.scm diff --git a/gnu/tests/deploy.scm b/gnu/tests/deploy.scm new file mode 100644 index 0000000000..24671cddec --- /dev/null +++ b/gnu/tests/deploy.scm @@ -0,0 +1,203 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2019 Jakob L. Kreuze +;;; Copyright © 2024 Herman Rimm +;;; +;;; This file is part of GNU Guix. +;;; +;;; GNU Guix is free software; you can redistribute it and/or modify it +;;; under the terms of the GNU General Public License as published by +;;; the Free Software Foundation; either version 3 of the License, or (at +;;; your option) any later version. +;;; +;;; GNU Guix is distributed in the hope that it will be useful, but +;;; WITHOUT ANY WARRANTY; without even the implied warranty of +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;;; GNU General Public License for more details. +;;; +;;; You should have received a copy of the GNU General Public License +;;; along with GNU Guix. If not, see . + +(define-module (gnu tests deploy) + #:use-module (gnu packages gnupg) + #:use-module ((guix self) #:select (make-config.scm)) + #:use-module (gnu services) + #:use-module (gnu services base) + #:use-module (gnu services ssh) + #:use-module (gnu system) + #:use-module (gnu system vm) + #:use-module (gnu tests) + #:use-module (guix gexp) + #:use-module (guix modules) + #:use-module (ice-9 match) + #:export (%test-deploy + %test-rollback)) + +;;; Commentary: +;;; +;;; Test in-place system deployment: advancing the system generation on +;;; a running instance of the Guix System. +;;; +;;; Code: + +(define (machines os) + (program-file "machines.scm" + #~(list (machine (configuration + (machine-ssh-configuration + (host-name "localhost") + (system (%current-system)))) + (environment managed-host-environment-type) + (operating-system #$os))))) + +(define not-config? + ;; Select (guix …) and (gnu …) modules, except (guix config). + (match-lambda + (('guix 'config) #f) + (('guix rest ...) #t) + (('gnu rest ...) #t) + (_ #f))) + +(define* (deploy-program #:optional (os #~%simple-os)) + (program-file "deploy.scm" + (with-extensions (list guile-gcrypt) + (with-imported-modules `(,@(source-module-closure + '((guix scripts deploy)) + #:select? not-config?) + ((guix config) => ,(make-config.scm))) + #~(begin + (use-modules (guix scripts deploy)) + (guix-deploy #$(machines os))))))) + +(define os + (marionette-operating-system + (simple-operating-system + (service openssh-service-type + (openssh-configuration + (permit-root-login #t) + (allow-empty-passwords? #t))) + (service static-networking-service-type + (list (static-networking + (inherit %loopback-static-networking) + (provision '(networking)))))) + #:imported-modules '((gnu services herd) + (guix combinators)))) + +(define vm (virtual-machine os)) + +(define* (run-deploy-test) + "Run a test of an OS running DEPLOY-PROGRAM, which creates a new +generation of the system profile." + (define (test script) + (with-imported-modules '((gnu build marionette)) + #~(begin + (use-modules (gnu build marionette) + (srfi srfi-64)) + + (define marionette + (make-marionette (list #$vm))) + + ;; Return the names of the generation symlinks on MARIONETTE. + (define (system-generations marionette) + (marionette-eval + '(begin + (use-modules (ice-9 ftw) + (srfi srfi-1)) + (let* ((profile-dir "/var/guix/profiles/") + (entries (map first (cddr (file-system-tree profile-dir))))) + (remove (lambda (entry) + (member entry '("per-user" "system"))) + entries))) + marionette)) + + (test-runner-current (system-test-runner #$output)) + (test-begin "deploy") + + (let ((generations-prior (system-generations marionette))) + (test-assert "script successfully evaluated" + (marionette-eval + '(primitive-load #$script) + marionette)) + + (test-equal "script created new generation" + (length (system-generations marionette)) + (1+ (length generations-prior))) + + (test-equal "script activated the new generation" + (string-append "/var/guix/profiles/system-" + (number->string (+ 1 (length generations-prior))) + "-link") + (marionette-eval '(readlink "/run/current-system") + marionette))) + + (test-end)))) + + (gexp->derivation "deploy" (test (deploy-program)))) + +(define* (run-rollback-test) + "Run a test of an OS with a faulty bootloader running DEPLOY-PROGRAM, +which causes a rollback." + (define os + #~(operating-system + (inherit %simple-os) + (bootloader + (bootloader-configuration + (inherit (operating-system-bootloader + %simple-os)) + (targets '("/dev/null")))))) + + (define (test script) + (with-imported-modules '((gnu build marionette)) + #~(begin + (use-modules (gnu build marionette) + (srfi srfi-64)) + + (define marionette + (make-marionette (list #$vm))) + + ;; Return the names of the generation symlinks on MARIONETTE. + (define (system-generations marionette) + (marionette-eval + '(begin + (use-modules (ice-9 ftw) + (srfi srfi-1)) + (let* ((profile-dir "/var/guix/profiles/") + (entries (map first (cddr (file-system-tree profile-dir))))) + (remove (lambda (entry) + (member entry '("per-user" "system"))) + entries))) + marionette)) + + (test-runner-current (system-test-runner #$output)) + (test-begin "rollback") + + (let ((generations-prior (system-generations marionette))) + (test-assert "script successfully evaluated" + (marionette-eval + '(primitive-load #$script) + marionette)) + + (test-equal "script created new generation" + (length (system-generations marionette)) + (1+ (length generations-prior))) + + (test-equal "script rolled back the new generation" + (string-append "/var/guix/profiles/system-" + (number->string (length generations-prior)) + "-link") + (marionette-eval '(readlink "/run/current-system") + marionette))) + + (test-end)))) + + (gexp->derivation "rollback" (test (deploy-program os)))) + +(define %test-deploy + (system-test + (name "deploy") + (description "Deploy to the local machine.") + (value (run-deploy-test)))) + +(define %test-rollback + (system-test + (name "rollback") + (description "Rollback the deployment of a faulty bootloader.") + (value (run-rollback-test))))