From patchwork Fri May 9 06:02:25 2025 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 8bit X-Patchwork-Submitter: Herman Rimm X-Patchwork-Id: 42474 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 3A5F027BC4A; Fri, 9 May 2025 07:04:57 +0100 (BST) X-Spam-Checker-Version: SpamAssassin 3.4.6 (2021-04-09) on mira.cbaines.net X-Spam-Level: X-Spam-Status: No, score=-7.4 required=5.0 tests=BAYES_00,DKIM_INVALID, DKIM_SIGNED,MAILING_LIST_MULTI,RCVD_IN_DNSWL_BLOCKED,RCVD_IN_MSPIKE_H2, 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 1FF5F27BC49 for ; Fri, 9 May 2025 07:04:55 +0100 (BST) Received: from localhost ([::1] helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1uDGqA-0004d8-NI; Fri, 09 May 2025 02:04:10 -0400 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 1uDGq2-0004bf-Uk for guix-patches@gnu.org; Fri, 09 May 2025 02:04:02 -0400 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 1uDGq2-00039j-Me for guix-patches@gnu.org; Fri, 09 May 2025 02:04:02 -0400 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=QwBsfceGtQS9myS7WtGN7PYeKY26Uli8gSPQiFIcf3k=; b=bUJXtT8nlKOrHpmHgALt3Mh4wTS7gZKOQA0GFmQqKMXSfEz0pwRld2nYtbueNFIu04FNGa+kyKO6WHa+GrkOgd91W/mhiwJ3pPUlxexgJ97k2X/TAKcxYpo+BGy4XDOGVn/j9Af6XifNFPVq/X8r+JVMaBV3G9vtyhtUDsDzdkCcFO+ut6s9eMcUsmDL9fSYMKEhSM3hZL5IQlvLwQU4DSuZXz1Vu948kOkIJfyU8grluEASroSgFPw4U/Baz4+9+ynEvlxS5sI2ZYryHoEKXLHj8hOrQU3Gv4IBO2q5TSLkV/XDmiFgVMzQtocry4LuyQ9tF/IZ5E2M1vLOjO4zkQ==; Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1uDGq2-0002ZV-G8 for guix-patches@gnu.org; Fri, 09 May 2025 02:04:02 -0400 X-Loop: help-debbugs@gnu.org Subject: [bug#75010] [PATCH v4 1/5] gnu: machine: ssh: Refactor roll-back-managed-host. Resent-From: Herman Rimm Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Fri, 09 May 2025 06:04: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 moreinfo To: 75010@debbugs.gnu.org Received: via spool by 75010-submit@debbugs.gnu.org id=B75010.17467706189804 (code B ref 75010); Fri, 09 May 2025 06:04:02 +0000 Received: (at 75010) by debbugs.gnu.org; 9 May 2025 06:03:38 +0000 Received: from localhost ([127.0.0.1]:34609 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1uDGpd-0002Y2-OC for submit@debbugs.gnu.org; Fri, 09 May 2025 02:03:38 -0400 Received: from 81-205-150-117.fixed.kpn.net ([81.205.150.117]:50871 helo=email.rimm.ee) by debbugs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.84_2) (envelope-from ) id 1uDGpZ-0002XI-OK for 75010@debbugs.gnu.org; Fri, 09 May 2025 02:03:35 -0400 DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=rimm.ee; s=herman; t=1746770603; 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=KovGb9q5Hzxl+fhWRoiB5wNgqVKByyi3gnd/e5c5+Zo=; b=A/IqKLEBEKbz3Kv1NnUPutl0i/Ja2Rnyr1A4mPVyJuVPTEu8bEbwR5+4EIzbhb7T7+5OOr JpjrBRGohYKp+YH7C4BkiNFY6RgF7Oe7C5bnx0XO3gfnCkB3Wr1a/nKS0tQZTBQpqYMH+8 GSEMzFIp6k8IZCQz/viT//1GFnR2j+27HEwUyytpg9CkUQYQPkpKg1WVDXlpjnhtyOkqfq 4f+6E2WEXEmRha4u4b/axd9R0fHmDI7ig34Zdv5CEcYv3GZ3+LVL9bHL1YUo8vQfcwdLuV LiWmLYJJSqVrxyIMqUyVxUbK9Buc4xbHXmzm5e4hGNp3nPw4gRumOSGSrR1NFA== Received: by 81-205-150-117.fixed.kpn.net (OpenSMTPD) with ESMTPSA id b4f98ec1 (TLSv1.3:TLS_CHACHA20_POLY1305_SHA256:256:NO) for <75010@debbugs.gnu.org>; Fri, 9 May 2025 06:03:23 +0000 (UTC) Date: Fri, 9 May 2025 08:02:25 +0200 Message-ID: <1b5bd68abb306b6102202f2ef8c194c7c26a1507.1746769714.git.herman@rimm.ee> X-Mailer: git-send-email 2.47.1 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 | 57 +++++++++++++++++++++++---------------------- 1 file changed, 29 insertions(+), 28 deletions(-) diff --git a/gnu/machine/ssh.scm b/gnu/machine/ssh.scm index 73d5dc513ee..696b349a303 100644 --- a/gnu/machine/ssh.scm +++ b/gnu/machine/ssh.scm @@ -3,6 +3,8 @@ ;;; Copyright © 2020-2024 Ludovic Courtès ;;; Copyright © 2024 Ricardo ;;; Copyright © 2025 Arun Isaac +;;; Copyright © 2024 Felix Lechner +;;; Copyright © 2025 Herman Rimm ;;; ;;; This file is part of GNU Guix. ;;; @@ -597,34 +599,33 @@ (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))) - (if (eqv? 'error remote-result) - (raise roll-back-failure) - (return remote-result)))) + (mlet %store-monad + ((boot-parameters (machine-boot-parameters machine))) + (match boot-parameters + ((_ 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))) + (if (eqv? 'error remote-result) + (raise roll-back-failure) + (return remote-result))))) + (_ (raise roll-back-failure))))) ;;; From patchwork Fri May 9 06:02:26 2025 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Herman Rimm X-Patchwork-Id: 42471 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 CE1D227BC49; Fri, 9 May 2025 07:04:27 +0100 (BST) X-Spam-Checker-Version: SpamAssassin 3.4.6 (2021-04-09) on mira.cbaines.net X-Spam-Level: X-Spam-Status: No, score=-7.4 required=5.0 tests=BAYES_00,DKIM_INVALID, DKIM_SIGNED,MAILING_LIST_MULTI,RCVD_IN_DNSWL_BLOCKED,RCVD_IN_MSPIKE_H2, RCVD_IN_VALIDITY_CERTIFIED,RCVD_IN_VALIDITY_RPBL,RCVD_IN_VALIDITY_SAFE, SPF_HELO_PASS 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 89F6627BC49 for ; Fri, 9 May 2025 07:04:27 +0100 (BST) Received: from localhost ([::1] helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1uDGq9-0004cg-7B; Fri, 09 May 2025 02:04:09 -0400 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 1uDGq3-0004bv-RE for guix-patches@gnu.org; Fri, 09 May 2025 02:04:04 -0400 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 1uDGq3-00039x-JL for guix-patches@gnu.org; Fri, 09 May 2025 02:04:03 -0400 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=A0OT8GbcURu8PLGiAj++IjE06n0Ltb5bVSP75tS3CNI=; b=lhh/mNI0tveuAFxdv85GY+iUaQ0OpBnsiBkY1B7AaYHbXr4EPaVu+TaYxy/JWSRx/I82a+VrMqpin9O85xIiL2r4U72aeLZOwYs12A+JJG/IrhJXINvXJWG3CxZ1Ifxx1mIGTGTKPVv35ZTPhiuVjyW7IkPUjInVjVMWQDzT/Lj9gBn2c4rdEwRKRvzArDbB4xUlnKWtCk5gGUkxSP8rXcUwzkLidhBKExzQFC2knkf+02RJm6e2G4MiJEWSa2Fx6R1t53ME0jm0ExN87OJPKqN/Rhk4h2AlQoVRljgN87pzMtCLE5vh5OdOGdcp6IE0/z9Ut/zgGCZEhEE64Ni87w==; Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1uDGq3-0002Zk-Ec for guix-patches@gnu.org; Fri, 09 May 2025 02:04:03 -0400 X-Loop: help-debbugs@gnu.org Subject: [bug#75010] [PATCH v4 2/5] Rename two remote variables confusingly named 'generations'. Resent-From: Herman Rimm Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Fri, 09 May 2025 06:04: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 moreinfo To: 75010@debbugs.gnu.org Cc: Felix Lechner Received: via spool by 75010-submit@debbugs.gnu.org id=B75010.17467706229832 (code B ref 75010); Fri, 09 May 2025 06:04:03 +0000 Received: (at 75010) by debbugs.gnu.org; 9 May 2025 06:03:42 +0000 Received: from localhost ([127.0.0.1]:34615 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1uDGpi-0002YQ-0B for submit@debbugs.gnu.org; Fri, 09 May 2025 02:03:42 -0400 Received: from 81-205-150-117.fixed.kpn.net ([81.205.150.117]:50871 helo=email.rimm.ee) by debbugs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.84_2) (envelope-from ) id 1uDGpb-0002XI-C4 for 75010@debbugs.gnu.org; Fri, 09 May 2025 02:03:37 -0400 DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=rimm.ee; s=herman; t=1746770603; 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=A0OT8GbcURu8PLGiAj++IjE06n0Ltb5bVSP75tS3CNI=; b=JA3OXYklK/fbY0HEF4nfNPDJOtF9AXzYxNJbUtwhc6XsQOm+j3xGPaunCdq2EqeIBy06LC qEtRyEk2kzTpU+BrXbc8KgwfUxtmjrQAxu/cbMhR/Q3uAqwm23Dg9vhqQuYwfh2SrUXpOz WNI0XTnarcBFSpBnDu8nAIJnsesh0JaPnakB6kaAWC6qXi2Se/7KnuXUzmcBWucYUYiFL/ e+6e1t8UpdeD8RLkHMEPO10B6jCjl3vLVdoLFHsNjt0MplWHnq1SwAMGbmY6fBTRVKb8/p 3ToSzRRvYxtpr7tSDC8aRF/55Y9O9jZrYhn8viRmPSC327XXQq/qgVbt+puu3g== Received: by 81-205-150-117.fixed.kpn.net (OpenSMTPD) with ESMTPSA id 3ecfd81b (TLSv1.3:TLS_CHACHA20_POLY1305_SHA256:256:NO); Fri, 9 May 2025 06:03:23 +0000 (UTC) Date: Fri, 9 May 2025 08:02:26 +0200 Message-ID: <06dd6b3f55cfdf7fb7610618d1071058b7db0b2a.1746769714.git.herman@rimm.ee> X-Mailer: git-send-email 2.47.1 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 696b349a303..47f379c57e3 100644 --- a/gnu/machine/ssh.scm +++ b/gnu/machine/ssh.scm @@ -456,10 +456,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)) @@ -478,7 +479,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 Fri May 9 06:02:27 2025 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Herman Rimm X-Patchwork-Id: 42472 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 E034527BC4B; Fri, 9 May 2025 07:04:41 +0100 (BST) X-Spam-Checker-Version: SpamAssassin 3.4.6 (2021-04-09) on mira.cbaines.net X-Spam-Level: X-Spam-Status: No, score=-7.4 required=5.0 tests=BAYES_00,DKIM_INVALID, DKIM_SIGNED,MAILING_LIST_MULTI,RCVD_IN_DNSWL_BLOCKED,RCVD_IN_MSPIKE_H2, RCVD_IN_VALIDITY_CERTIFIED,RCVD_IN_VALIDITY_RPBL,RCVD_IN_VALIDITY_SAFE, SPF_HELO_PASS 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 6357827BC49 for ; Fri, 9 May 2025 07:04:41 +0100 (BST) Received: from localhost ([::1] helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1uDGq8-0004cc-R5; Fri, 09 May 2025 02:04:08 -0400 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 1uDGq3-0004bu-Eq for guix-patches@gnu.org; Fri, 09 May 2025 02:04:04 -0400 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 1uDGq3-00039s-5R for guix-patches@gnu.org; Fri, 09 May 2025 02:04:03 -0400 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=WZ5+AW4Qwp38QiV0uDasmznt2IFOQPwL9GcSIcR8LnM=; b=TKGvZju5FGdQTcvZor0AAMdYmTPqU5Lr7XZReocG7q7O7MDAAjC9MqAvnyyvYvesw0djAEhOLx596H3WXKOTReNaOkbBnqru8yDipJHCpi1l5NtLzcUbksZFA688jrkrlN2nMIvaUHscwrAeyn3GC2ieN9YNd56PYxwi+sU2Liao1zoC+5F5hOeVWrBbx5PCfPB2Eney1gYu7LhNHGtqXT3kB+5lWiC83GoqJkatkRhTWp5It9UPYTkzH9IGDxwl+Baj+Zzr4MCmLq72Gy1GYE+lzeYuN0SfWkW45VrjGLmEgNvCuE9DWK5WQOLmbnh0Cx7IdnGUwryW4k9Ig0roMg==; Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1uDGq3-0002Zc-0m for guix-patches@gnu.org; Fri, 09 May 2025 02:04:03 -0400 X-Loop: help-debbugs@gnu.org Subject: [bug#75010] [PATCH v4 3/5] gnu: machine: Remove &deploy-error. Resent-From: Herman Rimm Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Fri, 09 May 2025 06:04: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 moreinfo To: 75010@debbugs.gnu.org Received: via spool by 75010-submit@debbugs.gnu.org id=B75010.17467706229825 (code B ref 75010); Fri, 09 May 2025 06:04:02 +0000 Received: (at 75010) by debbugs.gnu.org; 9 May 2025 06:03:42 +0000 Received: from localhost ([127.0.0.1]:34613 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1uDGph-0002YO-8X for submit@debbugs.gnu.org; Fri, 09 May 2025 02:03:41 -0400 Received: from 81-205-150-117.fixed.kpn.net ([81.205.150.117]:52169 helo=email.rimm.ee) by debbugs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.84_2) (envelope-from ) id 1uDGpc-0002XQ-NN for 75010@debbugs.gnu.org; Fri, 09 May 2025 02:03:37 -0400 DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=rimm.ee; s=herman; t=1746770604; 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=30QiySZrk8Vsw3in5KBxGqsvGL6poSAmwkyZL5AqbSw=; b=j7SBkIOewUSpQ3/aaDybiZEALMGLMAXPJN8FuG0/YwB62XnrmOhUpi/8usogqBktQOMBtD 1JYxYOM/+JNFd75L4d/vCgcxWJ2AtHv454Xwu9JhTYYAYHqqXboSxVaZU8yUzPRtJR6wxz svdLb6Zqp1bZ1SIoiLrWzo2Ojwx+IY7qnUvY9KYL+4E97AR5RcDcG0C47Sd0Aq9ELH2w1l R87kSELI6xaMpEvbojblDegtVtBdQKgHJo3i0wKaGe//70ipPFNGa7yd1ReC3WMu/0KTl7 kHVaXr4L8IWXPEPJ7KCCj95tywbo+s/B1Fu59HupbmNk8SoHc5rACoD2LZWoCA== Received: by 81-205-150-117.fixed.kpn.net (OpenSMTPD) with ESMTPSA id 22121843 (TLSv1.3:TLS_CHACHA20_POLY1305_SHA256:256:NO) for <75010@debbugs.gnu.org>; Fri, 9 May 2025 06:03:24 +0000 (UTC) Date: Fri, 9 May 2025 08:02:27 +0200 Message-ID: <863bef6e18135cc897c2a8ddfd2634d696fe41c6.1746769714.git.herman@rimm.ee> X-Mailer: git-send-email 2.47.1 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 | 62 +++++++++++++++-------------------------- guix/scripts/deploy.scm | 8 +----- 3 files changed, 25 insertions(+), 62 deletions(-) diff --git a/gnu/machine.scm b/gnu/machine.scm index 60be6749727..ede595d053d 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 47f379c57e3..aea390fe0b3 100644 --- a/gnu/machine/ssh.scm +++ b/gnu/machine/ssh.scm @@ -481,18 +481,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." @@ -537,39 +525,35 @@ (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) - (load-system-for-kexec (eval/error-handling c - (warning (G_ "\ + host (inferior-exception-arguments c))) + os) + (load-system-for-kexec + (eval/error-handling c + (warning (G_ "\ failed to load system of '~a' for kexec reboot:~%~{~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 e2ef0006e06..f80982b6d18 100644 --- a/guix/scripts/deploy.scm +++ b/guix/scripts/deploy.scm @@ -181,13 +181,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 Fri May 9 06:02:28 2025 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Herman Rimm X-Patchwork-Id: 42470 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 5F77527BC4A; Fri, 9 May 2025 07:04:23 +0100 (BST) X-Spam-Checker-Version: SpamAssassin 3.4.6 (2021-04-09) on mira.cbaines.net X-Spam-Level: X-Spam-Status: No, score=-7.4 required=5.0 tests=BAYES_00,DKIM_INVALID, DKIM_SIGNED,MAILING_LIST_MULTI,RCVD_IN_DNSWL_BLOCKED,RCVD_IN_MSPIKE_H2, RCVD_IN_VALIDITY_CERTIFIED,RCVD_IN_VALIDITY_RPBL,RCVD_IN_VALIDITY_SAFE, SPF_HELO_PASS 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 5B97327BC49 for ; Fri, 9 May 2025 07:04:21 +0100 (BST) Received: from localhost ([::1] helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1uDGq9-0004ci-Fq; Fri, 09 May 2025 02:04:09 -0400 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 1uDGq4-0004bw-Ao for guix-patches@gnu.org; Fri, 09 May 2025 02:04:04 -0400 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 1uDGq4-0003A4-1o for guix-patches@gnu.org; Fri, 09 May 2025 02:04:04 -0400 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=8CpqUDf8ZdlC4gJ5DMubcB+Q8rCQz8bC3HBoU4fo3vc=; b=KQm1tsyob1syE63RXZYODRTquDyJY9X7qCLXTAYLhdm/rjcTyUMiFzUerutCfslytJmPmPmcCX+rjbpuu9grYJFjZzELAsE1kdtIwbiUe5yETs0UL/H0Vl71oc6N4L/dR/XL+F+Dp4Q73crQn0RPHPab/WGg39O1AA4JOf4061D/2kciWn4Rr/JyppxXRfkQYgwITu/xudzZB4cu0D/ojqoT+BVIx3anz1upEVpPNyWMGLek7H8wPVGmtOanLbvWPw0aENQ1gf6LV5UMSxrGfnygCuU2zmfXNb5Yy0ZlG5f087FAaIfWMkUcOlP30QEzroFal08MofjVTEKmE5tW1g==; Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1uDGq3-0002Zr-T9 for guix-patches@gnu.org; Fri, 09 May 2025 02:04:03 -0400 X-Loop: help-debbugs@gnu.org Subject: [bug#75010] [PATCH v4 4/5] gnu: machine: ssh: Roll-back on failure. Resent-From: Herman Rimm Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Fri, 09 May 2025 06:04: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 moreinfo To: 75010@debbugs.gnu.org Received: via spool by 75010-submit@debbugs.gnu.org id=B75010.17467706229839 (code B ref 75010); Fri, 09 May 2025 06:04:03 +0000 Received: (at 75010) by debbugs.gnu.org; 9 May 2025 06:03:42 +0000 Received: from localhost ([127.0.0.1]:34617 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1uDGpi-0002Yd-G5 for submit@debbugs.gnu.org; Fri, 09 May 2025 02:03:42 -0400 Received: from 81-205-150-117.fixed.kpn.net ([81.205.150.117]:52169 helo=email.rimm.ee) by debbugs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.84_2) (envelope-from ) id 1uDGpd-0002XQ-NZ for 75010@debbugs.gnu.org; Fri, 09 May 2025 02:03:38 -0400 DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=rimm.ee; s=herman; t=1746770604; 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=8CpqUDf8ZdlC4gJ5DMubcB+Q8rCQz8bC3HBoU4fo3vc=; b=XyYrt/Nrc/P4LXE2Cd0n1UO1bPeBQEGB6YXvGOI6/D9pY1kJvOVvv0onpabZ7wdQcttc+E z36J7SNSel/fPH+nV3WzC0k4W8NKZqE2mjLILisOAX8kkEkNoASsQb1OCYAC2Ao4rJqxxK EaZ77JOXfJcvxCq9Wyf03WwdELcgptO5kerIBbLg8fq4dhH71YHy1ag6N1pj7aH2jZtR77 G28kWXC15KS2Sin++GOFCcorVA8Rz0dKznYqlz7QIStPVHPf72+li5iW4/2Gf+jYag8eh2 6GFItmzFjZir66EkLO0hs6V5JPgPoHfJPIWplBt9MrNc3YLeBOEVIFfQCgEMhw== Received: by 81-205-150-117.fixed.kpn.net (OpenSMTPD) with ESMTPSA id 4f7648c3 (TLSv1.3:TLS_CHACHA20_POLY1305_SHA256:256:NO) for <75010@debbugs.gnu.org>; Fri, 9 May 2025 06:03:24 +0000 (UTC) Date: Fri, 9 May 2025 08:02:28 +0200 Message-ID: <4d35b3b044f8a61a4683d12dd71c835fb3d57864.1746769714.git.herman@rimm.ee> X-Mailer: git-send-email 2.47.1 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 | 20 +++++++++++++++----- 1 file changed, 15 insertions(+), 5 deletions(-) diff --git a/gnu/machine/ssh.scm b/gnu/machine/ssh.scm index aea390fe0b3..357b4376d4b 100644 --- a/gnu/machine/ssh.scm +++ b/gnu/machine/ssh.scm @@ -513,7 +513,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) @@ -525,7 +526,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 ~}") @@ -536,19 +537,28 @@ (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) (load-system-for-kexec - (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_ "\ failed to load system of '~a' for kexec reboot:~%~{~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 Fri May 9 06:02:29 2025 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 8bit X-Patchwork-Submitter: Herman Rimm X-Patchwork-Id: 42473 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 237D227BC4B; Fri, 9 May 2025 07:04:46 +0100 (BST) X-Spam-Checker-Version: SpamAssassin 3.4.6 (2021-04-09) on mira.cbaines.net X-Spam-Level: X-Spam-Status: No, score=-7.4 required=5.0 tests=BAYES_00,DKIM_INVALID, DKIM_SIGNED,MAILING_LIST_MULTI,RCVD_IN_DNSWL_BLOCKED,RCVD_IN_MSPIKE_H2, RCVD_IN_VALIDITY_CERTIFIED,RCVD_IN_VALIDITY_RPBL,RCVD_IN_VALIDITY_SAFE, SPF_HELO_PASS 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 39C1C27BC49 for ; Fri, 9 May 2025 07:04:45 +0100 (BST) Received: from localhost ([::1] helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1uDGq9-0004cj-WE; Fri, 09 May 2025 02:04:10 -0400 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 1uDGq5-0004cI-6K for guix-patches@gnu.org; Fri, 09 May 2025 02:04:07 -0400 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 1uDGq4-0003AB-HD for guix-patches@gnu.org; Fri, 09 May 2025 02:04:04 -0400 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=S+NO9SJzxQE2zGlSlbZzl/g8uHPAbQ6vrrt/Gbbp7+w=; b=jjYYn1tjSTDegLvvWsuVx/z8EysG2lblH/lfr1OJO5PouaD08imoRVSali2gLcYb5qWenR8/CNqEEqKG2CmG2LH8y8o+6kDtIGAK8o6iwZASIyZ6eMHqR7SF8iqAGAxxAoREXXR8wABGkc8pDcaswGy6br053fwUyVVNK8IfOy16yM4uyENxPz/CYo9n7jVK/4GBphwCVwycm21pNDgAsZ6udRXqdvIFPmeIvajTUGUiOEt4UaZYHxDfXDVs36c6is4h84Xp0P2ubLngkM6/QcLb215DFeGsS4igAgKFY7sAV5qe03e5epCG2Lhk3Yb7TqFs5aE+aT20ixmWUTrb2g==; Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1uDGq4-0002Zy-CT for guix-patches@gnu.org; Fri, 09 May 2025 02:04:04 -0400 X-Loop: help-debbugs@gnu.org Subject: [bug#75010] [PATCH v4 5/5] gnu: tests: Add module for guix deploy tests. Resent-From: Herman Rimm Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Fri, 09 May 2025 06:04: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 moreinfo To: 75010@debbugs.gnu.org Received: via spool by 75010-submit@debbugs.gnu.org id=B75010.17467706239847 (code B ref 75010); Fri, 09 May 2025 06:04:04 +0000 Received: (at 75010) by debbugs.gnu.org; 9 May 2025 06:03:43 +0000 Received: from localhost ([127.0.0.1]:34619 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1uDGpi-0002Yj-Sw for submit@debbugs.gnu.org; Fri, 09 May 2025 02:03:43 -0400 Received: from 81-205-150-117.fixed.kpn.net ([81.205.150.117]:50871 helo=email.rimm.ee) by debbugs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.84_2) (envelope-from ) id 1uDGpd-0002XI-Oi for 75010@debbugs.gnu.org; Fri, 09 May 2025 02:03:39 -0400 DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=rimm.ee; s=herman; t=1746770604; 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=S+NO9SJzxQE2zGlSlbZzl/g8uHPAbQ6vrrt/Gbbp7+w=; b=bgbZGVH9Vj42+TATxJXwXCGvC5NuPCPHRpte/aMrR2EvMU3XcAOiclwLkyZb492x919Bjh JuCAjFolkvMXdEXhydScOKQNFsWT5EwTtXDLYc7NUXOMCYXnihvUF+vkrSi+OsOMjn1cqk OWulNwA1g9B2IoThMEvJQNyn2xftOmp9takfaIZPsY/XhNA5MI6wSULe/+VCq1rAPD6FXG 6/Y71rLbqSbN0amVlyLQT8FpeKVqBWzrBf3k8vzA9yzwPbKwNTMVp2enCQPhoOO/U7pby6 /ysk08Q2QwBd04rofb6G9wWT0h0BpO18N+vBNs2F0r6WixvOS9UjpKvLhExLGA== Received: by 81-205-150-117.fixed.kpn.net (OpenSMTPD) with ESMTPSA id cebc9fe7 (TLSv1.3:TLS_CHACHA20_POLY1305_SHA256:256:NO) for <75010@debbugs.gnu.org>; Fri, 9 May 2025 06:03:24 +0000 (UTC) Date: Fri, 9 May 2025 08:02:29 +0200 Message-ID: <23f3850c0d0d62fb78137e694dc96b34a54c15ec.1746769714.git.herman@rimm.ee> X-Mailer: git-send-email 2.47.1 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. * gnu/local.mk (GNU_SYSTEM_MODULES): Register file. Change-Id: I348c8bf2e518ec6c00af126993eaca3fcd453901 --- gnu/local.mk | 3 +- gnu/tests/deploy.scm | 223 +++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 225 insertions(+), 1 deletion(-) create mode 100644 gnu/tests/deploy.scm diff --git a/gnu/local.mk b/gnu/local.mk index e6ece8cc483..157d327e53b 100644 --- a/gnu/local.mk +++ b/gnu/local.mk @@ -62,7 +62,7 @@ # Copyright © 2023 B. Wilson # Copyright © 2023 Bruno Victal # Copyright © 2023, 2024 gemmaro -# Copyright © 2023 Herman Rimm +# Copyright © 2023, 2025 Herman Rimm # Copyright © 2023 Troy Figiel # Copyright © 2024, 2025 David Elsing # Copyright © 2024 Ashish SHUKLA @@ -847,6 +847,7 @@ GNU_SYSTEM_MODULES = \ %D%/tests/containers.scm \ %D%/tests/cups.scm \ %D%/tests/databases.scm \ + %D%/tests/deploy.scm \ %D%/tests/desktop.scm \ %D%/tests/dns.scm \ %D%/tests/dict.scm \ diff --git a/gnu/tests/deploy.scm b/gnu/tests/deploy.scm new file mode 100644 index 00000000000..55d3edb78ef --- /dev/null +++ b/gnu/tests/deploy.scm @@ -0,0 +1,223 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2019 Jakob L. Kreuze +;;; Copyright © 2024, 2025 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 (gnu packages package-management) + #:use-module (gnu packages ssh) + #: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-source) + (scheme-file "machines.scm" + #~(begin (use-modules (gnu machine ssh) + (guix utils) + (ice-9 textual-ports)) + ;; XXX: (guix platforms ...) are not found in %load-path. + (set! (@ (guix platform) systems) + (compose list %current-system)) + (list (machine + (configuration + (machine-ssh-configuration + (host-name "localhost") + (host-key + (call-with-input-file "/etc/ssh/ssh_host_ed25519_key.pub" + get-string-all)) + (system (%current-system)))) + (environment managed-host-environment-type) + (operating-system #$os-source)))))) + +(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 os-source) + (program-file "deploy.scm" + (with-extensions (list guile-gcrypt guile-ssh) + (with-imported-modules + `(((guix config) => ,(make-config.scm))) + #~(execl #$(file-append (current-guix) "/bin/guix") + "guix" "deploy" #$(machines os-source)))))) + +(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 system-generations-definition + #~(define (system-generations marionette) + "Return the names of the generation symlinks on MARIONETTE." + (marionette-eval + '(begin (use-modules (ice-9 ftw)) + (define (select? entry) + (not (member entry '("per-user" "system" "." "..")))) + (scandir "/var/guix/profiles/" select?)) + marionette))) + +(define* (run-deploy-test) + "Run a test of an OS running DEPLOY-PROGRAM, which creates a new +generation of the system profile." + (define new-os-source + '(begin + (use-modules (gnu tests)) + (operating-system + (inherit %simple-os) + (host-name (substring (operating-system-host-name %simple-os) + 0 1))))) + + (define (test script) + (with-imported-modules '((gnu build marionette)) + #~(begin + (use-modules (gnu build marionette) + (ice-9 match) + (srfi srfi-64)) + + (define marionette + (make-marionette (list #$vm))) + + #$system-generations-definition + + (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-assert "uname" + (match (marionette-eval '(uname) marionette) + (#("Linux" host-name _ ...) + (string=? host-name #$(operating-system-host-name os))))) + + (test-end)))) + + (gexp->derivation "deploy" (test (deploy-program new-os-source)))) + +(define* (run-rollback-test) + "Run a test of an OS with a faulty bootloader running DEPLOY-PROGRAM, +which causes a rollback." + (define bad-os-source + '(begin + (use-modules (gnu tests)) + (operating-system + (inherit %simple-os) + (host-name (substring (operating-system-host-name %simple-os) + 0 1)) + (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) + (ice-9 match) + (srfi srfi-64)) + + (define marionette + (make-marionette (list #$vm))) + + #$system-generations-definition + + (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-assert "uname" + (match (marionette-eval '(uname) marionette) + (#("Linux" host-name _ ...) + (string=? host-name #$(operating-system-host-name os))))) + + (test-end)))) + + (gexp->derivation "rollback" (test (deploy-program bad-os-source)))) + +(define %test-deploy + (system-test + (name "deploy") + (description "Deploy to the local machine.") + (value (run-deploy-test)))) + +(define %test-rollback + (system-test + (name "deploy-rollback") + (description "Rollback guix deploy with a faulty bootloader.") + (value (run-rollback-test))))