Bump
Sent with ProtonMail Secure Email. ‐‐‐‐‐‐‐ Original Message ‐‐‐‐‐‐‐ On Tuesday, March 16, 2021 11:55 PM, raid5atemyhomework <raid5atemyhomew...@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 raid5atemyhomew...@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
