aboutsummaryrefslogtreecommitdiff
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2018 Mathieu Othacehe <m.othacehe@gmail.com>
;;; Copyright © 2019, 2020 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2020, 2024 Janneke Nieuwenhuizen <janneke@gnu.org>
;;; Copyright © 2021 Tobias Geerinckx-Rice <me@tobias.gr>
;;; Copyright © 2021 Leo Famulari <leo@famulari.name>
;;;
;;; This file is part of GNU Guix.
;;;
;;; GNU Guix is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version.
;;;
;;; GNU Guix is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.

(define-module (gnu installer newt services)
  #:use-module (gnu installer services)
  #:use-module (gnu installer steps)
  #:use-module (gnu installer newt page)
  #:use-module (gnu installer newt utils)
  #:use-module (guix i18n)
  #:use-module (guix utils)
  #:use-module (srfi srfi-34)
  #:use-module (srfi srfi-35)
  #:export (run-services-page))

(define (run-desktop-environments-cbt-page)
  "Run a page allowing the user to choose between various desktop
environments."
  (let ((items (filter desktop-system-service? (%system-services))))
    (run-checkbox-tree-page
     #:info-text (if (target-hurd?)
                     (G_ "Currently, none of these is available for the Hurd.")
                     (G_ "Please select the desktop environment(s) you wish to \
install.  If you select multiple desktop environments here, you will be able \
to choose from them later when you log in."))
     #:title (G_ "Desktop environment")
     #:items items
     #:selection (map system-service-recommended? items)
     #:item->text system-service-name             ;no i18n for DE names
     #:checkbox-tree-height 9
     #:exit-button-callback-procedure
     (lambda ()
       (abort-to-prompt 'installer-step 'abort)))))

(define (run-networking-cbt-page)
  "Run a page allowing the user to select networking services."
  (let ((items (filter (lambda (service)
                         (eq? 'networking (system-service-type service)))
                       (%system-services))))
    (run-checkbox-tree-page
     #:info-text (G_ "You can now select networking services to run on your \
system.")
     #:title (G_ "Network service")
     #:items items
     #:selection (map system-service-recommended? items)
     #:item->text (compose G_ system-service-name)
     #:checkbox-tree-height 5
     #:exit-button-callback-procedure
     (lambda ()
       (abort-to-prompt 'installer-step 'abort)))))

(define (run-printing-services-cbt-page)
  "Run a page allowing the user to select document services such as CUPS."
  (let ((items (filter (lambda (service)
                         (eq? 'document
                              (system-service-type service)))
                       (%system-services))))
    (run-checkbox-tree-page
     #:info-text (G_ "You can now select the CUPS printing service to run on your \
system.")
     #:title (G_ "Printing and document services")
     #:items items
     #:selection (map system-service-recommended? items)
     #:item->text (compose G_ system-service-name)
     #:checkbox-tree-height 9
     #:exit-button-callback-procedure
     (lambda ()
       (abort-to-prompt 'installer-step 'abort)))))

(define (run-console-services-cbt-page)
  "Run a page to select various system adminstration services for non-graphical
systems."
  (let ((items (filter (lambda (service)
                         (eq? 'administration
                              (system-service-type service)))
                       (%system-services))))
    (run-checkbox-tree-page
      #:title (G_ "Console services")
      #:info-text (G_ "Select miscellaneous services to run on your \
non-graphical system.")
      #:items items
      #:selection (map system-service-recommended? items)
      #:item->text (compose G_ system-service-name)
      #:checkbox-tree-height 5
      #:exit-button-callback-procedure
      (lambda _
        (abort-to-prompt 'installer-step 'abort)))))

(define (run-network-management-page)
  "Run a page to select among several network management methods."
  (let ((title (G_ "Network management"))
        (items (filter (lambda (service)
                         (eq? 'network-management
                              (system-service-type service)))
                       (%system-services))))
    (run-listbox-selection-page
     #:title title
     #:info-text (G_ "Choose the method to manage network connections.

We recommend NetworkManager or Connman for a WiFi-capable laptop; the DHCP \
client may be enough for a server.")
     #:info-textbox-width 70
     #:listbox-height 7
     #:listbox-items `(,@items
                       ,@(if (target-hurd?)
                             (list system-service-none)
                             '()))
     #:listbox-item->text (compose G_ system-service-name)
     #:sort-listbox-items? #f
     #:button-text (G_ "Exit")
     #:button-callback-procedure
     (lambda _
       (abort-to-prompt '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
    ;; '%desktop-services', offer network management services.
    (append desktop
            (run-networking-cbt-page)
            (if (null? desktop)
                (cons (run-network-management-page)
                      (run-console-services-cbt-page))
                '())
            (run-printing-services-cbt-page))))
04-21 08:30:32 -0700'>2021-04-21image: Fix spelling of "evaluate"...* gnu/build/image.scm: Fix typo. Vagrant Cascadian 2020-12-15database: Remove #:deduplicate? from 'register-items'....It is now up to the caller to deduplicate store contents. * guix/store/database.scm (register-items): Remove #:deduplicate? parameter and call to 'deduplicate'. (register-path): Call 'deduplicate' when #:deduplicate? is true. * gnu/build/image.scm (register-closure): Adjust call accordingly. * gnu/build/vm.scm (register-closure): Likewise. * guix/nar.scm (finalize-store-file): Likewise. * guix/scripts/pack.scm (store-database): Likewise. Ludovic Courtès 2020-12-15image: 'register-closure' leaves it up to the caller to deduplicate....* gnu/build/image.scm (register-closure): Remove #:deduplicate? parameter and pass #:deduplicate? #f to 'register-items'. (initialize-root-partition): Adjust accordingly. * gnu/build/vm.scm (register-closure, root-partition-initializer): Likewise. Ludovic Courtès 2020-12-15store-copy: 'populate-store' can optionally deduplicate files....Until now deduplication was performed as an additional pass after copying files, which involve re-traversing all the files that had just been copied. * guix/store/deduplication.scm (copy-file/deduplicate): New procedure. * tests/store-deduplication.scm ("copy-file/deduplicate"): New test. * guix/build/store-copy.scm (populate-store): Add #:deduplicate? parameter and honor it. * tests/gexp.scm ("gexp->derivation, store copy"): Pass #:deduplicate? #f to 'populate-store'. * gnu/build/image.scm (initialize-root-partition): Pass #:deduplicate? to 'populate-store'. Pass #:deduplicate? #f to 'register-closure'. * gnu/build/vm.scm (root-partition-initializer): Likewise. * gnu/build/install.scm (populate-single-profile-directory): Pass #:deduplicate? #f to 'populate-store'. * gnu/build/linux-initrd.scm (build-initrd): Likewise. * guix/scripts/pack.scm (self-contained-tarball)[import-module?]: New procedure. [build]: Pass it as an argument to 'source-module-closure'. * guix/scripts/pack.scm (squashfs-image)[build]: Wrap in 'with-extensions'. * gnu/system/linux-initrd.scm (expression->initrd)[import-module?]: New procedure. [builder]: Pass it to 'source-module-closure'. * gnu/system/install.scm (cow-store-service-type)[import-module?]: New procedure. Pass it to 'source-module-closure'. Ludovic Courtès 2020-12-15database: Remove #:reset-timestamps? from 'register-items'....The assumption now is that the caller took care of resetting timestamps and permissions. * guix/store/database.scm (register-items): Remove #:reset-timestamps? parameter and the call to 'reset-timestamps'. (register-path): Adjust accordingly and add call to 'reset-timestamps'. * gnu/build/image.scm (register-closure): Remove #:reset-timestamps? parameter to 'register-items'. * gnu/build/vm.scm (register-closure): Likewise. * guix/nar.scm (finalize-store-file): Adjust accordingly. * guix/scripts/pack.scm (store-database)[build]: Likewise. Ludovic Courtès 2020-12-15image: 'register-closure' assumes already-reset timestamps....* gnu/build/image.scm (register-closure): Remove #:reset-timestamps? parameter. Pass #:reset-timestamps? #f to 'register-items'. (initialize-root-partition): Adjust accordingly. * gnu/build/vm.scm (register-closure, root-partition-initializer): Likewise. Ludovic Courtès 2020-12-15store-copy: 'populate-store' resets timestamps....Until now, 'populate-store' would reset permissions but not timestamps, so callers would resort to going through an extra directory traversal to reset timestamps. * guix/build/store-copy.scm (reset-permissions): Remove. (copy-recursively): New procedure. (populate-store): Pass #:keep-permissions? to 'copy-recursively'. Remove call to 'reset-permissions'. * tests/gexp.scm ("gexp->derivation, store copy"): In BUILD-DRV, check whether 'populate-store' canonicalizes permissions and timestamps. * gnu/build/image.scm (initialize-root-partition): Pass #:reset-timestamps? #f to 'register-closure'. * gnu/build/vm.scm (root-partition-initializer): Likewise. Ludovic Courtès 2020-11-05image: Error out when passed an unsupported partition type....* gnu/build/image.scm (make-partition-image): Use 'raise' instead of 'format' when TYPE is not supported. (convert-disk-image): Remove unneeded 'begin'. Ludovic Courtès 2020-09-29image: Add support for compressed-qcow2 format....* gnu/build/image.scm (convert-disk-image): New procedure. (genimage): Remove target argument. * gnu/system/image.scm (system-disk-image): Add support for 'compressed-qcow2 image format. Call "convert-disk-image" to apply image conversions on the final image. Add "qemu-minimal" to the build inputs. (system-image): Also add support for 'compressed-qcow2. Mathieu Othacehe