Introducing ‘guix pack’

[Ludovic Courtès]

Hello Guix!

I had it on my to-do list and Andy said he’d like to have something like
that to publish Guile 2.2 binaries: the ‘guix pack’ command below is a
generalization of the code that builds the Guix binary tarball¹.  It
creates a bundle of the closure of the given packages, with a profile
containing all the packages.

Examples:

--8<---------------cut here---------------start------------->8---
$ ./pre-inst-env guix pack guile-next
/gnu/store/c2brwnrx0066lvf1d9hg82lvb1wkmd78-tarball.tar.lz
$ ./pre-inst-env guix pack guile-next guix
/gnu/store/kc6bxqwrf9z2vvxwndhw8s39s39h5mz6-tarball.tar.lz
$ tar tvf /gnu/store/kc6bxqwrf9z2vvxwndhw8s39s39h5mz6-tarball.tar.lz|grep 
/bin/gui[lx]
-r-xr-xr-x root/root      2974 1970-01-01 01:00 
./gnu/store/060piiiz4nmb51jc3wk01bgikajrnfjd-guile-2.0.13/bin/guild
-r-xr-xr-x root/root     13472 1970-01-01 01:00 
./gnu/store/060piiiz4nmb51jc3wk01bgikajrnfjd-guile-2.0.13/bin/guile
-r-xr-xr-x root/root      7008 1970-01-01 01:00 
./gnu/store/060piiiz4nmb51jc3wk01bgikajrnfjd-guile-2.0.13/bin/guile-config
-r-xr-xr-x root/root      3050 1970-01-01 01:00 
./gnu/store/060piiiz4nmb51jc3wk01bgikajrnfjd-guile-2.0.13/bin/guile-snarf
lrwxrwxrwx root/root         0 1970-01-01 01:00 
./gnu/store/060piiiz4nmb51jc3wk01bgikajrnfjd-guile-2.0.13/bin/guile-tools -> 
guild
-r-xr-xr-x root/root      2978 1970-01-01 01:00 
./gnu/store/62hqgi4cac0f70v1ycsvv985fl3l1hzr-guile-next-2.1.7/bin/guild
-r-xr-xr-x root/root     12784 1970-01-01 01:00 
./gnu/store/62hqgi4cac0f70v1ycsvv985fl3l1hzr-guile-next-2.1.7/bin/guile
-r-xr-xr-x root/root      7022 1970-01-01 01:00 
./gnu/store/62hqgi4cac0f70v1ycsvv985fl3l1hzr-guile-next-2.1.7/bin/guile-config
-r-xr-xr-x root/root      3072 1970-01-01 01:00 
./gnu/store/62hqgi4cac0f70v1ycsvv985fl3l1hzr-guile-next-2.1.7/bin/guile-snarf
lrwxrwxrwx root/root         0 1970-01-01 01:00 
./gnu/store/62hqgi4cac0f70v1ycsvv985fl3l1hzr-guile-next-2.1.7/bin/guile-tools 
-> guild
-r-xr-xr-x root/root       744 1970-01-01 01:00 
./gnu/store/6xlybn33znrp4nyvy39wbrwjrl8l9qnd-guix-0.12.0-5.1162/bin/guix
-r-xr-xr-x root/root    933120 1970-01-01 01:00 
./gnu/store/6xlybn33znrp4nyvy39wbrwjrl8l9qnd-guix-0.12.0-5.1162/bin/guix-daemon
lrwxrwxrwx root/root         0 1970-01-01 01:00 
./gnu/store/ynafk7v924xil993dqbx4mxxnm9ifsi6-profile/bin/guild -> 
/gnu/store/62hqgi4cac0f70v1ycsvv985fl3l1hzr-guile-next-2.1.7/bin/guild
lrwxrwxrwx root/root         0 1970-01-01 01:00 
./gnu/store/ynafk7v924xil993dqbx4mxxnm9ifsi6-profile/bin/guile -> 
/gnu/store/62hqgi4cac0f70v1ycsvv985fl3l1hzr-guile-next-2.1.7/bin/guile
lrwxrwxrwx root/root         0 1970-01-01 01:00 
./gnu/store/ynafk7v924xil993dqbx4mxxnm9ifsi6-profile/bin/guile-config -> 
/gnu/store/62hqgi4cac0f70v1ycsvv985fl3l1hzr-guile-next-2.1.7/bin/guile-config
lrwxrwxrwx root/root         0 1970-01-01 01:00 
./gnu/store/ynafk7v924xil993dqbx4mxxnm9ifsi6-profile/bin/guile-snarf -> 
/gnu/store/62hqgi4cac0f70v1ycsvv985fl3l1hzr-guile-next-2.1.7/bin/guile-snarf
lrwxrwxrwx root/root         0 1970-01-01 01:00 
./gnu/store/ynafk7v924xil993dqbx4mxxnm9ifsi6-profile/bin/guile-tools -> 
/gnu/store/62hqgi4cac0f70v1ycsvv985fl3l1hzr-guile-next-2.1.7/bin/guile-tools
lrwxrwxrwx root/root         0 1970-01-01 01:00 
./gnu/store/ynafk7v924xil993dqbx4mxxnm9ifsi6-profile/bin/guix -> 
/gnu/store/6xlybn33znrp4nyvy39wbrwjrl8l9qnd-guix-0.12.0-5.1162/bin/guix
lrwxrwxrwx root/root         0 1970-01-01 01:00 
./gnu/store/ynafk7v924xil993dqbx4mxxnm9ifsi6-profile/bin/guix-daemon -> 
/gnu/store/6xlybn33znrp4nyvy39wbrwjrl8l9qnd-guix-0.12.0-5.1162/bin/guix-daemon
--8<---------------cut here---------------end--------------->8---

Andy, does this correspond to what you have in mind?

I’d like to move support for Docker (currently in ‘guix archive’) to
this new command because I think it’s more appropriate: ‘guix archive’
is supposed to be rather low-level so it would not create a profile, for
instance.

Ricardo, WDYT?

If there are no objections, I’d like to commit it soonish.

Thanks!

Ludo’.

¹ https://git.savannah.gnu.org/cgit/guix.git/tree/gnu/system/install.scm#n52

;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2015, 2017 Ludovic Courtès <address@hidden>
;;;
;;; 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 (guix scripts pack)
  #:use-module (guix scripts)
  #:use-module (guix ui)
  #:use-module (guix gexp)
  #:use-module (guix utils)
  #:use-module (guix store)
  #:use-module (guix grafts)
  #:use-module (guix monads)
  #:use-module (guix profiles)
  #:use-module (guix derivations)
  #:use-module (guix scripts build)
  #:use-module (gnu packages)
  #:autoload   (gnu packages compression) (lzip)
  #:autoload   (gnu packages base) (tar)
  #:autoload   (gnu packages package-management) (guix)
  #:use-module (srfi srfi-1)
  #:use-module (srfi srfi-37)
  #:use-module (ice-9 match)
  #:export (guix-pack))

(define* (self-contained-tarball name profile
                                 #:key deduplicate?)
  "Return a self-contained tarball containing a store initialized with the
closure of PROFILE, a derivation.  The tarball contains /gnu/store, /var/guix,
and PROFILE is available as /root/.guix-profile."
  (define build
    (with-imported-modules '((guix build utils)
                             (guix build store-copy)
                             (gnu build install))
      #~(begin
          (use-modules (guix build utils)
                       (gnu build install))

          (define %root "root")

          ;; We need Guix here for 'guix-register'.
          (setenv "PATH"
                  (string-append #$guix "/sbin:" #$tar "/bin:" #$lzip "/bin"))

          ;; Note: there is not much to gain here with deduplication and
          ;; there is the overhead of the '.links' directory, so turn it
          ;; off.
          (populate-single-profile-directory %root
                                             #:profile #$profile
                                             #:closure "profile"
                                             #:deduplicate? #f)

          ;; Create the tarball.  Use GNU format so there's no file name
          ;; length limitation.
          (with-directory-excursion %root
            (zero? (system* "tar" "--lzip" "--format=gnu"

                            ;; Avoid non-determinism in the archive.  Use
                            ;; mtime = 1, not zero, because that is what the
                            ;; daemon does for files in the store (see the
                            ;; 'mtimeStore' constant in local-store.cc.)
                            "--sort=name"
                            "address@hidden"          ;for files in /var/guix
                            "--owner=root:0"
                            "--group=root:0"

                            "--check-links"
                            "-cvf" #$output
                            ;; Avoid adding / and /var to the tarball, so
                            ;; that the ownership and permissions of those
                            ;; directories will not be overwritten when
                            ;; extracting the archive.  Do not include /root
                            ;; because the root account might have a
                            ;; different home directory.
                            "./var/guix"
                            (string-append "." (%store-directory))))))))

  (gexp->derivation name build
                    #:references-graphs `(("profile" ,profile))))



;;;
;;; Command-line options.
;;;

(define %default-options
  ;; Alist of default option values.
  `((system . ,(%current-system))
    (substitutes? . #t)
    (graft? . #t)
    (max-silent-time . 3600)
    (verbosity . 0)))

(define %options
  ;; Specifications of the command-line options.
  (cons* (option '(#\h "help") #f #f
                 (lambda args
                   (show-help)
                   (exit 0)))
         (option '(#\V "version") #f #f
                 (lambda args
                   (show-version-and-exit "guix pack")))

         (option '(#\n "dry-run") #f #f
                 (lambda (opt name arg result)
                   (alist-cons 'dry-run? #t (alist-cons 'graft? #f result))))

         %standard-build-options))

(define (show-help)
  (display (_ "Usage: guix pack [OPTION]... PACKAGE...
Create a bundle of PACKAGE.\n"))
  (show-build-options-help)

  (newline)
  (display (_ "
  -h, --help             display this help and exit"))
  (display (_ "
  -V, --version          display version information and exit"))
  (newline)
  (show-bug-report-information))


;;;
;;; Entry point.
;;;

(define (guix-pack . args)
  (define opts
    (parse-command-line args %options (list %default-options)))

  (with-error-handling
    (parameterize ((%graft? (assoc-ref opts 'graft?)))
      (let* ((dry-run? (assoc-ref opts 'dry-run?))
             (specs    (filter-map (match-lambda
                                     (('argument . name)
                                      name)
                                     (x #f))
                                   opts))
             (packages (map (lambda (spec)
                              (call-with-values
                                  (lambda ()
                                    (specification->package+output spec))
                                list))
                            specs)))
        (with-store store
          (run-with-store store
            (mlet* %store-monad ((profile (profile-derivation
                                           (packages->manifest packages)))
                                 (drv (self-contained-tarball "tarball.tar.lz"
                                                              profile)))
              (mbegin %store-monad
                (show-what-to-build* (list drv)
                                     #:use-substitutes?
                                     (assoc-ref opts 'substitutes?)
                                     #:dry-run? dry-run?)
                (munless dry-run?
                  (built-derivations (list drv))
                  (return (format #t "~a~%"
                                  (derivation->output-path drv))))))))))))

signature.asc
Description: PGP signature