Adding Substitute Mirrors page to installer

Adding Substitute Mirrors page to installer

[raid5atemyhomework]

Hi Guix Developers,

I want to add a page to the installer to allow selection of substitute mirrors.  In particular, from my ISP, the SJTU mirror is significantly faster (1MB/s->5MB/s) than directly from `ci.guix.gnu.org` (4kB/s->40kB/s), so I think putting that option to the installer would be beneficial to others in similar circumstances.

However, the current `(gnu installer services)` assumes that snippets are added to a list of services. To implement substitute mirrors, I need to insert a `modify-services` form with a `(guix-service-type config => (guix-configuration (inherit config) (substitute-urls <whatever>))`.


What I want to propose is something like this:

* Add a `snippet-type` field to `<system-service>`, default `'service-list`.
  * The field can instead be set to `'modify-services` to mean that the snippet is to be in a `modify-services` form.
* In `system-services->configuration`, filter services according to `snippet-type` and put the snippets in the appropriate parts of the `service` form.
* Add entries for the SJTU mirror (with fallback to the original `ci.guix.gnu.org`) and the default unmirrored `ci.guix.gnu.org`, with `system-service-type` of `'substitute-urls`.
* Then in `(gnu installer newt services)`, add a page for `'substitute-urls`.

What do you think?

Thanks
raid5atemyhomework

Re: Adding Substitute Mirrors page to installer

[raid5atemyhomework]

BUMP

> Hi Guix Developers,
>
> I want to add a page to the installer to allow selection of substitute mirrors. In particular, from my ISP, the SJTU mirror is significantly faster (1MB/s->5MB/s) than directly from `ci.guix.gnu.org` (4kB/s->40kB/s), so I think putting that option to the installer would be beneficial to others in similar circumstances.
>
> However, the current`(gnu installer services)` assumes that snippets are added to a list of services. To implement substitute mirrors, I need to insert a `modify-services` form with a `(guix-service-type config => (guix-configuration (inherit config) (substitute-urls <whatever>))`.
>
> What I want to propose is something like this:
>
> -   Add a `snippet-type` field to `<system-service>`, default `'service-list`.
>     -   The field can instead be set to `'modify-services` to mean that the snippet is to be in a `modify-services` form.
> -   In `system-services->configuration`, filter services according to `snippet-type` and put the snippets in the appropriate parts of the `service` form.
>
> -   Add entries for the SJTU mirror (with fallback to the original `ci.guix.gnu.org`) and the default unmirrored `ci.guix.gnu.org`, with `system-service-type` of `'substitute-urls`.
>
> -   Then in `(gnu installer newt services)`, add a page for `'substitute-urls`.
>
>     What do you think?
>
>     Thanks
>     raid5atemyhomework
>

Re: Adding Substitute Mirrors page to installer

[Pierre Neidhardt]

[-- Attachment #1: Type: text/plain, Size: 428 bytes --]

Hi!

I agree that we need a convenient way to add mirrors, it can be critical
to users who get low throughput from Berlin.

To that I'd add the option to add channels straight from the installer.
Not sure it belongs to a separate change set, maybe we can hit two birds
we one stone here.

Forwarding to Mathieu who I think knows the installer pretty well! :)

Cheers!

-- 
Pierre Neidhardt
https://ambrevar.xyz/

[-- Attachment #2: signature.asc --]
[-- Type: application/pgp-signature, Size: 511 bytes --]

Re: Adding Substitute Mirrors page to installer

[raid5atemyhomework]

Hello,

Below I have a patch that adds a page for substitute mirrors.

Limitation is that the substitute mirror is only used after installation completes.  During installation the guix daemon still loads from the Berlin server.  Also, channel is still the default Guix channel (which is fairly slow as well from some places).

Testing done:

* Create an install image by `./pre-inst-env guix system image -t iso9660 gnu/system/install.scm` on a patched Guix.
* Create a new VM and install using the created install image.
* Select the SJTU mirror.
* Complete installation (also notice that during install, the mirror is *not* used, which could be confusing to users).
* On installation completion, reboot VM, then `guix pull` on root.
* Check that `guix pull` gets substitutes from SJTU mirror.

The ability to also use the same mirror *during* install rather than after it would be very nice.  After all, the guix daemon has to be restarted during installation in the meantime anyway, so on restart it should be possible to switch the `substitute-urls`.  However the complications are:

* The `(gnu installer service)` module inherently assumes that services are completely orthogonal to everything else being configured in the installation.  I'm not sure what the best way to extract the substitute mirror selection would be.
* The installation image has to do a local `guix system reconfigure` of itself so that its shepherd points the guix daemon to a new mirror, so that the guix daemon restart in `install-system` of `(gnu installer final)` will refer to a new mirror.

> I agree that we need a convenient way to add mirrors, it can be critical
> to users who get low throughput from Berlin.

Indeed.

>
> To that I'd add the option to add channels straight from the installer.
> Not sure it belongs to a separate change set, maybe we can hit two birds
> we one stone here.

If you mean mirrors of the official Guix channel, this would be nice.

However, channels are not described in the `operating-system` declaration.  Thus, we need to create channel by extra mechanism in installer.  This can probably be done by hooking somehow into `install-final` as well, as it creates the `/mnt` mountpoint for installing.

If you mean other non-Guix channels, the only channels I know of that are not Guix cannot be named here, so --- are there any channels that *can* be named in official documentation about Guix?

Thanks
raid5atemyhomework

From af7e4d1336ed9010a31011d2fbae2a27fdaca237 Mon Sep 17 00:00:00 2001
From: raid5atemyhomework <raid5atemyhomework@protonmail.com>
Date: Wed, 10 Mar 2021 09:21:42 +0000
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/installer/newt/services.scm | 26 +++++++++++++-
 gnu/installer/services.scm      | 62 ++++++++++++++++++++++++++++-----
 2 files changed, 78 insertions(+), 10 deletions(-)

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 substitute 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 =>
+                                     (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-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' is in
--
2.30.1

Re: Adding Substitute Mirrors page to installer

[Ludovic Courtès]

Hi,

raid5atemyhomework <raid5atemyhomework@protonmail.com> skribis:

> From af7e4d1336ed9010a31011d2fbae2a27fdaca237 Mon Sep 17 00:00:00 2001
> From: raid5atemyhomework <raid5atemyhomework@protonmail.com>
> Date: Wed, 10 Mar 2021 09:21:42 +0000
> 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`.

Looks nice!  Mathieu, could you take a look as time permits?

I wonder if the “conversations” in (gnu installer tests) need to be
adjusted.

Thanks,
Ludo’.

Re: Adding Substitute Mirrors page to installer

[zimoun]

Hi,

On Wed, 10 Mar 2021 at 09:49, raid5atemyhomework <raid5atemyhomework@protonmail.com> wrote:

> If you mean other non-Guix channels, the only channels I know of that
> are not Guix cannot be named here, so --- are there any channels that
> *can* be named in official documentation about Guix? 

You can find a list of scientific related channels here: (Section Code)

  <https://hpc.guix.info/about/>


All the best,
simon

Re: Adding Substitute Mirrors page to installer

[raid5atemyhomework]

>     The ability to also use the same mirror during install rather than after it would be very nice. After all, the guix daemon has to be restarted during installation in the meantime anyway, so on restart it should be possible to switch the `substitute-urls`. However the complications are:
>
> -   The `(gnu installer service)` module inherently assumes that services are completely orthogonal to everything else being configured in the installation. I'm not sure what the best way to extract the substitute mirror selection would be.
> -   The installation image has to do a local `guix system reconfigure` of itself so that its shepherd points the guix daemon to a new mirror, so that the guix daemon restart in `install-system` of `(gnu installer final)` will refer to a new mirror.

Another way to do this would be to add another argument to the `start` action of `guix-daemon`, in much the same way the installer passes in its pid so that the guix daemon can access the copy-on-write store on the destination.  This argument would override the `--substitute-urls`.

So in `(gnu services base)` the `guix-shepherd-service` procedure would have something like:

    (define substitute-urls
            (match args
              ((_ substitute-urls . __) substitute-urls)
              (else                     #$(string-join substitute-urls))))

    #; ....

    (fork-exec-command/container
      #; ...
      #:pid
      (match args
        ((pid . _) pid)
        (else      (getpid)))
      #; ...)


The question now is how does the `install-system` procedure in `(gnu installer final)` determine what substitute URL to pass into `(start-service 'guix-daemon (list (number->string (getpid)) <>))`?

* Change the architecture of the installer somehow so that a single page can both manipulate the `services` field and also manipulate how `install-system` is invoked, and add a new argument to `install-system`.
* Or have `install-system` `read` in the `(%installer-configuration-file)`, look for the `operating-system` form, then delve in its `services` field for a `substitute-urls` field.  This feels fairly brittle but does take advantage of the homoiconicity of Scheme.

Thanks
raid5atemyhomework

Re: Adding Substitute Mirrors page to installer

[raid5atemyhomework]

Hi all,

Below is the new patch version.

In this version, the installer now also reads the generated `operating-system` file to extract the `guix-configuration-substitute-urls`, in order to pass it into the `start` action of `guix-daemon`.  The `start` action also now supports a second argument, the space-separated list of substitute URLs.  I'm wary of this technique as I feel it is unclean, but it works and does not require significant changes to the existing software architecture of the installer.

Tested in this manner:

* Created an installer image by `./pre-inst-env guix system image -t iso9660 gnu/system/install.scm`.
* Started a new VM with the installer image and selected the SJTUG mirror.
* Confirmed that during installation the installer downloaded substitutes from the SJTUG mirror.
* After installation completed on the VM, did a `guix pull` on the new VM instance and confirmed it downloaded substitutes from the SJTUG mirror.

I haven't tested for the use of the normal Berlin Cuirass, as that would be ridiculously slow right now from my network, but I expect it would continue to work.

Thanks
raid5atemyhomework

From 68a42cce2b4ae876cbbd1911aaa2a5bc8348bf15 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 extract
substitute URLs to pass to `guix-daemon` start action.
---
 gnu/installer/final.scm         | 36 ++++++++++++++++++-
 gnu/installer/newt/services.scm | 26 +++++++++++++-
 gnu/installer/services.scm      | 62 ++++++++++++++++++++++++++++-----
 gnu/services/base.scm           | 15 ++++++--
 4 files changed, 125 insertions(+), 14 deletions(-)

diff --git a/gnu/installer/final.scm b/gnu/installer/final.scm
index fc0b7803fa..6eca3ec606 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,15 @@ 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=> (find
+                                   (lambda (service)
+                                     (eq? guix-service-type
+                                          (service-kind service)))
+                                   (operating-system-services os))
+                                 (compose guix-configuration-substitute-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 +233,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 substitute 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 =>
+                                     (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-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' is in
diff --git a/gnu/services/base.scm b/gnu/services/base.scm
index f6a490f712..5e079866d7 100644
--- a/gnu/services/base.scm
+++ b/gnu/services/base.scm
@@ -1630,6 +1630,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 supported,
                   ;; to solve an installation issue. See the comment below for
                   ;; more details.
@@ -1646,7 +1655,7 @@ proxy of 'guix-daemon'...~%")
                                  '("--no-substitutes"))
                           (string-append "--discover="
                                          (if discover? "yes" "no"))
-                          "--substitute-urls" #$(string-join substitute-urls)
+                          "--substitute-urls" substitute-urls
                           #$@extra-options

                           ;; Add CHROOT-DIRECTORIES and all their dependencies
@@ -1668,8 +1677,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.30.1

Re: Adding Substitute Mirrors page to installer

[raid5atemyhomework]

Bump


Sent with ProtonMail Secure Email.

‐‐‐‐‐‐‐ Original Message ‐‐‐‐‐‐‐
On Tuesday, March 16, 2021 11:55 PM, raid5atemyhomework <raid5atemyhomework@protonmail.com> wrote:

> Hi all,
>
> Below is the new patch version.
>
> In this version, the installer now also reads the generated `operating-system` file to extract the `guix-configuration-substitute-urls`, in order to pass it into the `start` action of `guix-daemon`. The `start` action also now supports a second argument, the space-separated list of substitute URLs. I'm wary of this technique as I feel it is unclean, but it works and does not require significant changes to the existing software architecture of the installer.
>
> Tested in this manner:
>
> -   Created an installer image by `./pre-inst-env guix system image -t iso9660 gnu/system/install.scm`.
> -   Started a new VM with the installer image and selected the SJTUG mirror.
> -   Confirmed that during installation the installer downloaded substitutes from the SJTUG mirror.
> -   After installation completed on the VM, did a `guix pull` on the new VM instance and confirmed it downloaded substitutes from the SJTUG mirror.
>
>     I haven't tested for the use of the normal Berlin Cuirass, as that would be ridiculously slow right now from my network, but I expect it would continue to work.
>
>     Thanks
>     raid5atemyhomework
>
>     From 68a42cce2b4ae876cbbd1911aaa2a5bc8348bf15 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 extract
>     substitute URLs to pass to `guix-daemon` start action.
>
>
> gnu/installer/final.scm | 36 ++++++++++++++++++-
> gnu/installer/newt/services.scm | 26 +++++++++++++-
> gnu/installer/services.scm | 62 ++++++++++++++++++++++++++++-----
> gnu/services/base.scm | 15 ++++++--
> 4 files changed, 125 insertions(+), 14 deletions(-)
>
> diff --git a/gnu/installer/final.scm b/gnu/installer/final.scm
> index fc0b7803fa..6eca3ec606 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,15 @@ 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=> (find
>
>
> -                                     (lambda (service)
>
>
> -                                       (eq? guix-service-type
>
>
> -                                            (service-kind service)))
>
>
> -                                     (operating-system-services os))
>
>
> -                                   (compose guix-configuration-substitute-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 +233,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 substitute 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 =>
>
>
> -                                       (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-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' is in
> diff --git a/gnu/services/base.scm b/gnu/services/base.scm
> index f6a490f712..5e079866d7 100644
> --- a/gnu/services/base.scm
> +++ b/gnu/services/base.scm
> @@ -1630,6 +1630,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 supported,
>                      ;; to solve an installation issue. See the comment below for
>                      ;; more details.
>
>
>
> @@ -1646,7 +1655,7 @@ proxy of 'guix-daemon'...~%")
> '("--no-substitutes"))
> (string-append "--discover="
> (if discover? "yes" "no"))
>
> -                            "--substitute-urls" #$(string-join substitute-urls)
>
>
>
> -                            "--substitute-urls" substitute-urls
>                              #$@extra-options
>
>
>
> ;; Add CHROOT-DIRECTORIES and all their dependencies
> @@ -1668,8 +1677,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.30.1

Re: Adding Substitute Mirrors page to installer

[Mathieu Othacehe]

Hello,

I plan to have a look to your patch in the next coming days. Sorry for
the long delay.

Thanks,

Mathieu

Re: Adding Substitute Mirrors page to installer

[Mathieu Othacehe]

Hello,

Thanks for this patch, it seems to work fine!

> +         ;; Extract the substitute URLs of the user configuration.
> +         (os              (read-operating-system (%installer-configuration-file)))
> +         (substitute-urls (and=> (find
> +                                   (lambda (service)
> +                                     (eq? guix-service-type
> +                                          (service-kind service)))
> +                                   (operating-system-services os))
> +                                 (compose guix-configuration-substitute-urls
> +                                          service-value)))

We could make the mirror selection a proper step, adding it to (gnu
installer record). Then in (gnu installer), you could add:

--8<---------------cut here---------------start------------->8---
  (installer-step
   (id 'mirrors)
   (description (G_ "Mirror substitute server"))
   (compute (lambda _
              ((installer-mirrors-page current-installer)))))
--8<---------------cut here---------------end--------------->8---

This way, you should be able to select the step result in
"run-final-page" this way:

--8<---------------cut here---------------start------------->8---
(let* ((configuration   (format-configuration prev-steps result))
       (user-partitions (result-step result 'partition))
       (locale          (result-step result 'locale))
       (users           (result-step result 'user))
       (mirrors         (result-step result 'mirrors))
       (install-ok?
        (with-mounted-partitions
         user-partitions
         (configuration->file configuration)
         (run-config-display-page #:locale locale)
         (run-install-shell locale #:users users #:mirrors mirrors))))
  ...)
--8<---------------cut here---------------end--------------->8---

That would avoid the need to parse the resulting configuration file.

> +(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.")

I wonder if it would make sense to select multiple mirrors, as fallback
if the preferred mirror is not up to date. We could also add the
possibility for the user to add a mirror manually.

In that case, the mirror page could look like the "User creation" page,
with an "Add" button opening a popup proposing to type a mirror URL or
to select one from an existing list.

WDYT?

Thanks,

Mathieu

Re: Adding Substitute Mirrors page to installer

[raid5atemyhomework]

Hello Mathieu,

> Hello,
>
> Thanks for this patch, it seems to work fine!
>
> > -           ;; Extract the substitute URLs of the user configuration.
> >
> >
> > -           (os              (read-operating-system (%installer-configuration-file)))
> >
> >
> > -           (substitute-urls (and=> (find
> >
> >
> > -                                     (lambda (service)
> >
> >
> > -                                       (eq? guix-service-type
> >
> >
> > -                                            (service-kind service)))
> >
> >
> > -                                     (operating-system-services os))
> >
> >
> > -                                   (compose guix-configuration-substitute-urls
> >
> >
> > -                                            service-value)))
> >
> >
>
> We could make the mirror selection a proper step, adding it to (gnu
> installer record). Then in (gnu installer), you could add:
>
> --8<---------------cut here---------------start------------->8---
> (installer-step
> (id 'mirrors)
> (description (G_ "Mirror substitute server"))
> (compute (lambda _
> ((installer-mirrors-page current-installer)))))
> --8<---------------cut here---------------end--------------->8---
>
> This way, you should be able to select the step result in
> "run-final-page" this way:
>
> --8<---------------cut here---------------start------------->8---
> (let* ((configuration (format-configuration prev-steps result))
> (user-partitions (result-step result 'partition))
> (locale (result-step result 'locale))
> (users (result-step result 'user))
> (mirrors (result-step result 'mirrors))
> (install-ok?
> (with-mounted-partitions
> user-partitions
> (configuration->file configuration)
>
>          (run-config-display-page #:locale locale)
>          (run-install-shell locale #:users users #:mirrors mirrors))))
>
>
> ...)
> --8<---------------cut here---------------end--------------->8---
>
> That would avoid the need to parse the resulting configuration file.

I don't think that will work.

The intent is that mirror selection affects ***two*** things:

* The actual installed system, i.e. `/etc/config.scm`.
* The installer's Guix Daemon.

If my understanding of the above is correct, it will only affect the installer's Guix Daemon (via `run-install-shell` which will call into `install-system`, presumably with the added argument), but not affect the ***installed*** system, because the `configuration` cannot be modified by the `'mirrors` page in the above construction.
Currently what the installer assumes is that a page will at most include a unique entry into the `operating-system`, but it cannot handle a page which modifies the entry created by a previous page.

It would be a breakage of expectations to ask the user to select some mirror, then the installed system, when `guix system reconfigure`d, uses the default `ci.guix.gnu.org`.

My patch affects both, because that is logically what a user would expect, after all, they selected a particular server to install from.
Thus, they expect, that both the installed system, and the installer, will use the selected mirror.
Of course, it feels somewhat dirty, as there is a need to read the configuration file.
It would be cleaner if a page could affect the field created by a previous page.

For example, perhaps the result of a page is not an AST that is a field of an `operating-system` form, but instead a procedure that accepts a `(operating-system ...)` form and returns it.
Most existing pages would just append their keyed sub-form.
However the `mirrors` page would modify an existing `services` field in the input `operating-system` form instead.

> > +(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.")
>
> I wonder if it would make sense to select multiple mirrors, as fallback
> if the preferred mirror is not up to date. We could also add the
> possibility for the user to add a mirror manually.
>
> In that case, the mirror page could look like the "User creation" page,
> with an "Add" button opening a popup proposing to type a mirror URL or
> to select one from an existing list.
>
> WDYT?

I think Less is More, and deploying an installer with a simple "select one mirror" page *now* will cover 90% of use-cases, and we can add the more complicated page later when there is more time.

In particular, there is really only one public mirror of Guix that I know of, the SJTU mirror, so all the flexibility here is not very useful, at least not to me.
Since "multiple mirrors" aren't even available yet anyway, why add the complication now?

Maybe you can encourage more people to actually run mirrors if the installer has a visible "select mirrors" page, so that you can actually get more than just the SJTU mirror and "select multiple mirrors" is now a (good) problem to have to solve.

For now I think a simple "select one mirror, we'll add ci.guix.gnu.org as a fallback" would be better.
You can add a "select multiple mirrors in an order I want to specify" later, when there *are* multiple mirrors existing.

Thanks
raid5atemyhomework

Re: Adding Substitute Mirrors page to installer

[raid5atemyhomework]

bump

> Hello Mathieu,
>
> > Hello,
> > Thanks for this patch, it seems to work fine!
> >
> > > -             ;; Extract the substitute URLs of the user configuration.
> > >
> > >
> > > -             (os              (read-operating-system (%installer-configuration-file)))
> > >
> > >
> > > -             (substitute-urls (and=> (find
> > >
> > >
> > > -                                       (lambda (service)
> > >
> > >
> > > -                                         (eq? guix-service-type
> > >
> > >
> > > -                                              (service-kind service)))
> > >
> > >
> > > -                                       (operating-system-services os))
> > >
> > >
> > > -                                     (compose guix-configuration-substitute-urls
> > >
> > >
> > > -                                              service-value)))
> > >
> > >
> >
> > We could make the mirror selection a proper step, adding it to (gnu
> > installer record). Then in (gnu installer), you could add:
> > --8<---------------cut here---------------start------------->8---
> > (installer-step
> > (id 'mirrors)
> > (description (G_ "Mirror substitute server"))
> > (compute (lambda _
> > ((installer-mirrors-page current-installer)))))
> > --8<---------------cut here---------------end--------------->8---
> > This way, you should be able to select the step result in
> > "run-final-page" this way:
> > --8<---------------cut here---------------start------------->8---
> > (let* ((configuration (format-configuration prev-steps result))
> > (user-partitions (result-step result 'partition))
> > (locale (result-step result 'locale))
> > (users (result-step result 'user))
> > (mirrors (result-step result 'mirrors))
> > (install-ok?
> > (with-mounted-partitions
> > user-partitions
> > (configuration->file configuration)
> >
> >          (run-config-display-page #:locale locale)
> >          (run-install-shell locale #:users users #:mirrors mirrors))))
> >
> >
> > ...)
> > --8<---------------cut here---------------end--------------->8---
> > That would avoid the need to parse the resulting configuration file.
>
> I don't think that will work.
>
> The intent is that mirror selection affects two things:
>
> -   The actual installed system, i.e. `/etc/config.scm`.
> -   The installer's Guix Daemon.
>
>     If my understanding of the above is correct, it will only affect the installer's Guix Daemon (via `run-install-shell` which will call into `install-system`, presumably with the added argument), but not affect the installed system, because the `configuration` cannot be modified by the `'mirrors` page in the above construction.
>     Currently what the installer assumes is that a page will at most include a unique entry into the `operating-system`, but it cannot handle a page which modifies the entry created by a previous page.
>
>     It would be a breakage of expectations to ask the user to select some mirror, then the installed system, when `guix system reconfigure`d, uses the default `ci.guix.gnu.org`.
>
>     My patch affects both, because that is logically what a user would expect, after all, they selected a particular server to install from.
>     Thus, they expect, that both the installed system, and the installer, will use the selected mirror.
>     Of course, it feels somewhat dirty, as there is a need to read the configuration file.
>     It would be cleaner if a page could affect the field created by a previous page.
>
>     For example, perhaps the result of a page is not an AST that is a field of an `operating-system` form, but instead a procedure that accepts a `(operating-system ...)` form and returns it.
>     Most existing pages would just append their keyed sub-form.
>     However the `mirrors` page would modify an existing `services` field in the input `operating-system` form instead.
>
>
> > > +(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.")
> >
> > I wonder if it would make sense to select multiple mirrors, as fallback
> > if the preferred mirror is not up to date. We could also add the
> > possibility for the user to add a mirror manually.
> > In that case, the mirror page could look like the "User creation" page,
> > with an "Add" button opening a popup proposing to type a mirror URL or
> > to select one from an existing list.
> > WDYT?
>
> I think Less is More, and deploying an installer with a simple "select one mirror" pagenow will cover 90% of use-cases, and we can add the more complicated page later when there is more time.
>
> In particular, there is really only one public mirror of Guix that I know of, the SJTU mirror, so all the flexibility here is not very useful, at least not to me.
> Since "multiple mirrors" aren't even available yet anyway, why add the complication now?
>
> Maybe you can encourage more people to actually run mirrors if the installer has a visible "select mirrors" page, so that you can actually get more than just the SJTU mirror and "select multiple mirrors" is now a (good) problem to have to solve.
>
> For now I think a simple "select one mirror, we'll add ci.guix.gnu.org as a fallback" would be better.
> You can add a "select multiple mirrors in an order I want to specify" later, when there are multiple mirrors existing.
>
> Thanks
> raid5atemyhomework

Re: Adding Substitute Mirrors page to installer

[raid5atemyhomework]

bump

> bump
>
> > Hello Mathieu,
> >
> > > Hello,
> > > Thanks for this patch, it seems to work fine!
> > >
> > > > -               ;; Extract the substitute URLs of the user configuration.
> > > >
> > > >
> > > > -               (os              (read-operating-system (%installer-configuration-file)))
> > > >
> > > >
> > > > -               (substitute-urls (and=> (find
> > > >
> > > >
> > > > -                                         (lambda (service)
> > > >
> > > >
> > > > -                                           (eq? guix-service-type
> > > >
> > > >
> > > > -                                                (service-kind service)))
> > > >
> > > >
> > > > -                                         (operating-system-services os))
> > > >
> > > >
> > > > -                                       (compose guix-configuration-substitute-urls
> > > >
> > > >
> > > > -                                                service-value)))
> > > >
> > > >
> > >
> > > We could make the mirror selection a proper step, adding it to (gnu
> > > installer record). Then in (gnu installer), you could add:
> > > --8<---------------cut here---------------start------------->8---
> > > (installer-step
> > > (id 'mirrors)
> > > (description (G_ "Mirror substitute server"))
> > > (compute (lambda _
> > > ((installer-mirrors-page current-installer)))))
> > > --8<---------------cut here---------------end--------------->8---
> > > This way, you should be able to select the step result in
> > > "run-final-page" this way:
> > > --8<---------------cut here---------------start------------->8---
> > > (let* ((configuration (format-configuration prev-steps result))
> > > (user-partitions (result-step result 'partition))
> > > (locale (result-step result 'locale))
> > > (users (result-step result 'user))
> > > (mirrors (result-step result 'mirrors))
> > > (install-ok?
> > > (with-mounted-partitions
> > > user-partitions
> > > (configuration->file configuration)
> > >
> > >          (run-config-display-page #:locale locale)
> > >          (run-install-shell locale #:users users #:mirrors mirrors))))
> > >
> > >
> > > ...)
> > > --8<---------------cut here---------------end--------------->8---
> > > That would avoid the need to parse the resulting configuration file.
> >
> > I don't think that will work.
> > The intent is that mirror selection affects two things:
> >
> > -   The actual installed system, i.e. `/etc/config.scm`.
> >
> > -   The installer's Guix Daemon.
> >     If my understanding of the above is correct, it will only affect the installer's Guix Daemon (via `run-install-shell` which will call into `install-system`, presumably with the added argument), but not affect the installed system, because the `configuration` cannot be modified by the `'mirrors` page in the above construction.
> >     Currently what the installer assumes is that a page will at most include a unique entry into the `operating-system`, but it cannot handle a page which modifies the entry created by a previous page.
> >     It would be a breakage of expectations to ask the user to select some mirror, then the installed system, when `guix system reconfigure`d, uses the default `ci.guix.gnu.org`.
> >     My patch affects both, because that is logically what a user would expect, after all, they selected a particular server to install from.
> >     Thus, they expect, that both the installed system, and the installer, will use the selected mirror.
> >     Of course, it feels somewhat dirty, as there is a need to read the configuration file.
> >     It would be cleaner if a page could affect the field created by a previous page.
> >     For example, perhaps the result of a page is not an AST that is a field of an `operating-system` form, but instead a procedure that accepts a `(operating-system ...)` form and returns it.
> >     Most existing pages would just append their keyed sub-form.
> >     However the `mirrors` page would modify an existing `services` field in the input `operating-system` form instead.
> >
> >
> > > > +(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.")
> > >
> > > I wonder if it would make sense to select multiple mirrors, as fallback
> > > if the preferred mirror is not up to date. We could also add the
> > > possibility for the user to add a mirror manually.
> > > In that case, the mirror page could look like the "User creation" page,
> > > with an "Add" button opening a popup proposing to type a mirror URL or
> > > to select one from an existing list.
> > > WDYT?
> >
> > I think Less is More, and deploying an installer with a simple "select one mirror" pagenow will cover 90% of use-cases, and we can add the more complicated page later when there is more time.
> > In particular, there is really only one public mirror of Guix that I know of, the SJTU mirror, so all the flexibility here is not very useful, at least not to me.
> > Since "multiple mirrors" aren't even available yet anyway, why add the complication now?
> > Maybe you can encourage more people to actually run mirrors if the installer has a visible "select mirrors" page, so that you can actually get more than just the SJTU mirror and "select multiple mirrors" is now a (good) problem to have to solve.
> > For now I think a simple "select one mirror, we'll add ci.guix.gnu.org as a fallback" would be better.
> > You can add a "select multiple mirrors in an order I want to specify" later, when there are multiple mirrors existing.
> > Thanks
> > raid5atemyhomework

Re: Adding Substitute Mirrors page to installer

[Maxime Devos]

[-- Attachment #1: Type: text/plain, Size: 325 bytes --]

raid5atemyhomework schreef op ma 31-05-2021 om 09:42 [+0000]:
> bump
> > bump

To me it seems all questions have been addressed,
though I was not involved in the discussion.
So, maybe time to merge?

See <https://lists.gnu.org/archive/html/guix-devel/2021-03/msg00294.html>
for the patches.

Greeings,
Maxime.


[-- Attachment #2: This is a digitally signed message part --]
[-- Type: application/pgp-signature, Size: 260 bytes --]

Re: Adding Substitute Mirrors page to installer

[raid5atemyhomework]

Hello Maxime,

> raid5atemyhomework schreef op ma 31-05-2021 om 09:42 [+0000]:
>
> > bump
> >
> > > bump
>
> To me it seems all questions have been addressed,
> though I was not involved in the discussion.
> So, maybe time to merge?
>
> See https://lists.gnu.org/archive/html/guix-devel/2021-03/msg00294.html
> for the patches.

I am not really satisfied with the patch as-is, and I have this question:

>     For example, perhaps the result of a page is not an AST that is a field of an `operating-system` form, but instead a procedure that accepts a `(operating-system ...)` form and returns it.
>     Most existing pages would just append their keyed sub-form.
>     However the `mirrors` page would modify an existing `services` field in the input `operating-system` form instead.

Of course, implementing the above has some problems:

* It is not a trivial change and it would take me a lot of time.
* Nobody has responded to the above **prose** description of the idea, so I am very reluctant to invest in the time to implement the idea since nobody may end up reviewing the actual **code** implementation, which of course will be less easy to understand than the above prosody.

I will not object if the existing patch is merged in, but I will not work on the above idea until somebody actually responds to it somehow.

Thanks
raid5atemyhomework

Re: Adding Substitute Mirrors page to installer

[Mathieu Othacehe]

Hello,

Sorry again for the long delay.

> Of course, it feels somewhat dirty, as there is a need to read the configuration file.
> It would be cleaner if a page could affect the field created by a previous page.

Yes I agree. In the meantime, I think that the configuration file read
is an acceptable solution.

> I think Less is More, and deploying an installer with a simple "select one
> mirror" page *now* will cover 90% of use-cases, and we can add the more
> complicated page later when there is more time.

Seems fair.

I ran the installer tests with this command: make check-system
TESTS="gui-installed-os". The following error is reported:

--8<---------------cut here---------------start------------->8---
conversation expecting pattern ((quote list-selection) ((quote title) "Partitioning method") ((quote multiple-choices?) #f) ((quote items) (not-encrypted encrypted _ ...)))
/gnu/store/h38i2hvaqy9bd0sbn9isdfzl7m56mngr-shepherd-marionette.scm:1:1718: ERROR:
  1. &pattern-not-matched:
      pattern: ((quote list-selection) ((quote title) "Partitioning method") ((quote multiple-choices?) #f) ((quote items) (not-encrypted encrypted _ ...)))
      sexp: (list-selection (title "Substitute mirror") (multiple-choices? #f) (items ("https://ci.guix.gnu.org (Berlin, official Guix substitute server)" "https://mirror.sjtu.edu.cn/guix (China, SJTU)")))
Backtrace:
           2 (primitive-load "/gnu/store/n6z0h9gxfkzrvsfcsbpd05kxxcx?")
In ice-9/eval.scm:
   191:35  1 (_ #f)
    619:8  0 (_ #(#<directory (guile-user) 7ffff3bb3f00> #<variabl?>))

ice-9/eval.scm:619:8: Throw to key `marionette-eval-failure' with args `((quote (choose-partitioning installer-socket #:encrypted? #f #:passphrase "thepassphrase" #:uefi-support? #f)))'.
note: keeping build directory `/tmp/guix-build-installation.drv-0'
builder for `/gnu/store/wp95pl7l9jfjwj6dpizhmbsfb85alzi1-installation.drv' failed with exit code 1
build of /gnu/store/wp95pl7l9jfjwj6dpizhmbsfb85alzi1-installation.drv failed
View build log at '/var/log/guix/drvs/wp/95pl7l9jfjwj6dpizhmbsfb85alzi1-installation.drv.bz2'.
--8<---------------cut here---------------end--------------->8---

As explained here:
https://lists.gnu.org/archive/html/guix-patches/2021-05/msg00819.html,
you need to introduce a new "list-selection" conversation item in the
"choose-services" procedure of the (gnu installer tests) module to fix
this issue.

Thanks,

Mathieu

Re: Adding Substitute Mirrors page to installer

[raid5atemyhomework]

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=> (find
+                                        (lambda (service)
+                                          (eq? guix-service-type
+                                               (service-kind service)))
+                                        (operating-system-services os))
+                                      (compose guix-configuration-substitute-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 `operating-system`, so I wonder why the testing environment is somehow different.  Printing via `syslog "~A~%"` shows the `os` object as being some `#<unidentified struct>`, 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 installing 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 <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 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=> (find
+                                        (lambda (service)
+                                          (eq? guix-service-type
+                                               (service-kind service)))
+                                        (operating-system-services os))
+                                      (compose guix-configuration-substitute-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 substitute 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 =>
+                                     (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-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' 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 substitute-urls))))
+
                   ;; Start the guix-daemon from a container, when supported,
                   ;; 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="
                                          (if discover? "yes" "no"))
-                          "--substitute-urls" #$(string-join substitute-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

Re: Adding Substitute Mirrors page to installer

[raid5atemyhomework]

.... 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 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=> (find
>
>
> -                                          (lambda (service)
>
>
> -                                            (eq? guix-service-type
>
>
> -                                                 (service-kind service)))
>
>
> -                                          (operating-system-services os))
>
>
> -                                        (compose guix-configuration-substitute-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 `operating-system`, so I wonder why the testing environment is somehow different. Printing via `syslog "~A~%"` shows the `os` object as being some `#<unidentified struct>`, 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 installing 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 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 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=> (find
>
>
> -                                          (lambda (service)
>
>
> -                                            (eq? guix-service-type
>
>
> -                                                 (service-kind service)))
>
>
> -                                          (operating-system-services os))
>
>
> -                                        (compose guix-configuration-substitute-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 substitute 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 =>
>
>
> -                                       (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-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' 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 substitute-urls))))
>
>
> -                    ;; Start the guix-daemon from a container, when supported,
>                      ;; 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="
> (if discover? "yes" "no"))
>
> -                            "--substitute-urls" #$(string-join substitute-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

Re: Adding Substitute Mirrors page to installer

[Tobias Geerinckx-Rice]

[CC'ing Andreas & Chris in case they want to chime in.]

On 2021-07-23 16:53, raid5atemyhomework wrote:
> As an aside, I notice there is now a new "bayfront.guix.gnu.org" 
> server.

bayfront has been public sinc 2016..2017?, but it was recently exposed 
through a second hostname, bordeaux.guix.gnu.org.  That's the name that 
should be used if added.

> Not sure if I should modify this patch or not to add it or whatever.

I don't see why not!  It's the only Guix-hosted substitute server after 
ci.guix.gnu.org, and has the advantage of not being a mere mirror.

Kind regards,

T G-R

Sent from a Web browser.  Excuse or enjoy my brevity.

Re: Adding Substitute Mirrors page to installer

[raid5atemyhomework]

Hello Tobias,

> > As an aside, I notice there is now a new "bayfront.guix.gnu.org"
> > server.
>
> bayfront has been public sinc 2016..2017?, but it was recently exposed
> through a second hostname, bordeaux.guix.gnu.org. That's the name that
> should be used if added.
>
> > Not sure if I should modify this patch or not to add it or whatever.
>
> I don't see why not! It's the only Guix-hosted substitute server after
> ci.guix.gnu.org, and has the advantage of not being a mere mirror.
>

If I add it, does this actually increase the chances the patch will get in or not?

Note that the current Substitute Mirrors Page system allows to select only one set of substitutes.
Mathieu was mentioning the ability to have a more complex Substitute Mirrors Page that allows to set up substitute servers in arbitrary order and so on, but I considered that it would be easier to implement a simple "just select one of these sets of substitutes" and hoped it would mean the patch gets in earlier rather than later.


In any case, it looks to me that bordeaux is already in `%default-substitute-mirrors`, which this patch uses, so it should get included anyway as a fallback in case the SJTU mirror is not available or something.
So maybe the patch is OK as-is?


Thanks
raid5atemyhomework

Re: Adding Substitute Mirrors page to installer

[raid5atemyhomework]

BUMP

Re: Adding Substitute Mirrors page to installer

[Christopher Baines]

[-- Attachment #1: Type: text/plain, Size: 464 bytes --]


raid5atemyhomework <raid5atemyhomework@protonmail.com> writes:

> In any case, it looks to me that bordeaux is already in
> `%default-substitute-mirrors`, which this patch uses, so it should get
> included anyway as a fallback in case the SJTU mirror is not available
> or something.  So maybe the patch is OK as-is?

I haven't looked at the changes here, but given bordeaux.guix.gnu.org is
a default substitute server, I don't think it'll need special handling.

[-- Attachment #2: signature.asc --]
[-- Type: application/pgp-signature, Size: 987 bytes --]

Re: Adding Substitute Mirrors page to installer

[raid5atemyhomework]

Any chance of this getting reviewed and merge within the next five years?

Thanks
raid5atemyhomework

Re: Adding Substitute Mirrors page to installer

[zimoun]

Hi,

On Wed, 1 Dec 2021 at 07:13, raid5atemyhomework
<raid5atemyhomework@protonmail.com> wrote:

> Any chance of this getting reviewed and merge within the next five years?

I understand your frustration.  Could you please point which patch number ?

Cheers,
simon

Re: Adding Substitute Mirrors page to installer

[raid5atemyhomework]

Hi zimoun,


> > Any chance of this getting reviewed and merge within the next five years?
>
> I understand your frustration. Could you please point which patch number ?


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 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=> (find
+                                        (lambda (service)
+                                          (eq? guix-service-type
+                                               (service-kind service)))
+                                        (operating-system-services os))
+                                      (compose guix-configuration-substitute-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 substitute 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 =>
+                                     (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-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' 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 substitute-urls))))
+
                   ;; Start the guix-daemon from a container, when supported,
                   ;; 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="
                                          (if discover? "yes" "no"))
-                          "--substitute-urls" #$(string-join substitute-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

Re: Adding Substitute Mirrors page to installer

[zimoun]

Hi,

On Wed, 1 Dec 2021 at 23:49, raid5atemyhomework
<raid5atemyhomework@protonmail.com> wrote:

> 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.

Thanks.

But I do not find it in the Debuggs database.  Or it is deeply hidden
somewhere in a thread.  Could you point the assigned debbugs number?


Cheers,
simon

Re: Adding Substitute Mirrors page to installer

[Jonathan Brielmaier]

On 02.12.21 10:36, zimoun wrote:
> Hi,
>
> On Wed, 1 Dec 2021 at 23:49, raid5atemyhomework
> <raid5atemyhomework@protonmail.com> wrote:
>
>>  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.
>
> Thanks.
>
> But I do not find it in the Debuggs database.  Or it is deeply hidden
> somewhere in a thread.  Could you point the assigned debbugs number?

It was only posted to the guix-devel list by raid5. I don't think he
send it to guix-patches@gnu.org...