From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: from mp1 ([2001:41d0:8:6d80::]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits)) by ms0.migadu.com with LMTPS id GAlOBF6Zt2BAgwEAgWs5BA (envelope-from ) for ; Wed, 02 Jun 2021 16:44:46 +0200 Received: from aspmx1.migadu.com ([2001:41d0:8:6d80::]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits)) by mp1 with LMTPS id MCA4O12Zt2AsfAAAbx9fmQ (envelope-from ) for ; Wed, 02 Jun 2021 14:44:45 +0000 Received: from lists.gnu.org (lists.gnu.org [209.51.188.17]) (using TLSv1.2 with cipher ECDHE-RSA-AES256-GCM-SHA384 (256/256 bits)) (No client certificate requested) by aspmx1.migadu.com (Postfix) with ESMTPS id 655C914E2A for ; Wed, 2 Jun 2021 16:44:45 +0200 (CEST) Received: from localhost ([::1]:39016 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1loS6u-0000c0-BW for larch@yhetil.org; Wed, 02 Jun 2021 10:44:44 -0400 Received: from eggs.gnu.org ([2001:470:142:3::10]:59810) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1loS6f-0000Zi-1B for guix-devel@gnu.org; Wed, 02 Jun 2021 10:44:30 -0400 Received: from mail-40141.protonmail.ch ([185.70.40.141]:60888) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1loS6Y-00030W-Js; Wed, 02 Jun 2021 10:44:28 -0400 Date: Wed, 02 Jun 2021 14:44:12 +0000 DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=protonmail.com; s=protonmail; t=1622645055; bh=V3xkZ8Qe+0IneBP0InTNNGnW+ZBg3rRXruiXQwFT2FU=; h=Date:To:From:Cc:Reply-To:Subject:In-Reply-To:References:From; b=yEEBth8ddT3OkdH2Ft3cbESsqw2qAblQRht3zerDh1DUK77DO6fPydWldYrQ5fVy+ /dYt541BcZkXt5Eia0h3B91HEPcMx7NkQO3Mc4BGR2kPf4OaVhfD/x+IandboHEIyM SPZBqhEZ4toL93QbKp84Haj+vr3avPhUf5wsc7Zo= To: Mathieu Othacehe From: raid5atemyhomework Cc: Pierre Neidhardt , "guix-devel@gnu.org" Subject: Re: Adding Substitute Mirrors page to installer Message-ID: <91TVhqLjb4qN2M9ewI6NRWYNNcka9vbIRPkuPzYAKv_Km_o8eFaD4viDAffo5U0WotEqHt90C3HnFmryv_beBUzuQcBWc4kymN4uDeCHbu8=@protonmail.com> In-Reply-To: <874kei6l6x.fsf@gnu.org> References: <87blbsah0x.fsf@ambrevar.xyz> <-WVvn-rIc2HXdunUeEp6YfVQ9WkU-JsP_sAdLNK4ebx5YUTZ0-lSxWF2MGWOTGpqCvfil-JSAW1n-_82UQlRSXM5Qmb2ajaTYsa_EFUJ6o4=@protonmail.com> <3YQTy8cg8z-IZkxgM7lJSk8ZeolHbf4t7_HPw9Q8GCkx1lP7CXrbdtPZ9Hvyo--NvKXyr9W2iv82d8lL2T0NQPpTPhDbBFo3_3jQ3eAdAEI=@protonmail.com> <87o8eys6ki.fsf@gnu.org> <874kei6l6x.fsf@gnu.org> MIME-Version: 1.0 Content-Type: text/plain; charset=utf-8 Content-Transfer-Encoding: quoted-printable Received-SPF: pass client-ip=185.70.40.141; envelope-from=raid5atemyhomework@protonmail.com; helo=mail-40141.protonmail.ch X-Spam_score_int: -20 X-Spam_score: -2.1 X-Spam_bar: -- X-Spam_report: (-2.1 / 5.0 requ) BAYES_00=-1.9, DKIM_SIGNED=0.1, DKIM_VALID=-0.1, DKIM_VALID_AU=-0.1, DKIM_VALID_EF=-0.1, FREEMAIL_FROM=0.001, RCVD_IN_MSPIKE_H3=0.001, RCVD_IN_MSPIKE_WL=0.001, SPF_HELO_PASS=-0.001, SPF_PASS=-0.001 autolearn=ham autolearn_force=no X-Spam_action: no action X-BeenThere: guix-devel@gnu.org X-Mailman-Version: 2.1.23 Precedence: list List-Id: "Development of GNU Guix and the GNU System distribution." List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Reply-To: raid5atemyhomework Errors-To: guix-devel-bounces+larch=yhetil.org@gnu.org Sender: "Guix-devel" X-Migadu-Flow: FLOW_IN ARC-Message-Signature: i=1; a=rsa-sha256; c=relaxed/relaxed; d=yhetil.org; s=key1; t=1622645085; h=from:from:sender:sender:reply-to:reply-to:subject:subject:date:date: message-id:message-id:to:to:cc:cc:mime-version:mime-version: content-type:content-type: content-transfer-encoding:content-transfer-encoding: in-reply-to:in-reply-to:references:references:list-id:list-help: list-unsubscribe:list-subscribe:list-post:dkim-signature; bh=V3xkZ8Qe+0IneBP0InTNNGnW+ZBg3rRXruiXQwFT2FU=; b=SruFAnL9gmzhq0mhHkqDibQfhYA0SvGrUgpJsA6d795n+0QnhDXGmtqLaoWesHKQ04ljYb TMmTYWWpuKHbPpphBnDyyO6ZsiD1FqkE4sK5DgL303M34CdoKX/CnrWPxmLGWokMQ2TR/R 8BFtzezqkC8kb+ymWBvcNywMVtFOu7MRjuHBjVzlwEJ9yvP9fAemhHu34HAmdqwitsJZBL TnmG0RJ7gyI+zj+yOW2zNXmvy/2LHfilXVDZtQAjIrO5in+gChRwaE8+kdJ/bCcF0+fcVi /PB9hzEYD8Gd9m0tr5NrJ7hwVMAo99dUmAQqmXZfT8enWV5FUazTMtUbAyaL8w== ARC-Seal: i=1; s=key1; d=yhetil.org; t=1622645085; a=rsa-sha256; cv=none; b=X+LBCJaXDa5ikl7EgOAz4+nbokqA2FL1Kwfpy6WQlEork2WcfIoRhqT/nOG9CcOCd9W3Kp 3/Jlp6W5C7pCeqr0Mn9HI5X8+abUhN6biprRk18go3KMOiB23x6WRIKeb1WdSPys7e7zLB vXGbEMx0Z5GDiXGeEeGdtMpIuh6yTbJseCJVXRpm9zSz7ltROHtwzyNQhHxjwZwXB53ZU5 Vyv+Md70lfTRg/nedkpIRbINM8JxENdDQHvKvvU4qe1z92DsK35RSTc6Tue29T3atIGd94 jk5OuR6a0BR9Xzp5nnPV7cYWt+/IvlgTDKnXMK5cCfKuY92My4L15VSvZlGfwg== ARC-Authentication-Results: i=1; aspmx1.migadu.com; dkim=pass header.d=protonmail.com header.s=protonmail header.b=yEEBth8d; dmarc=pass (policy=quarantine) header.from=protonmail.com; spf=pass (aspmx1.migadu.com: domain of guix-devel-bounces@gnu.org designates 209.51.188.17 as permitted sender) smtp.mailfrom=guix-devel-bounces@gnu.org X-Migadu-Spam-Score: -3.13 Authentication-Results: aspmx1.migadu.com; dkim=pass header.d=protonmail.com header.s=protonmail header.b=yEEBth8d; dmarc=pass (policy=quarantine) header.from=protonmail.com; spf=pass (aspmx1.migadu.com: domain of guix-devel-bounces@gnu.org designates 209.51.188.17 as permitted sender) smtp.mailfrom=guix-devel-bounces@gnu.org X-Migadu-Queue-Id: 655C914E2A X-Spam-Score: -3.13 X-Migadu-Scanner: scn0.migadu.com X-TUID: jwCuAdEaIkR9 Hi Mathieu, I added the test as you recommended, **however** it looks to me that within= the test, reading the configuration file leads to an non-`operating-system= ?` object, which seems strange. I was forced to modify the main code as below: + (substitute-urls (and (operating-system? os) + (and=3D> (find + (lambda (service) + (eq? guix-service-type + (service-kind service))) + (operating-system-services os)) + (compose guix-configuration-substitu= te-urls + service-value)))) In previous version there was no`(and (operating-system? os) ...)` guard, a= s we expect that the generated file, when `load`ed, will result in an `oper= ating-system`, so I wonder why the testing environment is somehow different= . Printing via `syslog "~A~%"` shows the `os` object as being some `#`, not an `operating-system` object. Unfortunately I am not very familiar with any particular wrinkles regarding= Guile and its loading system, so I am unsure what is going wrong here... In any case I checked it manually by creating an installer image and then i= nstalling into 2 different VMs, one with ci.guix.gnu.org and the other with= mirror.sjtu.edu.cn. Thanks raid5atemyhomework >From 41b174da1e38b71563405f1be48331fbe0e5700d Mon Sep 17 00:00:00 2001 From: raid5atemyhomework Date: Tue, 16 Mar 2021 23:45:37 +0800 Subject: [PATCH] gnu: Add substitute mirrors page to installer. * gnu/installer/services.scm (system-service) [snippet-type]: New field. (%system-services): Add substitute mirrors. (service-list-service?): New procedure. (modify-services-service?): New procedure. (system-services->configuration): Add support for services with `'modify-services` snippets. * gnu/installer/newt/services.scm (run-substitute-mirror-page): New procedure. (run-services-page): Call `run-substitute-mirror-page`. * gnu/services/base.scm (guix-shepherd-service)[start]: Accept second argument, a space-separated list of substitute URLs. * gnu/installer/final.scm (%user-modules): New variable. (read-operating-system): New procedure. (install-system): Read the installation configuration file and extract substitute URLs to pass to `guix-daemon` start action. * gnu/installer/tests.scm: Add new page in testing. --- gnu/installer/final.scm | 37 +++++++++++++++++++- gnu/installer/newt/services.scm | 26 +++++++++++++- gnu/installer/services.scm | 62 ++++++++++++++++++++++++++++----- gnu/installer/tests.scm | 12 +++++-- gnu/services/base.scm | 15 ++++++-- 5 files changed, 136 insertions(+), 16 deletions(-) diff --git a/gnu/installer/final.scm b/gnu/installer/final.scm index fc0b7803fa..2324c960f2 100644 --- a/gnu/installer/final.scm +++ b/gnu/installer/final.scm @@ -22,9 +22,13 @@ #:use-module (gnu installer steps) #:use-module (gnu installer utils) #:use-module (gnu installer user) + #:use-module (gnu services) + #:use-module (gnu services base) #:use-module (gnu services herd) + #:use-module (gnu system) #:use-module (guix build syscalls) #:use-module (guix build utils) + #:use-module (guix ui) #:use-module (gnu build accounts) #:use-module (gnu build install) #:use-module (gnu build linux-container) @@ -38,6 +42,20 @@ #:use-module (ice-9 rdelim) #:export (install-system)) +;; XXX duplicated from guix/scripts/system.scm, but that pulls in +;; (guix store database), which requires guile-sqlite which is not +;; available in the installation environment. +(define %user-module + ;; Module in which the machine description file is loaded. + (make-user-module '((gnu system) + (gnu services) + (gnu system shadow)))) + +(define (read-operating-system file) + "Read the operating-system declaration from FILE and return it." + (load* file %user-module)) +;; XXX + (define %seed (seed->random-state (logxor (getpid) (car (gettimeofday))))) @@ -174,6 +192,16 @@ or #f. Return #t on success and #f on failure." options (list (%installer-configuration-file) (%installer-target-dir)))) + ;; Extract the substitute URLs of the user configuration. + (os (read-operating-system (%installer-configuration= -file))) + (substitute-urls (and (operating-system? os) + (and=3D> (find + (lambda (service) + (eq? guix-service-type + (service-kind service))) + (operating-system-services os)) + (compose guix-configuration-substitu= te-urls + service-value)))) (database-dir "/var/guix/db") (database-file (string-append database-dir "/db.sqlite")) (saved-database (string-append database-dir "/db.save")) @@ -206,8 +234,15 @@ or #f. Return #t on success and #f on failure." (lambda () ;; We need to drag the guix-daemon to the container MNT ;; namespace, so that it can operate on the cow-store. + ;; Also we need to change the substitute URLs to whatever + ;; the user selected during setup, so that the mirrors are + ;; used during install, not just after install. (stop-service 'guix-daemon) - (start-service 'guix-daemon (list (number->string (getpid)))) + (start-service 'guix-daemon + `(,(number->string (getpid)) + ,@(if substitute-urls + `(,(string-join substitute-urls)) + '()))) (setvbuf (current-output-port) 'none) (setvbuf (current-error-port) 'none) diff --git a/gnu/installer/newt/services.scm b/gnu/installer/newt/services.= scm index 74f28e41ba..0fd5d3f2de 100644 --- a/gnu/installer/newt/services.scm +++ b/gnu/installer/newt/services.scm @@ -92,6 +92,29 @@ client may be enough for a server.") (condition (&installer-step-abort))))))) +(define (run-substitute-mirror-page) + (let ((title (G_ "Substitute mirror"))) + (run-listbox-selection-page + #:title title + #:info-text (G_ "Choose a server to get substitutes from. + +Depending on your location, the official substitutes server can be slow; \ +in that case, using a mirror may be faster.") + #:info-textbox-width 70 + #:listbox-height 8 + #:listbox-items (filter (lambda (service) + (eq? 'substitute-mirror + (system-service-type service))) + %system-services) + #:listbox-item->text (compose G_ system-service-name) + #:sort-listbox-items? #f + #:button-text (G_ "Exit") + #:button-callback-procedure + (lambda _ + (raise + (condition + (&installer-step-abort))))))) + (define (run-services-page) (let ((desktop (run-desktop-environments-cbt-page))) ;; When the user did not select any desktop services, and thus didn't = get @@ -100,4 +123,5 @@ client may be enough for a server.") (run-networking-cbt-page) (if (null? desktop) (list (run-network-management-page)) - '())))) + '()) + (list (run-substitute-mirror-page))))) diff --git a/gnu/installer/services.scm b/gnu/installer/services.scm index ec5ea30594..34d1e6f0de 100644 --- a/gnu/installer/services.scm +++ b/gnu/installer/services.scm @@ -41,6 +41,8 @@ (type system-service-type) ;'desktop | 'networking (recommended? system-service-recommended? ;Boolean (default #f)) + (snippet-type system-service-snippet-type ;'service-list | 'modify= -services + (default 'service-list)) (snippet system-service-snippet ;list of sexps (default '())) (packages system-service-packages ;list of sexps @@ -118,7 +120,31 @@ (system-service (name (G_ "DHCP client (dynamic IP address assignment)")) (type 'network-management) - (snippet '((service dhcp-client-service-type))))))) + (snippet '((service dhcp-client-service-type)))) + + ;; Substitute mirrors. + (system-service + ;; We should give the full URI of the servers, so that + ;; the user has the opportunity to ping it or wget + ;; from it to at least manually evaluate speed. + (name (G_ "https://ci.guix.gnu.org (Berlin, official Guix substitut= e server)")) + (type 'substitute-mirror)) + (system-service + (name (G_ "https://mirror.sjtu.edu.cn/guix (China, SJTU)")) + (type 'substitute-mirror) + (snippet-type 'modify-services) + (snippet '((guix-service-type config =3D> + (guix-configuration + (inherit config) + (substitute-urls + ;; cons* is better here, but we u= se + ;; (append (list ..) ...) in serv= ices + ;; below, so use the same for + ;; consistency. + (append + (list + "https://mirror.sjtu.edu.cn/g= uix") + %default-substitute-urls)))))))= ))) (define (desktop-system-service? service) "Return true if SERVICE is a desktop environment service." @@ -128,15 +154,33 @@ "Return true if SERVICE is a desktop environment service." (eq? 'networking (system-service-type service))) +(define (service-list-service? service) + (eq? 'service-list (system-service-snippet-type service))) + +(define (modify-services-service? service) + (eq? 'modify-services (system-service-snippet-type service))) + (define (system-services->configuration services) "Return the configuration field for SERVICES." - (let* ((snippets (append-map system-service-snippet services)) - (packages (append-map system-service-packages services)) - (desktop? (find desktop-system-service? services)) - (base (if desktop? - '%desktop-services - '%base-services))) - (if (null? snippets) + (let* ((service-list-services (filter service-list-service? + services)) + (service-list-snippets (append-map system-service-snippet + service-list-services)) + (modify-services-services (filter modify-services-service? + services)) + (modify-services-snippets (append-map system-service-snippet + modify-services-services)) + (packages (append-map system-service-packages + services)) + (desktop? (find desktop-system-service? services= )) + (base-variable (if desktop? + '%desktop-services + '%base-services)) + (base (if (null? modify-services-snippets) + base-variable + `(modify-services ,base-variable + ,@modify-services-snippets)))) + (if (null? service-list-snippets) `(,@(if (null? packages) '() `((packages (append (list ,@packages) @@ -146,7 +190,7 @@ '() `((packages (append (list ,@packages) %base-packages)))) - (services (append (list ,@snippets + (services (append (list ,@service-list-snippets ,@(if desktop? ;; XXX: Assume 'keyboard-layout' i= s in diff --git a/gnu/installer/tests.scm b/gnu/installer/tests.scm index 8ccd327a7c..fee1a50f6f 100644 --- a/gnu/installer/tests.scm +++ b/gnu/installer/tests.scm @@ -220,7 +220,10 @@ ROOT-PASSWORD, and USERS." (string-contains service "NSS")))) (choose-network-management-tool? (lambda (service) - (string-contains service "DHCP")))) + (string-contains service "DHCP"))) + (choose-mirror? + (lambda (mirror) + (string-contains mirror "https://")))) "Converse over PORT to choose networking services." (define desktop-environments '()) @@ -240,7 +243,12 @@ ROOT-PASSWORD, and USERS." (multiple-choices? #f) (items ,services)) (null? desktop-environments) - (find choose-network-management-tool? services)))) + (find choose-network-management-tool? services)) + + ((list-selection (title "Substitute mirror") + (multiple-choices? #f) + (items ,mirrors)) + (find choose-mirror? mirrors)))) (define (edit-configuration-file file) "Edit FILE, an operating system configuration file generated by the diff --git a/gnu/services/base.scm b/gnu/services/base.scm index 24b3ea785b..22970f0b31 100644 --- a/gnu/services/base.scm +++ b/gnu/services/base.scm @@ -1632,6 +1632,15 @@ proxy of 'guix-daemon'...~%") (define discover? (or (getenv "discover") #$discover?)) + ;; When running the installer, we want installation to + ;; use the substitute URLs selected by the user. + ;; The installer will pass in the desired substitute + ;; URLs as the second argument of the start action. + (define substitute-urls + (match args + ((_ substitute-urls . __) substitute-urls) + (else #$(string-join substitute= -urls)))) + ;; Start the guix-daemon from a container, when supporte= d, ;; to solve an installation issue. See the comment below= for ;; more details. @@ -1648,7 +1657,7 @@ proxy of 'guix-daemon'...~%") '("--no-substitutes")) (string-append "--discover=3D" (if discover? "yes" "no")) - "--substitute-urls" #$(string-join substitute-ur= ls) + "--substitute-urls" substitute-urls #$@extra-options ;; Add CHROOT-DIRECTORIES and all their dependen= cies @@ -1670,8 +1679,8 @@ proxy of 'guix-daemon'...~%") ;; Otherwise, for symmetry purposes enter the caller ;; namespaces which is a no-op. #:pid (match args - ((pid) (string->number pid)) - (else (getpid))) + ((pid . _) (string->number pid)) + (else (getpid))) #:environment-variables (append (list #$@(if tmpdir -- 2.31.1