;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2018, 2020 Mathieu Othacehe <m.othacehe@gmail.com>
;;; Copyright © 2019, 2020 Ludovic Courtès <ludo@gnu.org>
;;;
;;; 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 final)
  #:use-module (gnu installer newt page)
  #:use-module (gnu installer steps)
  #:use-module (gnu installer utils)
  #:use-module (gnu installer user)
  #:use-module (gnu services herd)
  #:use-module (guix build syscalls)
  #:use-module </td></tr></table>
<table class='tabs'><tr><td>
<a href='/guix/about/'>about</a><a href='/guix/'>summary</a><a href='/guix/refs/?id=51bf90c72e9c627f2bf8acb5556c5c6f9132cebe'>refs</a><a href='/guix/log/gnu/packages/mold.scm'>log</a><a href='/guix/tree/gnu/packages/mold.scm?id=51bf90c72e9c627f2bf8acb5556c5c6f9132cebe'>tree</a><a href='/guix/commit/gnu/packages/mold.scm?id=51bf90c72e9c627f2bf8acb5556c5c6f9132cebe'>commit</a><a class='active' href='/guix/diff/gnu/packages/mold.scm?id=51bf90c72e9c627f2bf8acb5556c5c6f9132cebe&amp;id2=acd9d1b9b21c21f2774f01f7cb4b6185debb6fa2'>diff</a></td><td class='form'><form class='right' method='get' action='/guix/log/gnu/packages/mold.scm'>
<input type='hidden' name='id' value='51bf90c72e9c627f2bf8acb5556c5c6f9132cebe'/><input type='hidden' name='id2' value='acd9d1b9b21c21f2774f01f7cb4b6185debb6fa2'/><select name='qt'>
<option value='grep'>log msg</option>
<option value='author'>author</option>
<option value='committer'>committer</option>
<option value='range'>range</option>
</select>
<input class='txt' type='search' size='10' name='q' value=''/>
<input type='submit' value='search'/>
</form>
</td></tr></table>
<div class='path'>path: <a href='/guix/diff/?id=51bf90c72e9c627f2bf8acb5556c5c6f9132cebe&amp;id2=acd9d1b9b21c21f2774f01f7cb4b6185debb6fa2'>root</a>/<a href='/guix/diff/gnu?id=51bf90c72e9c627f2bf8acb5556c5c6f9132cebe&amp;id2=acd9d1b9b21c21f2774f01f7cb4b6185debb6fa2'>gnu</a>/<a href='/guix/diff/gnu/packages?id=51bf90c72e9c627f2bf8acb5556c5c6f9132cebe&amp;id2=acd9d1b9b21c21f2774f01f7cb4b6185debb6fa2'>packages</a>/<a href='/guix/diff/gnu/packages/mold.scm?id=51bf90c72e9c627f2bf8acb5556c5c6f9132cebe&amp;id2=acd9d1b9b21c21f2774f01f7cb4b6185debb6fa2'>mold.scm</a></div><div class='content'><div class='cgit-panel'><b>diff options</b><form method='get'><input type='hidden' name='id' value='51bf90c72e9c627f2bf8acb5556c5c6f9132cebe'/><input type='hidden' name='id2' value='acd9d1b9b21c21f2774f01f7cb4b6185debb6fa2'/><table><tr><td colspan='2'/></tr><tr><td class='label'>context:</td><td class='ctrl'><select name='context' onchange='this.form.submit();'><option value='1'>1</option><option value='2'>2</option><option value='3' selected='selected'>3</option><option value='4'>4</option><option value='5'>5</option><option value='6'>6</option><option value='7'>7</option><option value='8'>8</option><option value='9'>9</option><option value='10'>10</option><option value='15'>15</option><option value='20'>20</option><option value='25'>25</option><option value='30'>30</option><option value='35'>35</option><option value='40'>40</option></select></td></tr><tr><td class='label'>space:</td><td class='ctrl'><select name='ignorews' onchange='this.form.submit();'><option value='0' selected='selected'>include</option><option value='1'>ignore</option></select></td></tr><tr><td class='label'>mode:</td><td class='ctrl'><select name='dt' onchange='this.form.submit();'><option value='0' selected='selected'>unified</option><option value='1'>ssdiff</option><option value='2'>stat only</option></select></td></tr><tr><td/><td class='ctrl'><noscript><input type='submit' value='reload'/></noscript></td></tr></table></form></div><div class='diffstat-header'><a href='/guix/diff/?id=51bf90c72e9c627f2bf8acb5556c5c6f9132cebe&amp;id2=acd9d1b9b21c21f2774f01f7cb4b6185debb6fa2'>Diffstat</a> (limited to 'gnu/packages/mold.scm')</div><table summary='diffstat' class='diffstat'></table><div class='diffstat-summary'>0 files changed, 0 insertions, 0 deletions</div><table summary='diff' class='diff'><tr><td></td></tr></table></div> <!-- class=content -->
                         <div class=footer>generated by
                             <a href="https://git.zx2c4.com/cgit/about/">
                                 cgit
                             </a>
                         </div>
                        </div> <!-- id=cgit -->
</body>
</html>
okenize (read-string port) %not-nul)
                       ((argv0 _ ...)
                        (unless (member (basename argv0) spare)
                          (syslog "Killing process ~a (~a)~%" pid argv0)
                          (kill pid SIGKILL)))
                       (_ #f))))))
              pids)))

(define (call-with-mnt-container thunk)
  "This is a variant of call-with-container. Run THUNK in a new container
process, within a separate MNT namespace. The container is not jailed so that
it can interact with the rest of the system."
  (let ((pid (run-container "/" '() '(mnt) 1 thunk)))
    ;; Catch SIGINT and kill the container process.
    (sigaction SIGINT
      (lambda (signum)
        (false-if-exception
         (kill pid SIGKILL))))

    (match (waitpid pid)
      ((_ . status) status))))

(define* (install-system locale #:key (users '()))
  "Create /etc/shadow and /etc/passwd on the installation target for USERS.
Start COW-STORE service on target directory and launch guix install command in
a subshell.  LOCALE must be the locale name under which that command will run,
or #f.  Return #t on success and #f on failure."
  (define backing-directory
    ;; Sub-directory used as the backing store for copy-on-write.
    "/tmp/guix-inst")

  (define (assert-exit x)
    (primitive-exit (if x 0 1)))

  (let* ((options         (catch 'system-error
                            (lambda ()
                              ;; If this file exists, it can provide
                              ;; additional command-line options.
                              (call-with-input-file
                                  "/tmp/installer-system-init-options"
                                read))
                            (const '())))
         (install-command (append (list "guix" "system" "init"
                                        "--fallback")
                                  options
                                  (list (%installer-configuration-file)
                                        (%installer-target-dir))))
         (database-dir    "/var/guix/db")
         (database-file   (string-append database-dir "/db.sqlite"))
         (saved-database  (string-append database-dir "/db.save"))
         (ret             #f))
    (mkdir-p (%installer-target-dir))

    ;; We want to initialize user passwords but we don't want to store them in
    ;; the config file since the password hashes would end up world-readable
    ;; in the store.  Thus, create /etc/shadow & co. here such that, on the
    ;; first boot, the activation snippet that creates accounts will reuse the
    ;; passwords that we've put in there.
    (create-user-database users (%installer-target-dir))

    ;; When the store overlay is mounted, other processes such as kmscon, udev
    ;; and guix-daemon may open files from the store, preventing the
    ;; underlying install support from being umounted. See:
    ;; https://lists.gnu.org/archive/html/guix-devel/2018-12/msg00161.html.
    ;;
    ;; To avoid this situation, mount the store overlay inside a container,
    ;; and run the installation from within that container.
    (zero?
     (call-with-mnt-container
       (lambda ()
         (dynamic-wind
           (lambda ()
             ;; Save the database, so that it can be restored once the
             ;; cow-store is umounted.
             (copy-file database-file saved-database)
             (mount-cow-store (%installer-target-dir) backing-directory))
           (lambda ()
             ;; We need to drag the guix-daemon to the container MNT
             ;; namespace, so that it can operate on the cow-store.
             (stop-service 'guix-daemon)
             (start-service 'guix-daemon (list (number->string (getpid))))

             (setvbuf (current-output-port) 'none)
             (setvbuf (current-error-port) 'none)

             ;; If there are any connected clients, assume that we are running
             ;; installation tests. In that case, dump the standard and error
             ;; outputs to syslog.
             (set! ret
                   (if (not (null? (current-clients)))
                       (with-output-to-file "/dev/console"
                         (lambda ()
                           (with-error-to-file "/dev/console"
                             (lambda ()
                               (run-command install-command
                                            #:locale locale)))))
                       (run-command install-command #:locale locale))))
           (lambda ()
             ;; Restart guix-daemon so that it does no keep the MNT namespace
             ;; alive.
             (restart-service 'guix-daemon)
             (copy-file saved-database database-file)

             ;; Finally umount the cow-store and exit the container.
             (unmount-cow-store (%installer-target-dir) backing-directory)
             (assert-exit ret))))))))