unofficial mirror of guix-devel@gnu.org 
 help / color / mirror / code / Atom feed
From: raid5atemyhomework <raid5atemyhomework@protonmail.com>
To: Pierre Neidhardt <mail@ambrevar.xyz>
Cc: "guix-devel@gnu.org" <guix-devel@gnu.org>,
	Mathieu Othacehe <othacehe@gnu.org>
Subject: Re: Adding Substitute Mirrors page to installer
Date: Sat, 27 Mar 2021 06:48:28 +0000	[thread overview]
Message-ID: <z8Ks4aqsDTgTjQBqxY085fWNZfqTy8auuAjnoFIkozfzWMfNAwBDTpi_pNRldqjv6YK5kEfKUCXLMe4mTmihFrsmlaP7NWJjbRVcxve2KBg=@protonmail.com> (raw)
In-Reply-To: <3YQTy8cg8z-IZkxgM7lJSk8ZeolHbf4t7_HPw9Q8GCkx1lP7CXrbdtPZ9Hvyo--NvKXyr9W2iv82d8lL2T0NQPpTPhDbBFo3_3jQ3eAdAEI=@protonmail.com>

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




  reply	other threads:[~2021-03-27  6:49 UTC|newest]

Thread overview: 28+ messages / expand[flat|nested]  mbox.gz  Atom feed  top
2021-03-07  2:46 Adding Substitute Mirrors page to installer raid5atemyhomework
2021-03-09  2:34 ` raid5atemyhomework
2021-03-09  8:05   ` Pierre Neidhardt
2021-03-10  9:49     ` raid5atemyhomework
2021-03-15 16:14       ` Ludovic Courtès
2021-03-15 22:53       ` zimoun
2021-03-16  1:07       ` raid5atemyhomework
2021-03-16 15:55         ` raid5atemyhomework
2021-03-27  6:48           ` raid5atemyhomework [this message]
2021-03-27  8:56             ` Mathieu Othacehe
2021-04-01  9:22           ` Mathieu Othacehe
2021-04-22  5:23             ` raid5atemyhomework
2021-05-13  1:27               ` raid5atemyhomework
2021-05-31  9:42                 ` raid5atemyhomework
2021-05-31 10:04                   ` Maxime Devos
2021-06-01  6:39                     ` raid5atemyhomework
2021-06-01  8:30               ` Mathieu Othacehe
2021-06-02 14:44                 ` raid5atemyhomework
2021-07-23 14:53                   ` raid5atemyhomework
2021-07-23 15:10                     ` Tobias Geerinckx-Rice
2021-07-23 15:21                       ` raid5atemyhomework
2021-08-01  9:42                         ` raid5atemyhomework
2021-08-01 12:28                         ` Christopher Baines
2021-12-01  6:11                           ` raid5atemyhomework
2021-12-01  8:16                             ` zimoun
2021-12-01 22:49                               ` raid5atemyhomework
2021-12-02  9:36                                 ` zimoun
2021-12-02 10:20                                   ` Jonathan Brielmaier

Reply instructions:

You may reply publicly to this message via plain-text email
using any one of the following methods:

* Save the following mbox file, import it into your mail client,
  and reply-to-all from there: mbox

  Avoid top-posting and favor interleaved quoting:
  https://en.wikipedia.org/wiki/Posting_style#Interleaved_style

  List information: https://guix.gnu.org/

* Reply using the --to, --cc, and --in-reply-to
  switches of git-send-email(1):

  git send-email \
    --in-reply-to='z8Ks4aqsDTgTjQBqxY085fWNZfqTy8auuAjnoFIkozfzWMfNAwBDTpi_pNRldqjv6YK5kEfKUCXLMe4mTmihFrsmlaP7NWJjbRVcxve2KBg=@protonmail.com' \
    --to=raid5atemyhomework@protonmail.com \
    --cc=guix-devel@gnu.org \
    --cc=mail@ambrevar.xyz \
    --cc=othacehe@gnu.org \
    /path/to/YOUR_REPLY

  https://kernel.org/pub/software/scm/git/docs/git-send-email.html

* If your mail client supports setting the In-Reply-To header
  via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line before the message body.
Code repositories for project(s) associated with this public inbox

	https://git.savannah.gnu.org/cgit/guix.git

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).