From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: from mp0 ([2001:41d0:8:6d80::]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits)) by ms0.migadu.com with LMTPS id UCGuJiDY+mD8gwEAgWs5BA (envelope-from ) for ; Fri, 23 Jul 2021 16:54:24 +0200 Received: from aspmx1.migadu.com ([2001:41d0:8:6d80::]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits)) by mp0 with LMTPS id YMlyIiDY+mDJdgAA1q6Kng (envelope-from ) for ; Fri, 23 Jul 2021 14:54:24 +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 D5CD28AEA for ; Fri, 23 Jul 2021 16:54:23 +0200 (CEST) Received: from localhost ([::1]:44400 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1m6wZC-00057x-V6 for larch@yhetil.org; Fri, 23 Jul 2021 10:54:22 -0400 Received: from eggs.gnu.org ([2001:470:142:3::10]:56560) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1m6wYz-00054d-J0 for guix-devel@gnu.org; Fri, 23 Jul 2021 10:54:09 -0400 Received: from mail-0201.mail-europe.com ([51.77.79.158]:52667) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1m6wYv-0004UH-OZ; Fri, 23 Jul 2021 10:54:09 -0400 Date: Fri, 23 Jul 2021 14:53:44 +0000 DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=protonmail.com; s=protonmail; t=1627052034; bh=bAru0hhAfhwqvHk5jpUUa6oSOOAWsXCbvf4sjSBk6l4=; h=Date:To:From:Cc:Reply-To:Subject:In-Reply-To:References:From; b=KVr0D8AmoOfYL+DUpmlFqAihUXYxezb434B2gPtHUszqETLB4okOhkntubsZ70yjO 4BcHdC2jEClIpBVyu3s26/aEvDXyCTMLudtrxdWVSRWuk+vQNGFbT7E2vP34/mkm6n oICFb3Mw5XwOO9xxhyJ/55rsqJs9Q+OdWgdzmnTo= To: Mathieu Othacehe From: raid5atemyhomework Cc: Pierre Neidhardt , "guix-devel@gnu.org" Subject: Re: Adding Substitute Mirrors page to installer Message-ID: In-Reply-To: <91TVhqLjb4qN2M9ewI6NRWYNNcka9vbIRPkuPzYAKv_Km_o8eFaD4viDAffo5U0WotEqHt90C3HnFmryv_beBUzuQcBWc4kymN4uDeCHbu8=@protonmail.com> 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> <91TVhqLjb4qN2M9ewI6NRWYNNcka9vbIRPkuPzYAKv_Km_o8eFaD4viDAffo5U0WotEqHt90C3HnFmryv_beBUzuQcBWc4kymN4uDeCHbu8=@protonmail.com> MIME-Version: 1.0 Content-Type: text/plain; charset=utf-8 Content-Transfer-Encoding: quoted-printable Received-SPF: pass client-ip=51.77.79.158; envelope-from=raid5atemyhomework@protonmail.com; helo=mail-0201.mail-europe.com X-Spam_score_int: -20 X-Spam_score: -2.1 X-Spam_bar: -- X-Spam_report: (-2.1 / 5.0 requ) BAYES_00=-1.9, DKIM_SIGNED=0.1, DKIM_VALID=-0.1, DKIM_VALID_AU=-0.1, DKIM_VALID_EF=-0.1, FREEMAIL_FROM=0.001, RCVD_IN_MSPIKE_H2=-0.001, SPF_HELO_NONE=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=1627052064; 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=bAru0hhAfhwqvHk5jpUUa6oSOOAWsXCbvf4sjSBk6l4=; b=orxOYaNhAeSnO8CWn8OqJydEZEhsKdn0bmCXPEBgKaL5uFheBN22FM+nSb7k+PgQtPLZ/g FCgcxjgaYX1l0Z8Ow1HNpqptoxpzmg5+4eu9lajvvj5hwsifELjoHVzOzXNluaTFJBOb9n i9YViEhOCWE9BF4chjkSGxd1QziFsEMHIEIepggiIcuRMbKZfJXRdoO3fM+m3i4G4jKjyU 920BSt0bMGyrgvxIYXwWTdfZWytCCU7UM+QSRDjpVQmkpEw4aEA5z/4NBW9GWheFn2nD5x FXHIrywDQKTmq7mu/Qs079LFcsMCyzzScl21e9+MLp9QhUMtrR0LdPAJ/fduMA== ARC-Seal: i=1; s=key1; d=yhetil.org; t=1627052064; a=rsa-sha256; cv=none; b=SyyEjuOobyErWtcN0Up6ZieLX2rMdW2XbeHJwchw+Re74WYi8qsfR/LHzJN/f4UHellNg/ Xr73n93eWda++vay54o71NI80TkCYtQCcFc+qrL9YaI3u2jPY6YPWUxR/tFC9LSGbTYFaH tQer3q5KIpsAE6wkMXbVmuNq3sRL/UdgxWrN2FUBsCDTLShG5IiAoNU2/sj1jGAfcxcExR lyYik9intDwQM0+vdvHD83s0qqvvAIYOprnqQKOeGAk3XO6oAhA9iBsoHAZJeN4xy53a0E hOgaLAlUBG+ssLEYUDsyhJ1HsmxoHH5VpkW9IsM7oqwhLKxngLZA1cAqP1547Q== ARC-Authentication-Results: i=1; aspmx1.migadu.com; dkim=pass header.d=protonmail.com header.s=protonmail header.b=KVr0D8Am; 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.12 Authentication-Results: aspmx1.migadu.com; dkim=pass header.d=protonmail.com header.s=protonmail header.b=KVr0D8Am; 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: D5CD28AEA X-Spam-Score: -3.12 X-Migadu-Scanner: scn0.migadu.com X-TUID: +lfxZ521HS7V .... bump. As an aside, I notice there is now a new "bayfront.guix.gnu.org" server. Not sure if I should modify this patch or not to add it or whatever. Thanks raid5atemyhomework > Hi Mathieu, > > I added the test as you recommended, however it looks to me that within t= he 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-subs= titute-urls > > > - service-value)))) > > > > In previous version there was no`(and (operating-system? os) ...)` guard,= as we expect that the generated file, when `load`ed, will result in an `op= erating-system`, so I wonder why the testing environment is somehow differe= nt. 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 regardi= ng 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= installing into 2 different VMs, one with ci.guix.gnu.org and the other wi= th mirror.sjtu.edu.cn. > > Thanks > raid5atemyhomework > > From 41b174da1e38b71563405f1be48331fbe0e5700d Mon Sep 17 00:00:00 2001 > From: raid5atemyhomework raid5atemyhomework@protonmail.com > 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 extrac= t > 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-configura= tion-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-subs= titute-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 ar= e > > > - ;; 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/service= s.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-se= rvices > - (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 subst= itute 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 use > > > - ;; (append (list ..) ...) in = services > > > - ;; below, so use the same for > > > - ;; consistency. > > > - (append > > > - (list > > > - "https://mirror.sjtu.edu.= cn/guix") > > > - %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-servic= es)) > > > - (packages (append-map system-service-package= s > > > - services)) > > > - (desktop? (find desktop-system-service? serv= ices)) > > > - (base-variable (if desktop? > > > - '%desktop-services > > > - '%base-services)) > > > - (base (if (null? modify-services-snippet= s) > > > - base-variable > > > - `(modify-services ,base-variab= le > > > - ,@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' is 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 substi= tute-urls)))) > > > - ;; Start the guix-daemon from a container, when supp= orted, > ;; to solve an installation issue. See the comment b= elow 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 substitut= e-urls) > > > > - "--substitute-urls" substitute-urls > #$@extra-options > > > > ;; Add CHROOT-DIRECTORIES and all their dependencies > @@ -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