From patchwork Fri Jul 5 23:46:44 2019 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 8bit X-Patchwork-Submitter: "Jakob L. Kreuze" X-Patchwork-Id: 14483 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 35DAD171C0; Sat, 6 Jul 2019 00:48:19 +0100 (BST) X-Spam-Checker-Version: SpamAssassin 3.4.0 (2014-02-07) on mira.cbaines.net X-Spam-Level: X-Spam-Status: No, score=-1.9 required=5.0 tests=BAYES_00,URIBL_BLOCKED autolearn=unavailable autolearn_force=no version=3.4.0 Received: from lists.gnu.org (lists.gnu.org [209.51.188.17]) by mira.cbaines.net (Postfix) with ESMTP id AF923171A5 for ; Sat, 6 Jul 2019 00:48:18 +0100 (BST) Received: from localhost ([::1]:57016 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.86_2) (envelope-from ) id 1hjXwA-0007Ve-DQ for patchwork@mira.cbaines.net; Fri, 05 Jul 2019 19:48:18 -0400 Received: from eggs.gnu.org ([2001:470:142:3::10]:42333) by lists.gnu.org with esmtp (Exim 4.86_2) (envelope-from ) id 1hjXvw-0007Oo-Py for guix-patches@gnu.org; Fri, 05 Jul 2019 19:48:06 -0400 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1hjXvu-0005Md-J8 for guix-patches@gnu.org; Fri, 05 Jul 2019 19:48:04 -0400 Received: from debbugs.gnu.org ([209.51.188.43]:45166) by eggs.gnu.org with esmtps (TLS1.0:RSA_AES_128_CBC_SHA1:16) (Exim 4.71) (envelope-from ) id 1hjXvu-0005MX-FY for guix-patches@gnu.org; Fri, 05 Jul 2019 19:48:02 -0400 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1hjXvu-0007do-AP for guix-patches@gnu.org; Fri, 05 Jul 2019 19:48:02 -0400 X-Loop: help-debbugs@gnu.org Subject: [bug#36404] [PATCH 1/3] guix system: Add 'reconfigure' module. Resent-From: zerodaysfordays@sdf.lonestar.org (Jakob L. Kreuze) Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Fri, 05 Jul 2019 23:48:02 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 36404 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: patch To: Ludovic =?utf-8?q?Court=C3=A8s?= Received: via spool by 36404-submit@debbugs.gnu.org id=B36404.156237042829288 (code B ref 36404); Fri, 05 Jul 2019 23:48:02 +0000 Received: (at 36404) by debbugs.gnu.org; 5 Jul 2019 23:47:08 +0000 Received: from localhost ([127.0.0.1]:53986 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1hjXv1-0007cK-Ix for submit@debbugs.gnu.org; Fri, 05 Jul 2019 19:47:08 -0400 Received: from mx.sdf.org ([205.166.94.20]:51005) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1hjXuy-0007c9-6X for 36404@debbugs.gnu.org; Fri, 05 Jul 2019 19:47:05 -0400 Received: from Upsilon (mobile-166-171-185-104.mycingular.net [166.171.185.104]) (authenticated (0 bits)) by mx.sdf.org (8.15.2/8.14.5) with ESMTPSA id x65Nkoxq002677 (using TLSv1.2 with cipher AES256-GCM-SHA384 (256 bits) verified NO); Fri, 5 Jul 2019 23:46:56 GMT From: zerodaysfordays@sdf.lonestar.org (Jakob L. Kreuze) References: <87o92ianbj.fsf@sdf.lonestar.org> <87o92glap5.fsf@dustycloud.org> <878sthoqzi.fsf@gnu.org> <87r2799tzd.fsf@sdf.lonestar.org> <87d0isrsmk.fsf@sdf.lonestar.org> <878std3fw0.fsf@sdf.lonestar.org> <87wogwoqrg.fsf@gnu.org> <87bly8f3kq.fsf_-_@sdf.lonestar.org> Date: Fri, 05 Jul 2019 19:46:44 -0400 In-Reply-To: <87bly8f3kq.fsf_-_@sdf.lonestar.org> (Jakob L. Kreuze's message of "Fri, 05 Jul 2019 19:45:41 -0400") Message-ID: <877e8wf3iz.fsf_-_@sdf.lonestar.org> User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/26.2 (gnu/linux) MIME-Version: 1.0 X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-detected-operating-system: by eggs.gnu.org: GNU/Linux 2.2.x-3.x [generic] X-Received-From: 209.51.188.43 X-BeenThere: guix-patches@gnu.org List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Cc: 36404@debbugs.gnu.org Errors-To: guix-patches-bounces+patchwork=mira.cbaines.net@gnu.org Sender: "Guix-patches" X-getmail-retrieved-from-mailbox: Patches * guix/scripts/system/reconfigure.scm: New file. * Makefile.am (MODULES): Add it. * guix/scripts/system.scm (bootloader-installer-script): Export variable. --- Makefile.am | 1 + guix/scripts/system.scm | 1 + guix/scripts/system/reconfigure.scm | 157 ++++++++++++++++++++++++++++ 3 files changed, 159 insertions(+) create mode 100644 guix/scripts/system/reconfigure.scm diff --git a/Makefile.am b/Makefile.am index 4d3024e58..1934a21b1 100644 --- a/Makefile.am +++ b/Makefile.am @@ -245,6 +245,7 @@ MODULES = \ guix/scripts/describe.scm \ guix/scripts/system.scm \ guix/scripts/system/search.scm \ + guix/scripts/system/reconfigure.scm \ guix/scripts/lint.scm \ guix/scripts/challenge.scm \ guix/scripts/import/crate.scm \ diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm index 60c1ca5c9..21858ee7d 100644 --- a/guix/scripts/system.scm +++ b/guix/scripts/system.scm @@ -70,6 +70,7 @@ #:use-module (ice-9 match) #:use-module (rnrs bytevectors) #:export (guix-system + bootloader-installer-script read-operating-system)) diff --git a/guix/scripts/system/reconfigure.scm b/guix/scripts/system/reconfigure.scm new file mode 100644 index 000000000..f4ca6b4b1 --- /dev/null +++ b/guix/scripts/system/reconfigure.scm @@ -0,0 +1,157 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2019 Jakob L. Kreuze +;;; +;;; 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 (guix scripts system reconfigure) + #:autoload (gnu packages gnupg) (guile-gcrypt) + #:use-module (guix gexp) + #:use-module (guix modules) + #:export (switch-to-system + upgrade-shepherd-services + install-bootloader)) + +;;; Commentary: +;;; +;;; This module implements the "effectful" parts of system +;;; reconfiguration. Although building a system derivation is a pure +;;; operation, a number of impure operations must be carried out for the +;;; system configuration to be realized -- chiefly, creation of generation +;;; symlinks and invocation of activation scripts. +;;; +;;; Code: + +(define (switch-to-system system-derivation activation-script) + "Return a G-Expression that, upon being evaluated, will create a new +generation for SYSTEM-DERIVATION and execute ACTIVATION-SCRIPT." + (with-extensions (list guile-gcrypt) + (with-imported-modules (source-module-closure '((guix config) + (guix profiles) + (guix utils))) + #~(begin + (use-modules (guix config) + (guix profiles) + (guix utils)) + + (define %system-profile + (string-append %state-directory "/profiles/system")) + + (let* ((system #$system-derivation) + (number (1+ (generation-number %system-profile))) + (generation (generation-file-name %system-profile number))) + (switch-symlinks generation system) + (switch-symlinks %system-profile generation) + ;; The implementation of 'guix system reconfigure' saves the + ;; load path and environment here. This is unnecessary here + ;; because each invocation of 'remote-eval' runs in a distinct + ;; Guile REPL. + (setenv "GUIX_NEW_SYSTEM" system) + ;; The activation script may write to stdout, which confuses + ;; 'remote-eval' when it attempts to read a result from the + ;; remote REPL. We work around this by forcing the output to a + ;; string. + (with-output-to-string + (lambda () + (primitive-load #$activation-script)))))))) + +;; XXX: Currently, this does NOT attempt to restart running services. See +;; for details. +(define (upgrade-shepherd-services target-services) + "Return a G-Expression that, upon being evaluated, will use TARGET-SERVICES, +a list of (shepherd-service-canonical-name, shepherd-service-file) pairs to +determine which services are obsolete and need to be unloaded, as well as +which services are new and need to be started." + (with-imported-modules '((gnu services herd)) + #~(begin + (use-modules (gnu services herd) + (srfi srfi-1)) + + (define running + (filter live-service-running (current-services))) + + (define (essential? service) + ;; Return #t if SERVICE is essential and should not be unloaded + ;; under any circumstance. + (memq (first (live-service-provision service)) + '(root shepherd))) + + (define (obsolete? service) + ;; Return #t if SERVICE can be safely unloaded. + (and (not (essential? service)) + (every (lambda (requirements) + (not (memq (first (live-service-provision service)) + requirements))) + (map live-service-requirement running)))) + + (define to-unload + (filter obsolete? + (remove (lambda (service) + (memq (first (live-service-provision service)) + (map first '#$target-services))) + running))) + + (define to-start + (remove (lambda (service-pair) + (memq (first service-pair) + (map (compose first live-service-provision) + running))) + '#$target-services)) + + ;; Unload obsolete services. + (for-each (lambda (service) + (false-if-exception + (unload-service service))) + to-unload) + + ;; Load the service files for any new services and start them. + (load-services/safe (map second to-start)) + (for-each start-service (map first to-start))))) + +(define (install-bootloader installer-script bootcfg bootcfg-file target) + "Return a G-Expression that, upon being evaluated, will install BOOTCFG to +BOOTCFG-FILE, a target path, on TARGET, a mount point, and subsequently run +INSTALLER-SCRIPT." + (with-extensions (list guile-gcrypt) + (with-imported-modules (source-module-closure '((gnu build install) + (guix store) + (guix utils))) + #~(begin + (use-modules (gnu build install) + (guix store) + (guix utils)) + (let* ((gc-root (string-append "/" %gc-roots-directory "/bootcfg")) + (temp-gc-root (string-append gc-root ".new"))) + + (switch-symlinks temp-gc-root gc-root) + + (unless (false-if-exception + (begin + ;; The implementation of 'guix system reconfigure' + ;; saves the load path here. This is unnecessary here + ;; because each invocation of 'remote-eval' runs in a + ;; distinct Guile REPL. + (install-boot-config #$bootcfg #$bootcfg-file #$target) + ;; The installation script may write to stdout, which + ;; confuses 'remote-eval' when it attempts to read a + ;; result from the remote REPL. We work around this + ;; by forcing the output to a string. + (with-output-to-string + (lambda () + (primitive-load #$installer-script))))) + (delete-file temp-gc-root) + (error "failed to install bootloader")) + + (rename-file temp-gc-root gc-root))))))