diff options
Diffstat (limited to 'gnu/installer/final.scm')
| -rw-r--r-- | gnu/installer/final.scm | 61 |
1 files changed, 28 insertions, 33 deletions
diff --git a/gnu/installer/final.scm b/gnu/installer/final.scm index fc0b7803fa..276af908f7 100644 --- a/gnu/installer/final.scm +++ b/gnu/installer/final.scm @@ -105,36 +105,6 @@ USERS." (write-passwd password (string-append etc "/passwd")) (write-shadow shadow (string-append etc "/shadow"))) -(define* (kill-cow-users cow-path #:key (spare '("udevd"))) - "Kill all processes that have references to the given COW-PATH in their -'maps' file. The process whose names are in SPARE list are spared." - (define %not-nul - (char-set-complement (char-set #\nul))) - - (let ((pids - (filter-map (lambda (pid) - (false-if-exception - (call-with-input-file - (string-append "/proc/" pid "/maps") - (lambda (port) - (and (string-contains (get-string-all port) - cow-path) - (string->number pid)))))) - (scandir "/proc" string->number)))) - (for-each (lambda (pid) - ;; cmdline does not always exist. - (false-if-exception - (call-with-input-file - (string-append "/proc/" (number->string pid) "/cmdline") - (lambda (port) - (match (string-tokenize (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 @@ -149,6 +119,28 @@ it can interact with the rest of the system." (match (waitpid pid) ((_ . status) status)))) +(define (install-locale locale) + "Install the given LOCALE or the en_US.utf8 locale as a fallback." + (let ((supported? (false-if-exception + (setlocale LC_ALL locale)))) + (if supported? + (begin + (syslog "install supported locale ~a~%." locale) + (setenv "LC_ALL" locale)) + (begin + ;; If the selected locale is not supported, install a default UTF-8 + ;; locale. This is required to copy some files with UTF-8 + ;; characters, in the nss-certs package notably. Set LANGUAGE + ;; anyways, to have translated messages if possible. + (syslog "~a locale is not supported, installating en_US.utf8 \ +locale instead.~%" locale) + (setlocale LC_ALL "en_US.utf8") + (setenv "LC_ALL" "en_US.utf8") + (setenv "LANGUAGE" + (string-take locale + (or (string-index locale #\_) + (string-length locale)))))))) + (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 @@ -199,6 +191,10 @@ or #f. Return #t on success and #f on failure." (lambda () (dynamic-wind (lambda () + ;; Install the locale before mounting the cow-store, otherwise + ;; the loaded cow-store locale files will prevent umounting. + (install-locale locale) + ;; Save the database, so that it can be restored once the ;; cow-store is umounted. (copy-file database-file saved-database) @@ -221,9 +217,8 @@ or #f. Return #t on success and #f on failure." (lambda () (with-error-to-file "/dev/console" (lambda () - (run-command install-command - #:locale locale))))) - (run-command install-command #:locale locale)))) + (run-command install-command))))) + (run-command install-command)))) (lambda () ;; Restart guix-daemon so that it does no keep the MNT namespace ;; alive. |