From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: from mp0 ([2001:41d0:2:bcc0::]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits)) by ms0.migadu.com with LMTPS id yH1iHyYN1GDgRAAAgWs5BA (envelope-from ) for ; Thu, 24 Jun 2021 06:42:14 +0200 Received: from aspmx1.migadu.com ([2001:41d0:2:bcc0::]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits)) by mp0 with LMTPS id 8P+VGiYN1GASTQAA1q6Kng (envelope-from ) for ; Thu, 24 Jun 2021 04:42:14 +0000 Received: from lists.gnu.org (lists.gnu.org [209.51.188.17]) (using TLSv1.2 with cipher ECDHE-RSA-AES256-GCM-SHA384 (256/256 bits)) (No client certificate requested) by aspmx1.migadu.com (Postfix) with ESMTPS id 3CA2920E50 for ; Thu, 24 Jun 2021 06:42:13 +0200 (CEST) Received: from localhost ([::1]:49176 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1lwHBs-00060z-5l for larch@yhetil.org; Thu, 24 Jun 2021 00:42:12 -0400 Received: from eggs.gnu.org ([2001:470:142:3::10]:56980) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1lwHBk-0005yx-Ke for guix-patches@gnu.org; Thu, 24 Jun 2021 00:42:04 -0400 Received: from debbugs.gnu.org ([209.51.188.43]:58872) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1lwHBk-0002yI-D0 for guix-patches@gnu.org; Thu, 24 Jun 2021 00:42:04 -0400 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1lwHBk-0002RH-BL for guix-patches@gnu.org; Thu, 24 Jun 2021 00:42:04 -0400 X-Loop: help-debbugs@gnu.org Subject: [bug#49149] [PATCH v2 7/7] pack: Add support for the deb format. Resent-From: Maxim Cournoyer Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Thu, 24 Jun 2021 04:42:04 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 49149 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: patch To: 49149@debbugs.gnu.org Cc: Maxim Cournoyer Received: via spool by 49149-submit@debbugs.gnu.org id=B49149.16245096989295 (code B ref 49149); Thu, 24 Jun 2021 04:42:04 +0000 Received: (at 49149) by debbugs.gnu.org; 24 Jun 2021 04:41:38 +0000 Received: from localhost ([127.0.0.1]:42179 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1lwHBJ-0002Pr-PS for submit@debbugs.gnu.org; Thu, 24 Jun 2021 00:41:38 -0400 Received: from mail-qk1-f181.google.com ([209.85.222.181]:34455) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1lwHB3-0002O7-Hw for 49149@debbugs.gnu.org; Thu, 24 Jun 2021 00:41:23 -0400 Received: by mail-qk1-f181.google.com with SMTP id g4so11279929qkl.1 for <49149@debbugs.gnu.org>; Wed, 23 Jun 2021 21:41:21 -0700 (PDT) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gmail.com; s=20161025; h=from:to:cc:subject:date:message-id:in-reply-to:references :mime-version:content-transfer-encoding; bh=Rls3Hb6sj4/2cHidCCg+vAj3YdiwdkeQFPh8443keHo=; b=TWz7pci1VkeZtC2G0nAGxBxPeT+8t7aThlwAacMyuEFIDzfhLihfOhEEGOMOFG8NeA d9SyTW7iWvObuqoeQk7xOLyqZ/ggrVbC2tXAlwyzaDnw0u13wQWZ3MEzi59WvRmFlDdq HwtY5B0apG1CtfADSEBArnT2uNZFYHTy6lQA5UXLAd6qO3/B1twic2CpfKfmSbeOLbzp SvfTQvcnILJgJXgFJl/rgjPsjc0EzpA4Ekio8C4lpFzlcySnjrUrTrgD2u5oC4XGGHRk dyG1bbHb8w0ISrr8Kr/xMI98r8SDBfxryCKqaEcJO9d9dwgtGbe6WH2rP1giH6K+KLrN xhAA== X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20161025; h=x-gm-message-state:from:to:cc:subject:date:message-id:in-reply-to :references:mime-version:content-transfer-encoding; bh=Rls3Hb6sj4/2cHidCCg+vAj3YdiwdkeQFPh8443keHo=; b=RlSdTla+JuI5MzC7xwxkxkg1Sl+cZ323vqXuVgfXEtqg+RkjB7QntluJZccxCZ6Iv4 bXL81NiHFPGfEP3xYw7BkC+z0+lwakRlc4HpNh7nx43sFgue0Vb4eRnKrlwL7yRy/sU1 dc8pGqmNSU+zZzE0txDnMRB+C3c3Gr07Qxn3c2wgQ8dFWvubOsm7uH1yQ1CdLTLXiwvb evQgSoIQRL2JOxsKNDActQ/KVDfl8PwBM80XqWGz04H6iz2PgCOFaoqKneLRlIy/Y2Y1 Vnu0OxfZnwPw6AYXajnGDcaWcSkRwDD3G1PUF4Q1c2FC42dZcLITq+/mN7VyaueYRcwR 7uZg== X-Gm-Message-State: AOAM533pcmWfcf+qcp+tjeYWJ2N4gwWiTHGJjNouNCsWJU8zj+zqBqN1 /kF1rraOWe6EWZL8nZDM5TD/mITQfFq9GA== X-Google-Smtp-Source: ABdhPJzi/yW3mJhpPvugsQYfrh90K38WH2k1GGNyNf860qFKgb7l+KF8alMk8Voha68DC1CcV6SdJA== X-Received: by 2002:a37:620f:: with SMTP id w15mr3788651qkb.99.1624509676051; Wed, 23 Jun 2021 21:41:16 -0700 (PDT) Received: from localhost.localdomain ([207.35.95.2]) by smtp.gmail.com with ESMTPSA id q199sm1603880qka.112.2021.06.23.21.41.15 (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256); Wed, 23 Jun 2021 21:41:15 -0700 (PDT) From: Maxim Cournoyer Date: Thu, 24 Jun 2021 00:40:49 -0400 Message-Id: <20210624044049.17906-7-maxim.cournoyer@gmail.com> X-Mailer: git-send-email 2.32.0 In-Reply-To: <20210624044049.17906-1-maxim.cournoyer@gmail.com> References: <20210624044049.17906-1-maxim.cournoyer@gmail.com> MIME-Version: 1.0 Content-Type: text/plain; charset=utf-8 Content-Transfer-Encoding: 8bit X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-BeenThere: guix-patches@gnu.org List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guix-patches-bounces+larch=yhetil.org@gnu.org Sender: "Guix-patches" X-Migadu-Flow: FLOW_IN ARC-Message-Signature: i=1; a=rsa-sha256; c=relaxed/relaxed; d=yhetil.org; s=key1; t=1624509734; h=from:from:sender:sender:reply-to:subject:subject:date:date: message-id:message-id:to:to:cc:cc:mime-version:mime-version: content-type:content-type: content-transfer-encoding:content-transfer-encoding:resent-cc: resent-from:resent-sender:resent-message-id:in-reply-to:in-reply-to: references:references:list-id:list-help:list-unsubscribe: list-subscribe:list-post:dkim-signature; bh=rvdP7oAGJrF7EkssDhTP04C8OnKHCRvHlNracGT7mvg=; b=fkgfyvQ1MZMVlg97hwHD96XIO16nfeLap9TvprNyp+MJfjBRCk3tB0eJG4aw6wHI7hLYVH R/ijqwTJEq6O0H+JPEdQGeLkia4o5qgPxs9PjcWSCeVGooC+h11Qmftzs5z25GNMq3kcue Aj+dCdcKTbPAeSsmupJkT9UtKDELuM7xEskmpo/SaAapF5J8cNtgXGh8wRI5Gds8OfQXeE Xm6O3hGXw1jZUJjHuS9sczpNlFnW7YjZ3sULoqLfd4ujHjBYDxOaZa9c9YZvex51zHzy9U C4cMWEeMvqrQaYdCklqgiLDG/YLUzFVA5rPGhKOZBGugvtkbiXX/TGJKqcPQsA== ARC-Seal: i=1; s=key1; d=yhetil.org; t=1624509734; a=rsa-sha256; cv=none; b=Tg4OgoCxYElKKaOaTNDGS+XdD3xRj+7ejV9UDzErQrDn9g7YHgSoorZ4AbzFYUslct00gK UniMe/c8rBMgF7PhKvEvy8Ye6aqgAo7lEDKI+GymshT4sYniDtrEcTO1112LSV8JgLc/RM ir8utGF4kT7OCkMijQvJPq8+A4jmQ1uD7ICS5B295uj43Zkz+/Exn1jH5+4nRcYe13Ekjm YEAPS/WAKJYNSkxOXO09ve48XHG8Xvfb3PmLe7oPaVgvRFRa2fjaaaf2ShbXJawO3S8oMm 23QD8R8IvqaaI+dJczHq61UdcapHE0VUsiyd+ZQym7cBxeGIGgoXoPSiIvOKVg== ARC-Authentication-Results: i=1; aspmx1.migadu.com; dkim=fail ("body hash did not verify") header.d=gmail.com header.s=20161025 header.b=TWz7pci1; dmarc=fail reason="SPF not aligned (relaxed)" header.from=gmail.com (policy=none); spf=pass (aspmx1.migadu.com: domain of guix-patches-bounces@gnu.org designates 209.51.188.17 as permitted sender) smtp.mailfrom=guix-patches-bounces@gnu.org X-Migadu-Spam-Score: -1.33 Authentication-Results: aspmx1.migadu.com; dkim=fail ("body hash did not verify") header.d=gmail.com header.s=20161025 header.b=TWz7pci1; dmarc=fail reason="SPF not aligned (relaxed)" header.from=gmail.com (policy=none); spf=pass (aspmx1.migadu.com: domain of guix-patches-bounces@gnu.org designates 209.51.188.17 as permitted sender) smtp.mailfrom=guix-patches-bounces@gnu.org X-Migadu-Queue-Id: 3CA2920E50 X-Spam-Score: -1.33 X-Migadu-Scanner: scn0.migadu.com X-TUID: t+JlKl6/Hlb/ * .dir-locals.el (scheme-mode)[gexp->derivation]: Define indentation rule. * guix/scripts/pack.scm (debian-archive): New procedure. (%formats): Register the new deb format. (show-formats): Add it to the usage string. * tests/pack.scm (%ar-bootstrap): New variable. (deb archive with symlinks): New test. * doc/guix.texi (Invoking guix pack): Document it. --- .dir-locals.el | 1 + doc/guix.texi | 5 ++ guix/scripts/pack.scm | 178 +++++++++++++++++++++++++++++++++++++++++- tests/pack.scm | 75 ++++++++++++++++++ 4 files changed, 258 insertions(+), 1 deletion(-) diff --git a/.dir-locals.el b/.dir-locals.el index 8f07a08eb5..a4fcbfe7ca 100644 --- a/.dir-locals.el +++ b/.dir-locals.el @@ -75,6 +75,7 @@ (eval . (put 'origin 'scheme-indent-function 0)) (eval . (put 'build-system 'scheme-indent-function 0)) (eval . (put 'bag 'scheme-indent-function 0)) + (eval . (put 'gexp->derivation 'scheme-indent-function 1)) (eval . (put 'graft 'scheme-indent-function 0)) (eval . (put 'operating-system 'scheme-indent-function 0)) (eval . (put 'file-system 'scheme-indent-function 0)) diff --git a/doc/guix.texi b/doc/guix.texi index 15e8999447..70de6b16ae 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -6025,6 +6025,11 @@ This produces a SquashFS image containing all the specified binaries and symlinks, as well as empty mount points for virtual file systems like procfs. +@item deb +This produces a Debian archive (a package with the @samp{.deb} file +extension) containing all the specified binaries and symlinks, that can +be installed on top of any dpkg-based GNU/Linux distribution. + @quotation Note Singularity @emph{requires} you to provide @file{/bin/sh} in the image. For that reason, @command{guix pack -f squashfs} always implies @code{-S diff --git a/guix/scripts/pack.scm b/guix/scripts/pack.scm index 84f2f14343..7de061d7ae 100644 --- a/guix/scripts/pack.scm +++ b/guix/scripts/pack.scm @@ -6,6 +6,7 @@ ;;; Copyright © 2018 Efraim Flashner ;;; Copyright © 2020 Tobias Geerinckx-Rice ;;; Copyright © 2020 Eric Bavier +;;; Copyright © 2021 Maxim Cournoyer ;;; ;;; This file is part of GNU Guix. ;;; @@ -65,6 +66,7 @@ %compressors lookup-compressor self-contained-tarball + debian-archive docker-image squashfs-image @@ -346,6 +348,10 @@ added to the pack." #:target target #:references-graphs `(("profile" ,profile)))) + +;;; +;;; Singularity. +;;; (define (singularity-environment-file profile) "Return a shell script that defines the environment variables corresponding to the search paths of PROFILE." @@ -372,6 +378,10 @@ to the search paths of PROFILE." (computed-file "singularity-environment.sh" build)) + +;;; +;;; SquashFS image format. +;;; (define* (squashfs-image name profile #:key target (profile-name "guix-profile") @@ -546,6 +556,10 @@ added to the pack." #:target target #:references-graphs `(("profile" ,profile)))) + +;;; +;;; Docker image format. +;;; (define* (docker-image name profile #:key target (profile-name "guix-profile") @@ -633,6 +647,165 @@ the image." #:target target #:references-graphs `(("profile" ,profile)))) + +;;; +;;; Debian archive format. +;;; +;;; TODO: When relocatable option is selected, install to a unique prefix. +;;; This would enable installation of multiple deb packs with conflicting +;;; files at the same time. +;;; TODO: Allow passing a custom control file from the CLI. +;;; TODO: Allow providing a postinst script. +(define* (debian-archive name profile + #:key target + (profile-name "guix-profile") + deduplicate? + entry-point + (compressor (first %compressors)) + localstatedir? + (symlinks '()) + (archiver tar)) + "Return a Debian archive (.deb) containing a store initialized with the +closure of PROFILE, a derivation. The archive contains /gnu/store; if +LOCALSTATEDIR? is true, it also contains /var/guix, including /var/guix/db +with a properly initialized store database. The supported compressors are +\"none\", \"gz\" or \"xz\". + +SYMLINKS must be a list of (SOURCE -> TARGET) tuples denoting symlinks to be +added to the pack." + ;; For simplicity, limit the supported compressors to the superset of + ;; compressors able to compress both the control file (gz or xz) and the + ;; data tarball (gz, bz2 or xz). + (define %valid-compressors '("gzip" "xz" "none")) + + (let ((compressor-name (compressor-name compressor))) + (unless (member compressor-name %valid-compressors) + (leave (G_ "~a is not a valid Debian archive compressor. \ +Valid compressors are: ~a~%") compressor-name %valid-compressors))) + + (when entry-point + (warning (G_ "entry point not supported in the '~a' format~%") + 'deb)) + + (define data-tarball + (computed-file (string-append "data.tar" + (compressor-extension compressor)) + (self-contained-tarball/builder + profile + #:profile-name profile-name + #:compressor compressor + #:localstatedir? localstatedir? + #:symlinks symlinks + #:archiver archiver) + #:local-build? #f ;allow offloading + #:options (list #:references-graphs `(("profile" ,profile)) + #:target target))) + + (define build + (with-extensions (list guile-gcrypt) + (with-imported-modules `(((guix config) => ,(make-config.scm)) + ,@(source-module-closure + `((guix build pack) + (guix build utils) + (guix profiles)) + #:select? not-config?)) + #~(begin + (use-modules (guix build pack) + (guix build utils) + (guix profiles) + (ice-9 match) + (srfi srfi-1)) + + (define machine-type + ;; Extract the machine type from the specified target, else from the + ;; current system. + (and=> (or #$target %host-type) (lambda (triplet) + (first (string-split triplet #\-))))) + + (define (gnu-machine-type->debian-machine-type type) + "Translate machine TYPE from the GNU to Debian terminology." + ;; Debian has its own jargon, different from the one used in GNU, for + ;; machine types (see data/cputable in the sources of dpkg). + (match type + ("i686" "i386") + ("x86_64" "amd64") + ("aarch64" "arm64") + ("mipsisa32r6" "mipsr6") + ("mipsisa32r6el" "mipsr6el") + ("mipsisa64r6" "mips64r6") + ("mipsisa64r6el" "mips64r6el") + ("powerpcle" "powerpcel") + ("powerpc64" "ppc64") + ("powerpc64le" "ppc64el") + (machine machine))) + + (define architecture + (gnu-machine-type->debian-machine-type machine-type)) + + #$(procedure-source manifest->friendly-name) + + (define manifest (profile-manifest #$profile)) + + (define single-entry ;manifest entry + (match (manifest-entries manifest) + ((entry) + entry) + (() #f))) + + (define package-name (or (and=> single-entry manifest-entry-name) + (manifest->friendly-name manifest))) + + (define package-version + (or (and=> single-entry manifest-entry-version) + "0.0.0")) + + (define debian-format-version "2.0") + + ;; Generate the debian-binary file. + (call-with-output-file "debian-binary" + (lambda (port) + (format port "~a~%" debian-format-version))) + + (define data-tarball-file-name (strip-store-file-name + #+data-tarball)) + + (copy-file #+data-tarball data-tarball-file-name) + + (define control-tarball-file-name + (string-append "control.tar" + #$(compressor-extension compressor))) + + ;; Write the compressed control tarball. Only the control file is + ;; mandatory (see: 'man deb' and 'man deb-control'). + (call-with-output-file "control" + (lambda (port) + (format port "\ +Package: ~a +Version: ~a +Description: Debian archive generated by GNU Guix. +Maintainer: GNU Guix +Architecture: ~a +~%" package-name package-version architecture))) + + (define tar (string-append #+archiver "/bin/tar")) + + (apply invoke tar + `(,@(tar-base-options + #:tar tar + #:compressor '#+(and=> compressor compressor-command)) + "-cvf" ,control-tarball-file-name + "control")) + + ;; Create the .deb archive using GNU ar. + (invoke (string-append #+binutils "/bin/ar") "-rv" #$output + "debian-binary" + control-tarball-file-name data-tarball-file-name))))) + + (gexp->derivation (string-append name ".deb") + build + #:target target + #:references-graphs `(("profile" ,profile)))) + ;;; ;;; Compiling C programs. @@ -965,7 +1138,8 @@ last resort for relocation." ;; Supported pack formats. `((tarball . ,self-contained-tarball) (squashfs . ,squashfs-image) - (docker . ,docker-image))) + (docker . ,docker-image) + (deb . ,debian-archive))) (define (show-formats) ;; Print the supported pack formats. @@ -977,6 +1151,8 @@ last resort for relocation." squashfs Squashfs image suitable for Singularity")) (display (G_ " docker Tarball ready for 'docker load'")) + (display (G_ " + deb Debian archive installable via dpkg/apt")) (newline)) (define %options diff --git a/tests/pack.scm b/tests/pack.scm index ae6247a1d5..9473d4f384 100644 --- a/tests/pack.scm +++ b/tests/pack.scm @@ -1,6 +1,7 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2017, 2018, 2019, 2020 Ludovic Courtès ;;; Copyright © 2018 Ricardo Wurmus +;;; Copyright © 2021 Maxim Cournoyer ;;; ;;; This file is part of GNU Guix. ;;; @@ -32,6 +33,7 @@ #:use-module ((gnu packages base) #:select (glibc-utf8-locales)) #:use-module (gnu packages bootstrap) #:use-module ((gnu packages compression) #:select (squashfs-tools)) + #:use-module ((gnu packages debian) #:select (dpkg)) #:use-module ((gnu packages guile) #:select (guile-sqlite3)) #:use-module ((gnu packages gnupg) #:select (guile-gcrypt)) #:use-module (srfi srfi-64)) @@ -56,6 +58,8 @@ (define %tar-bootstrap %bootstrap-coreutils&co) +(define %ar-bootstrap %bootstrap-binutils) + (test-begin "pack") @@ -270,6 +274,77 @@ 1) (pk 'guilelink (readlink "bin")))) (mkdir #$output)))))))) + (built-derivations (list check)))) + + (unless store (test-skip 1)) + (test-assertm "deb archive with symlinks" store + (mlet* %store-monad + ((guile (set-guile-for-build (default-guile))) + (profile (profile-derivation (packages->manifest + (list %bootstrap-guile)) + #:hooks '() + #:locales? #f)) + (deb (debian-archive "deb-pack" profile + #:compressor %gzip-compressor + #:symlinks '(("/opt/gnu/bin" -> "bin")) + #:archiver %tar-bootstrap)) + (check + (gexp->derivation "check-deb-pack" + (with-imported-modules '((guix build utils)) + #~(begin + (use-modules (guix build utils) + (ice-9 match) + (ice-9 popen) + (ice-9 rdelim) + (ice-9 textual-ports) + (rnrs base)) + + (setenv "PATH" (string-join + (list (string-append #+%tar-bootstrap "/bin") + (string-append #+dpkg "/bin") + (string-append #+%ar-bootstrap "/bin")) + ":")) + + ;; Validate the output of 'dpkg --info'. + (let* ((port (open-pipe* OPEN_READ "dpkg" "--info" #$deb)) + (info (get-string-all port)) + (exit-val (status:exit-val (close-pipe port)))) + (assert (zero? exit-val)) + + (assert (string-contains + info + (string-append "Package: " + #+(package-name %bootstrap-guile)))) + + (assert (string-contains + info + (string-append "Version: " + #+(package-version %bootstrap-guile))))) + + ;; Sanity check .deb contents. + (invoke "ar" "-xv" #$deb) + (assert (file-exists? "debian-binary")) + (assert (file-exists? "data.tar.gz")) + (assert (file-exists? "control.tar.gz")) + + ;; Verify there are no hard links in data.tar.gz, as hard + ;; links would cause dpkg to fail unpacking the archive. + (define hard-links + (let ((port (open-pipe* OPEN_READ "tar" "-tvf" "data.tar.gz"))) + (let loop ((hard-links '())) + (match (read-line port) + ((? eof-object?) + (assert (zero? (status:exit-val (close-pipe port)))) + hard-links) + (line + (if (string-prefix? "u" line) + (loop (cons line hard-links)) + (loop hard-links))))))) + + (unless (null? hard-links) + (error "hard links found in data.tar.gz" hard-links)) + + (mkdir #$output)))))) (built-derivations (list check))))) (test-end) -- 2.32.0