aboutsummaryrefslogtreecommitdiff
path: root/AUTHORS
blob: 1e30a74a64f51ec735dcc44ff4dfe5fa4fa13c6f (about) (plain) 
1
2
3
4
5
6
7
8
9

GNU Guix consists of Scheme code that implements the deployment model
of the Nix package management tool.  In fact, it currently talks to a
build daemon whose code comes from Nix (see the manual for details.)

Nix was initially written by Eelco Dolstra; other people have been
contributing to it.  See `nix/AUTHORS' for details.

The list of GNU Guix contributors is now generated from the output of
'git log' and written to this file, as can be seen in release tarballs.
generated by cgit
ld environment (in derivations that ;;; build VM images), and on the bare metal (when really installing the ;;; system.) ;;; ;;; Code: (define (install-boot-config bootcfg bootcfg-location mount-point) "Atomically copy BOOTCFG into BOOTCFG-LOCATION on the MOUNT-POINT. Note that the caller must make sure that BOOTCFG is registered as a GC root so that the fonts, background images, etc. referred to by BOOTCFG are not GC'd." (let* ((target (string-append mount-point bootcfg-location)) (pivot (string-append target ".new"))) (mkdir-p (dirname target)) ;; Copy BOOTCFG instead of just symlinking it, because symlinks won't ;; work when /boot is on a separate partition. Do that atomically. (copy-file bootcfg pivot) (rename-file pivot target))) (define* (evaluate-populate-directive directive target #:key (default-gid 0) (default-uid 0) (error-on-dangling-symlink? #t)) "Evaluate DIRECTIVE, an sexp describing a file or directory to create under directory TARGET. DEFAULT-UID and DEFAULT-GID are the default UID and GID in the context of the caller. If the directive matches those defaults then, 'chown' won't be run. When ERROR-ON-DANGLING-SYMLINK? is true, abort with an error when a dangling symlink would be created." (define target* (if (string-suffix? "/" target) target (string-append target "/"))) (let loop ((directive directive)) (catch 'system-error (lambda () (match directive (('directory name) (mkdir-p (string-append target* name))) (('directory name uid gid) (let ((dir (string-append target* name))) (mkdir-p dir) ;; If called from a context without "root" permissions, "chown" ;; to root will fail. In that case, do not try to run "chown" ;; and assume that the file will be chowned elsewhere (when ;; interned in the store for instance). (or (and (= uid default-uid) (= gid default-gid)) (chown dir uid gid)))) (('directory name uid gid mode) (loop `(directory ,name ,uid ,gid)) (chmod (string-append target* name) mode)) (('file name) (call-with-output-file (string-append target* name) (const #t))) (('file name (? string? content)) (call-with-output-file (string-append target* name) (lambda (port) (display content port)))) ((new '-> old) (let ((new* (string-append target* new))) (let try () (catch 'system-error (lambda () (when error-on-dangling-symlink? ;; When the symbolic link points to a relative path, ;; checking if its target exists must be done relatively ;; to the link location. (unless (if (string-prefix? "/" old) (file-exists? old) (with-directory-excursion (dirname new*) (file-exists? old))) (error (format #f "symlink `~a' points to nonexistent \ file `~a'" new* old)))) (symlink old new*)) (lambda args ;; When doing 'guix system init' on the current '/', some ;; symlinks may already exists. Override them. (if (= EEXIST (system-error-errno args)) (begin (delete-file new*) (try)) (apply throw args))))))))) (lambda args ;; Usually we can only get here when installing to an existing root, ;; as with 'guix system init foo.scm /'. (format (current-error-port) "error: failed to evaluate directive: ~s~%" directive) (apply throw args))))) (define (directives store) "Return a list of directives to populate the root file system that will host STORE." `((directory ,store 0 0 #o1775) (directory "/etc") (directory "/var/log") ; for shepherd (directory "/var/guix/gcroots") (directory "/var/empty") ; for no-login accounts (directory "/var/db") ; for dhclient, etc. (directory "/mnt") (directory "/var/guix/profiles/per-user/root" 0 0) ;; Link to the initial system generation. ("/var/guix/profiles/system" -> "system-1-link") ("/var/guix/gcroots/booted-system" -> "/run/booted-system") ("/var/guix/gcroots/current-system" -> "/run/current-system") ("/var/guix/gcroots/profiles" -> "/var/guix/profiles") (directory "/bin") (directory "/tmp" 0 0 #o1777) ; sticky bit (directory "/var/tmp" 0 0 #o1777) (directory "/var/lock" 0 0 #o1777) (directory "/home" 0 0))) (define* (populate-root-file-system system target #:key (extras '())) "Make the essential non-store files and directories on TARGET. This includes /etc, /var, /run, /bin/sh, etc., and all the symlinks to SYSTEM. EXTRAS is a list of directives appended to the built-in directives to populate TARGET." ;; It's expected that some symbolic link targets do not exist yet, so do not ;; error on dangling links. (for-each (cut evaluate-populate-directive <> target #:error-on-dangling-symlink? #f) (append (directives (%store-directory)) extras)) ;; Add system generation 1. (let ((generation-1 (string-append target "/var/guix/profiles/system-1-link"))) (let try () (catch 'system-error (lambda () (symlink system generation-1)) (lambda args ;; If GENERATION-1 already exists, overwrite it. (if (= EEXIST (system-error-errno args)) (begin (delete-file generation-1) (try)) (apply throw args))))))) (define %root-profile "/var/guix/profiles/per-user/root") (define* (install-database-and-gc-roots root database profile #:key (profile-name "guix-profile")) "Install DATABASE, the store database, under directory ROOT. Create PROFILE-NAME and have it link to PROFILE, a store item." (define (scope file) (string-append root "/" file)) (define (mkdir-p* dir) (mkdir-p (scope dir))) (define (symlink* old new) (symlink old (scope new))) (install-file database (scope "/var/guix/db/")) (chmod (scope "/var/guix/db/db.sqlite") #o644) (mkdir-p* "/var/guix/profiles") (mkdir-p* "/var/guix/gcroots") (symlink* "/var/guix/profiles" "/var/guix/gcroots/profiles") ;; Make root's profile, which makes it a GC root. (mkdir-p* %root-profile) (symlink* profile (string-append %root-profile "/" profile-name "-1-link")) (symlink* (string-append profile-name "-1-link") (string-append %root-profile "/" profile-name))) (define* (populate-single-profile-directory directory #:key profile closure (profile-name "guix-profile") database) "Populate DIRECTORY with a store containing PROFILE, whose closure is given in the file called CLOSURE (as generated by #:references-graphs.) DIRECTORY is initialized to contain a single profile under /root pointing to PROFILE. When DATABASE is true, copy it to DIRECTORY/var/guix/db and create DIRECTORY/var/guix/gcroots and friends. PROFILE-NAME is the name of the profile being created under /var/guix/profiles, typically either \"guix-profile\" or \"current-guix\". This is used to create the self-contained tarballs with 'guix pack'." (define (scope file) (string-append directory "/" file)) (define (mkdir-p* dir) (mkdir-p (scope dir))) (define (symlink* old new) (symlink old (scope new))) ;; Populate the store. (populate-store (list closure) directory #:deduplicate? #f) (when database (install-database-and-gc-roots directory database profile #:profile-name profile-name)) (match profile-name ("guix-profile" (mkdir-p* "/root") (symlink* (string-append %root-profile "/guix-profile") "/root/.guix-profile")) ("current-guix" (mkdir-p* "/root/.config/guix") (symlink* (string-append %root-profile "/current-guix") "/root/.config/guix/current")) (_ #t))) (define (mount-cow-store target backing-directory) "Make the store copy-on-write, using TARGET as the backing store. This is useful when TARGET is on a hard disk, whereas the current store is on a RAM disk." (define (set-store-permissions directory) "Set the right perms on DIRECTORY to use it as the store." (chown directory 0 30000) ;use the fixed 'guixbuild' GID (chmod directory #o1775)) (let ((tmpdir (string-append target "/tmp"))) (mkdir-p tmpdir) (mount tmpdir "/tmp" "none" MS_BIND)) (let* ((rw-dir (string-append target backing-directory)) (work-dir (string-append rw-dir "/../.overlayfs-workdir"))) (mkdir-p rw-dir) (mkdir-p work-dir) (mkdir-p "/.rw-store") (set-store-permissions rw-dir) (set-store-permissions "/.rw-store") ;; Mount the overlay, then atomically make it the store. (mount "none" "/.rw-store" "overlay" 0 (string-append "lowerdir=" (%store-directory) "," "upperdir=" rw-dir "," "workdir=" work-dir)) (mount "/.rw-store" (%store-directory) "" MS_MOVE) (rmdir "/.rw-store"))) (define (umount* directory) "Unmount DIRECTORY, but retry a few times upon EBUSY." (let loop ((attempts 5)) (catch 'system-error (lambda () (umount directory)) (lambda args (if (and (= EBUSY (system-error-errno args)) (> attempts 0)) (begin (sleep 1) (loop (- attempts 1))) (apply throw args)))))) (define (unmount-cow-store target backing-directory) "Unmount copy-on-write store." (let ((tmp-dir "/remove")) (mkdir-p tmp-dir) (mount (%store-directory) tmp-dir "" MS_MOVE) ;; We might get EBUSY at this point, possibly because of lingering ;; processes with open file descriptors. Use 'umount*' to retry upon ;; EBUSY, leaving a bit of time. See <https://issues.guix.gnu.org/59884>. (umount* tmp-dir) (rmdir tmp-dir) (delete-file-recursively (string-append target backing-directory)))) ;;; install.scm ends here
generated by cgit