me/guix
Archived
1
0
Fork 0
Code Activity

install: Add 'install-database-and-gc-roots'.

Browse source 
* gnu/build/install.scm (%root-profile): New variable.
(install-database-and-gc-roots): New procedure.
(populate-single-profile-directory): Replace inline code with a call to
'install-database-and-gc-roots'.
This commit is contained in:
Ludovic Courtès 2018-11-03 23:01:44 +01:00
parent b27ef1d46c
commit c5ce2db569
No known key found for this signature in database
GPG key ID: 090B11993D9AEBB5
1 changed files with 32 additions and 16 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

48
gnu/build/install.scm
View file

@ -26,6 +26,7 @@
evaluate-populate-directive evaluate-populate-directive
populate-root-file-system populate-root-file-system
register-closure register-closure
install-database-and-gc-roots
populate-single-profile-directory)) populate-single-profile-directory))
;;; Commentary: ;;; Commentary:
@ -140,6 +141,35 @@ includes /etc, /var, /run, /bin/sh, etc., and all the symlinks to SYSTEM."
(try)) (try))
(apply throw args))))))) (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 (define* (populate-single-profile-directory directory
#:key profile closure #:key profile closure
(profile-name "guix-profile") (profile-name "guix-profile")
@ -158,9 +188,6 @@ This is used to create the self-contained tarballs with 'guix pack'."
(define (scope file) (define (scope file)
(string-append directory "/" file)) (string-append directory "/" file))
(define %root-profile
"/var/guix/profiles/per-user/root")
(define (mkdir-p* dir) (define (mkdir-p* dir)
(mkdir-p (scope dir))) (mkdir-p (scope dir)))
@ -171,19 +198,8 @@ This is used to create the self-contained tarballs with 'guix pack'."
(populate-store (list closure) directory) (populate-store (list closure) directory)
(when database (when database
(install-file database (scope "/var/guix/db/")) (install-database-and-gc-roots directory database profile
(chmod (scope "/var/guix/db/db.sqlite") #o644) #:profile-name profile-name))
(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))
(match profile-name (match profile-name
("guix-profile" ("guix-profile"