From mboxrd@z Thu Jan 1 00:00:00 1970 From: David Thompson Subject: Re: Reproducible profiles Date: Mon, 18 May 2015 17:07:35 -0400 Message-ID: <87egmd8ui0.fsf@fsf.org> References: <87pp62iqmn.fsf@fsf.org> Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" Return-path: Received: from eggs.gnu.org ([2001:4830:134:3::10]:38359) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1YuSGJ-0007Vq-Tw for guix-devel@gnu.org; Mon, 18 May 2015 17:07:49 -0400 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1YuSGH-0004Kn-UJ for guix-devel@gnu.org; Mon, 18 May 2015 17:07:47 -0400 Received: from mail.fsf.org ([208.118.235.13]:47446) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1YuSGH-0004Kg-PV for guix-devel@gnu.org; Mon, 18 May 2015 17:07:45 -0400 Received: from jumpgate.fsf.org ([74.94.156.211]:52950 helo=izanagi) by mail.fsf.org with esmtpsa (TLS-1.0:RSA_AES_128_CBC_SHA1:16) (Exim 4.69) (envelope-from ) id 1YuSGH-0001gk-0o for guix-devel@gnu.org; Mon, 18 May 2015 17:07:45 -0400 In-Reply-To: <87pp62iqmn.fsf@fsf.org> List-Id: "Development of GNU Guix and the GNU System distribution." List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guix-devel-bounces+gcggd-guix-devel=m.gmane.org@gnu.org Sender: guix-devel-bounces+gcggd-guix-devel=m.gmane.org@gnu.org To: guix-devel@gnu.org --=-=-= Content-Type: text/plain Below is a new patch set taking into account the feedback received thus far. The (guix profiles) module still needs to be documented in the manual, but there's quite a lot of procedures and variables to account for. Would anyone be intertested in helping with this part? --=-=-= Content-Type: text/x-diff Content-Disposition: inline; filename=0001-ui-Factorize-user-provided-Scheme-file-loading.patch >From d506ad1d8824cc694364be502acddb25b76d0020 Mon Sep 17 00:00:00 2001 From: David Thompson Date: Mon, 18 May 2015 07:49:44 -0400 Subject: [PATCH 1/3] ui: Factorize user-provided Scheme file loading. * guix/ui.scm (make-user-module, read-scheme-file): New procedures. * guix/scripts/system.scm (%user-module): Define in terms of 'make-user-module'. (read-operating-system): Define in terms of 'read-scheme-file'. --- guix/scripts/system.scm | 22 ++++------------------ guix/ui.scm | 24 ++++++++++++++++++++++++ 2 files changed, 28 insertions(+), 18 deletions(-) diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm index 1838e89..2d7c5d1 100644 --- a/guix/scripts/system.scm +++ b/guix/scripts/system.scm @@ -48,28 +48,14 @@ (define %user-module ;; Module in which the machine description file is loaded. - (let ((module (make-fresh-user-module))) - (for-each (lambda (iface) - (module-use! module (resolve-interface iface))) - '((gnu system) - (gnu services) - (gnu system shadow))) - module)) + (make-user-module '((gnu system) + (gnu services) + (gnu system shadow)))) (define (read-operating-system file) "Read the operating-system declaration from FILE and return it." - ;; TODO: Factorize. - (catch #t - (lambda () - ;; Avoid ABI incompatibility with the record. - (set! %fresh-auto-compile #t) + (read-scheme-file file %user-module)) - (save-module-excursion - (lambda () - (set-current-module %user-module) - (primitive-load file)))) - (lambda args - (report-load-error file args)))) ;;; diff --git a/guix/ui.scm b/guix/ui.scm index 911e5ee..5a76cf4 100644 --- a/guix/ui.scm +++ b/guix/ui.scm @@ -48,6 +48,8 @@ P_ report-error leave + make-user-module + read-scheme-file report-load-error warn-about-load-error show-version-and-exit @@ -133,6 +135,28 @@ messages." (report-error args ...) (exit 1))) +(define (make-user-module modules) + "Return a new user module with the additional MODULES loaded." + ;; Module in which the machine description file is loaded. + (let ((module (make-fresh-user-module))) + (for-each (lambda (iface) + (module-use! module (resolve-interface iface))) + modules) + module)) + +(define (read-scheme-file file user-module) + "Read the user provided Scheme source code FILE." + (catch #t + (lambda () + (set! %fresh-auto-compile #t) + + (save-module-excursion + (lambda () + (set-current-module user-module) + (primitive-load file)))) + (lambda args + (report-load-error file args)))) + (define (report-load-error file args) "Report the failure to load FILE, a user-provided Scheme file, and exit. ARGS is the list of arguments received by the 'throw' handler." -- 2.1.4 --=-=-= Content-Type: text/x-diff Content-Disposition: inline; filename=0002-profiles-Add-packages-manifest-procedure.patch >From 5665da9934726ce0a8c4ed358b7f606d917c300a Mon Sep 17 00:00:00 2001 From: David Thompson Date: Mon, 18 May 2015 07:51:56 -0400 Subject: [PATCH 2/3] profiles: Add 'packages->manifest' procedure. * guix/profiles.scm (packages->manifest): New procedure. --- guix/profiles.scm | 11 +++++++++++ 1 file changed, 11 insertions(+) diff --git a/guix/profiles.scm b/guix/profiles.scm index 11d9bf0..cbc8a9a 100644 --- a/guix/profiles.scm +++ b/guix/profiles.scm @@ -80,6 +80,7 @@ profile-manifest package->manifest-entry + packages->manifest %default-profile-hooks profile-derivation generation-number @@ -172,6 +173,16 @@ omitted or #f, use the first output of PACKAGE." (dependencies (delete-duplicates deps)) (search-paths (package-native-search-paths package))))) +(define (packages->manifest packages) + "Convert PACKAGES into a manifest containing entries for all of them." + (manifest + (map (match-lambda + ((package output) + (package->manifest-entry package output)) + (package + (package->manifest-entry package))) + packages))) + (define (manifest->gexp manifest) "Return a representation of MANIFEST as a gexp." (define (entry->gexp entry) -- 2.1.4 --=-=-= Content-Type: text/x-diff Content-Disposition: inline; filename=0003-package-Add-manifest-option.patch >From 3be657353bfebc33dc9733b820165699ac07b43d Mon Sep 17 00:00:00 2001 From: David Thompson Date: Thu, 14 May 2015 21:11:57 -0400 Subject: [PATCH 3/3] package: Add --manifest option. * guix/scripts/package.scm (show-help): Add help text. (%options): Add manifest option. (guix-package): Add manifest option handler. * doc/guix.texi ("Invoking guix package"): Document it. * tests/guix-package.sh: Add test. --- doc/guix.texi | 17 ++++++++ guix/scripts/package.scm | 107 ++++++++++++++++++++++++++++------------------- tests/guix-package.sh | 10 +++++ 3 files changed, 90 insertions(+), 44 deletions(-) diff --git a/doc/guix.texi b/doc/guix.texi index 049292d..ca5f82d 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -1057,6 +1057,23 @@ substring ``emacs'': $ guix package --upgrade . --do-not-upgrade emacs @end example +@item --manifest=@var{file} +@itemx -m @var{file} +Create a new @dfn{generation} of the profile from the manifest object +contained in @var{file}, a Scheme source code file. + +A manifest file may look like this: + +@example +(use-package-modules guile emacs gcc) + +(packages->manifest + (list guile-2.0 + emacs + ;; Use a specific package output. + (list gcc "debug"))) +@end example + @item --roll-back Roll back to the previous @dfn{generation} of the profile---i.e., undo the last transaction. diff --git a/guix/scripts/package.scm b/guix/scripts/package.scm index 15f3e13..f2ca663 100644 --- a/guix/scripts/package.scm +++ b/guix/scripts/package.scm @@ -426,6 +426,9 @@ Install, remove, or upgrade PACKAGES in a single transaction.\n")) (display (_ " -u, --upgrade[=REGEXP] upgrade all the installed packages matching REGEXP")) (display (_ " + -m, --manifest=FILE create a new profile generation with the manifest + contained within FILE.")) + (display (_ " --do-not-upgrade[=REGEXP] do not upgrade any packages matching REGEXP")) (display (_ " --roll-back roll back to the previous generation")) @@ -517,6 +520,10 @@ Install, remove, or upgrade PACKAGES in a single transaction.\n")) (lambda (opt name arg result arg-handler) (values (alist-cons 'roll-back? #t result) #f))) + (option '(#\m "manifest") #t #f + (lambda (opt name arg result arg-handler) + (values (alist-cons 'manifest arg result) + arg-handler))) (option '(#\l "list-generations") #f #t (lambda (opt name arg result arg-handler) (values (cons `(query list-generations ,(or arg "")) @@ -783,6 +790,50 @@ more information.~%")) (define dry-run? (assoc-ref opts 'dry-run?)) (define profile (assoc-ref opts 'profile)) + (define (build-and-use-profile manifest) + (let* ((bootstrap? (assoc-ref opts 'bootstrap?))) + + (when (equal? profile %current-profile) + (ensure-default-profile)) + + (let* ((prof-drv (run-with-store (%store) + (profile-derivation + manifest + #:hooks (if bootstrap? + '() + %default-profile-hooks)))) + (prof (derivation->output-path prof-drv))) + (show-what-to-build (%store) (list prof-drv) + #:use-substitutes? + (assoc-ref opts 'substitutes?) + #:dry-run? dry-run?) + + (cond + (dry-run? #t) + ((and (file-exists? profile) + (and=> (readlink* profile) (cut string=? prof <>))) + (format (current-error-port) (_ "nothing to be done~%"))) + (else + (let* ((number (generation-number profile)) + + ;; Always use NUMBER + 1 for the new profile, + ;; possibly overwriting a "previous future + ;; generation". + (name (generation-file-name profile + (+ 1 number)))) + (and (build-derivations (%store) (list prof-drv)) + (let* ((entries (manifest-entries manifest)) + (count (length entries))) + (switch-symlinks name prof) + (switch-symlinks profile name) + (unless (string=? profile %current-profile) + (register-gc-root (%store) name)) + (format #t (N_ "~a package in profile~%" + "~a packages in profile~%" + count) + count) + (display-search-paths entries profile))))))))) + ;; First roll back if asked to. (cond ((and (assoc-ref opts 'roll-back?) (not dry-run?)) @@ -817,60 +868,28 @@ more information.~%")) (alist-delete 'delete-generations opts))) (_ #f)) opts)) + ((and (assoc-ref opts 'manifest) + (not dry-run?)) + (let* ((file-name (assoc-ref opts 'manifest)) + (user-module (make-user-module '((guix profiles) + (gnu)))) + (manifest (read-scheme-file file-name user-module))) + (format #t (_ "installing new manifest from ~a with ~d entries.~%") + file-name (length (manifest-entries manifest))) + (build-and-use-profile manifest))) (else (let* ((manifest (profile-manifest profile)) (install (options->installable opts manifest)) (remove (options->removable opts manifest)) - (bootstrap? (assoc-ref opts 'bootstrap?)) (transaction (manifest-transaction (install install) (remove remove))) (new (manifest-perform-transaction manifest transaction))) - (when (equal? profile %current-profile) - (ensure-default-profile)) - (unless (and (null? install) (null? remove)) - (let* ((prof-drv (run-with-store (%store) - (profile-derivation - new - #:hooks (if bootstrap? - '() - %default-profile-hooks)))) - (prof (derivation->output-path prof-drv))) - (show-manifest-transaction (%store) manifest transaction - #:dry-run? dry-run?) - (show-what-to-build (%store) (list prof-drv) - #:use-substitutes? - (assoc-ref opts 'substitutes?) - #:dry-run? dry-run?) - - (cond - (dry-run? #t) - ((and (file-exists? profile) - (and=> (readlink* profile) (cut string=? prof <>))) - (format (current-error-port) (_ "nothing to be done~%"))) - (else - (let* ((number (generation-number profile)) - - ;; Always use NUMBER + 1 for the new profile, - ;; possibly overwriting a "previous future - ;; generation". - (name (generation-file-name profile - (+ 1 number)))) - (and (build-derivations (%store) (list prof-drv)) - (let* ((entries (manifest-entries new)) - (count (length entries))) - (switch-symlinks name prof) - (switch-symlinks profile name) - (unless (string=? profile %current-profile) - (register-gc-root (%store) name)) - (format #t (N_ "~a package in profile~%" - "~a packages in profile~%" - count) - count) - (display-search-paths entries - profile)))))))))))) + (show-manifest-transaction (%store) manifest transaction + #:dry-run? dry-run?) + (build-and-use-profile new)))))) (define (process-query opts) ;; Process any query specified by OPTS. Return #t when a query was diff --git a/tests/guix-package.sh b/tests/guix-package.sh index a732110..4591333 100644 --- a/tests/guix-package.sh +++ b/tests/guix-package.sh @@ -237,3 +237,13 @@ export GUIX_BUILD_OPTIONS available2="`guix package -A | sort`" test "$available2" = "$available" guix package -I + +unset GUIX_BUILD_OPTIONS + +# Applying a manifest file +cat > "$module_dir/manifest.scm"<manifest (list %bootstrap-guile)) +EOF +guix package --bootstrap -m "$module_dir/manifest.scm" -- 2.1.4 --=-=-= Content-Type: text/plain -- David Thompson GPG Key: 0FF1D807 --=-=-=--