[bug#74163] [PATCH v3 1/3] gnu: appimage: New packages for the appimage runtime.

[bug#74163] [PATCH v3 1/3] gnu: appimage: New packages for the appimage runtime.

[noe--- via Guix-patches via]

From: Noé Lopez <noelopez@free.fr>

* gnu/packages/appimage.scm
(gnu packages appimage): New module.
(fuse-for-appimage, squashfuse-for-appimage)
(appimage-type2-runtime): New variables.

Change-Id: I857a8eb5399a6a493e52db70b6c8cf0c71360930
---
 gnu/packages/appimage.scm | 126 ++++++++++++++++++++++++++++++++++++++
 1 file changed, 126 insertions(+)
 create mode 100644 gnu/packages/appimage.scm

diff --git a/gnu/packages/appimage.scm b/gnu/packages/appimage.scm
new file mode 100644
index 0000000000..df17be214e
--- /dev/null
+++ b/gnu/packages/appimage.scm
@@ -0,0 +1,126 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2024 Noé Lopez <noelopez@free.fr>
+;;;
+;;; 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 (gnu packages appimage)
+  #:use-module ((guix licenses) #:prefix license:)
+  #:use-module (gnu packages base)
+  #:use-module (gnu packages compression)
+  #:use-module (gnu packages file-systems)
+  #:use-module (gnu packages linux)
+  #:use-module (gnu packages)
+  #:use-module (guix build-system gnu)
+  #:use-module (guix download)
+  #:use-module (guix gexp)
+  #:use-module (guix git-download)
+  #:use-module (guix packages)
+  #:use-module (guix utils))
+
+(define fuse-for-appimage
+  (package
+    (inherit fuse)
+    (name "fuse")
+    (version "3.16.2")
+    (source
+     (origin
+       (method url-fetch)
+       (uri (string-append "https://github.com/libfuse/libfuse/releases/"
+                           "download/fuse-" version "/fuse-" version ".tar.gz"))
+       (sha256
+        (base32 "11yfl2w2a445hllyzlakq97n32g06972vxpmh7lpbclnj9fhb5zp"))))
+    (arguments
+     (substitute-keyword-arguments (package-arguments fuse)
+       ((#:configure-flags original-flags #~(list))
+        #~(append #$original-flags '("--default-library=static")))))))
+
+(define squashfuse-for-appimage
+    (package
+      (inherit squashfuse)
+      (arguments
+       (list
+        #:configure-flags
+        #~'("CFLAGS=-ffunction-sections -fdata-sections -Os -no-pie"
+            "LDFLAGS=-static")
+        #:phases
+        #~(modify-phases %standard-phases
+            (add-after 'install 'install-private-headers
+              (lambda _
+                (install-file "fuseprivate.h"
+                              (string-append #$output
+                                             "/include/squashfuse/")))))))
+      (inputs (list fuse-for-appimage
+                    `(,zstd "lib")
+                    `(,zstd "static")
+                    `(,zlib "out")
+                    `(,zlib "static")))))
+
+(define-public appimage-type2-runtime
+  (let ((revision "0")
+        ;; No releases, just the latest commit.
+        (commit "47b665594856b4e8928f8932adcf6d13061d8c30"))
+    (package
+      (name "appimage-type2-runtime")
+      (version (git-version "continuous" revision commit))
+      (source
+       (origin
+         (method git-fetch)
+         (uri (git-reference
+               (url "https://github.com/AppImage/type2-runtime")
+               (commit commit)))
+         (file-name (git-file-name name version))
+         (sha256
+          (base32 "0954crhlbapxis96g1s0vfpf78ybr64zvjalak387ksxj560g44x"))))
+      (arguments
+       (list
+        #:make-flags
+        #~(list "-Csrc/runtime" "runtime-fuse3"
+                (string-append "CFLAGS=" "-I" #$fuse-2 "/include/fuse/"
+                               " -DGIT_COMMIT='\"" "guix-" #$version "\"'"
+                               " -D_FILE_OFFSET_BITS=64"
+                               " -static"))
+        #:modules
+        `((guix build gnu-build-system)
+          (guix build utils)
+          (ice-9 binary-ports))
+        #:phases #~(modify-phases %standard-phases
+                     (delete 'configure)
+                     (delete 'check)    ; No tests.
+                     (replace 'install
+                       (lambda _
+                         (install-file "src/runtime/runtime-fuse3"
+                                       (string-append #$output "/bin"))))
+                     ;; Must be after all elf reliant phases.
+                     (add-after 'make-dynamic-linker-cache 'set-magic-bytes
+                       (lambda _
+                         (let ((port (open (string-append #$output
+                                            "/bin/runtime-fuse3")
+                                           (logior O_WRONLY))))
+                           (seek port 8 SEEK_SET)
+                           (put-bytevector port #vu8(#x41 #x49 #x02))
+                           (close-port port)))))
+        #:disallowed-references (list squashfuse-for-appimage
+                                      fuse-for-appimage zstd zlib)))
+      ;; Only needed at build time.
+      (inputs (list squashfuse-for-appimage fuse-for-appimage
+                    `(,zstd "static")
+                    `(,zlib "static")))
+      (build-system gnu-build-system)
+      (home-page "https://github.com/AppImage/type2-runtime")
+      (synopsis "Runtime for executing AppImages")
+      (description "The runtime is the executable part of every AppImage, it
+mounts the payload via FUSE and executes the entrypoint.")
+      (license license:expat))))

base-commit: 870b7d69b4b06d01cdf6bfca71bcc161c0b832bf
-- 
2.46.0

[bug#74164] [PATCH v3 2/3] pack: Add support for AppImage pack format.

[noe--- via Guix-patches via]

From: Sebastian Dümcke <code@sam-d.com>

* guix/scripts/pack.scm: Add Appimage format.
* doc/guix.texi: Document AppImage pack.

Co-authored-by: Noé Lopez <noelopez@free.fr>
Change-Id: I33ebfec623cff1cfcd6f029d2d3054c23ab1949a
---
 doc/guix.texi         |  53 ++++++++++++++++++++-
 guix/scripts/pack.scm | 104 +++++++++++++++++++++++++++++++++++++++++-
 tests/pack.scm        |  41 ++++++++++++++++-
 3 files changed, 195 insertions(+), 3 deletions(-)

diff --git a/doc/guix.texi b/doc/guix.texi
index 187bae6898..46108dc3f1 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -6949,6 +6949,16 @@ Invoking guix pack
 environment}, using commands like @command{singularity shell} or
 @command{singularity exec}.
 
+@cindex AppImage, create an AppImage file with @command{guix pack}
+Another format internally based on SquashFS is
+@uref{https://appimage.org/, AppImage}. An AppImage file can be created
+and executed without any special privileges:
+
+@example
+file=$(guix pack -f appimage --entry-point=bin/guile guile)
+$file --help
+@end example
+
 Several command-line options allow you to customize your pack:
 
 @table @code
@@ -7065,6 +7075,47 @@ Invoking guix pack
 installation or other, non-rpm packs.
 @end quotation
 
+@item appimage
+@cindex AppImage, create an AppImage file with @command{guix pack}
+This produces an AppImage file with the @samp{.AppImage} extension.
+AppImage is a SquashFS volume prefixed with a runtime that mounts the
+SquashFS file system and executes the binary provided with
+@option{--entry-point}.  This results in a self-contained archive that
+bundles the software and all its requirements into a single file.  When
+the file is made executable it runs the packaged software.
+
+@example
+guix pack -f appimage --entry-point=bin/vlc vlc
+@end example
+
+The runtime used by AppImages makes use of libfuse to mount the image
+quickly.  If libfuse is not available, the AppImage can still be started
+using the @option{--appimage-extract-and-run} flag.
+
+@quotation Warning
+ When building an AppImage, always @emph{pass} the
+@option{--relocatable} option (or @option{-R}, or @option{-RR}) to make
+sure the image can be used on systems where Guix is not installed.  A
+warning is printed when this option is not used.
+@end quotation
+
+@example
+guix pack -f appimage --entry-point=bin/hello --relocatable hello
+@end example
+
+@quotation Note
+The resulting AppImage does not conform to the complete standard as it
+currently does not contain a @file{.DirIcon} file.  This does not impact
+functionality of the AppImage itself, but possibly that of software used
+to manage AppImages.
+@end quotation
+
+@quotation Note
+As the generated AppImage packages the complete dependency graph, it
+will be larger than comparable AppImage files found online, which depend
+on host system libraries.
+@end quotation
+
 @end table
 
 @cindex relocatable binaries
@@ -7155,7 +7206,7 @@ Invoking guix pack
 @cindex entry point, for Docker and Singularity images
 @item --entry-point=@var{command}
 Use @var{command} as the @dfn{entry point} of the resulting pack, if the pack
-format supports it---currently @code{docker} and @code{squashfs} (Singularity)
+format supports it---currently @code{docker}, @code{appimage} and @code{squashfs} (Singularity)
 support it.  @var{command} must be relative to the profile contained in the
 pack.
 
diff --git a/guix/scripts/pack.scm b/guix/scripts/pack.scm
index 7c5fe76fe0..26ba80b80d 100644
--- a/guix/scripts/pack.scm
+++ b/guix/scripts/pack.scm
@@ -10,6 +10,8 @@
 ;;; Copyright © 2022 Alex Griffin <a@ajgrf.com>
 ;;; Copyright © 2023 Graham James Addis <graham@addis.org.uk>
 ;;; Copyright © 2023 Oleg Pykhalov <go.wigust@gmail.com>
+;;; Copyright © 2024 Sebastian Dümcke <code@sam-d.com>
+;;; Copyright © 2024 Noé Lopez <noelopez@free.fr>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -56,6 +58,7 @@ (define-module (guix scripts pack)
   #:use-module ((gnu packages compression) #:hide (zip))
   #:use-module (gnu packages guile)
   #:use-module (gnu packages base)
+  #:autoload   (gnu packages appimage) (appimage-type2-runtime)
   #:autoload   (gnu packages gnupg) (guile-gcrypt)
   #:autoload   (gnu packages guile) (guile2.0-json guile-json)
   #:use-module (srfi srfi-1)
@@ -64,6 +67,7 @@ (define-module (guix scripts pack)
   #:use-module (srfi srfi-35)
   #:use-module (srfi srfi-37)
   #:use-module (ice-9 match)
+  #:use-module (ice-9 optargs)
   #:export (symlink-spec-option-parser
 
             self-contained-tarball
@@ -71,6 +75,7 @@ (define-module (guix scripts pack)
             rpm-archive
             docker-image
             squashfs-image
+            self-contained-appimage
 
             %formats
             guix-pack))
@@ -974,8 +979,100 @@ (define* (rpm-archive name profile
   (gexp->derivation (string-append name ".rpm") build
                     #:target target
                     #:references-graphs `(("profile" ,profile))))
+\f
+;;;
+;;; AppImage format
+;;;
+(define* (self-contained-appimage name profile
+                                  #:key target
+                                  (profile-name "guix-profile")
+                                  entry-point
+                                  (compressor (lookup-compressor "zstd"))
+                                  localstatedir?
+                                  (symlinks '())
+                                  (archiver tar)
+                                  (extra-options '()))
+  "Return a self-contained AppImage containing a store initialized with the
+closure of PROFILE, a derivation.  The AppImage contains /gnu/store unless
+RELOCATABLE option is used; if LOCALSTATEDIR? is true, it also contains
+/var/guix, including /var/guix/db with a properly initialized store database.
+
+SYMLINKS must be a list of (SOURCE -> TARGET) tuples denoting symlinks to be
+added to the pack."
+  (unless entry-point
+    (leave (G_ "entry-point must be provided in the '~a' format~%")
+           'appimage))
+  (let-keywords extra-options #f ((relocatable? #f))
+    (unless relocatable?
+      (warning (G_ "AppImages should be built with the --relocatable flag~%"))))
+
+  (define runtime-package appimage-type2-runtime)
+  (define runtime-path "bin/runtime-fuse3")
+  (define %valid-compressors '("gzip" "zstd"))
+
+  (let ((compressor-name (compressor-name compressor)))
+    (unless (member compressor-name %valid-compressors)
+      (leave (G_ "~a is not a valid squashfs archive compressor used in
+generating the AppImage.  Valid compressors are: ~a~%")
+             compressor-name
+             %valid-compressors)))
 
-  \f
+  (define builder
+    (with-extensions (list guile-gcrypt)
+      (with-imported-modules (source-module-closure
+                              '((guix build store-copy)
+                                (guix build utils))
+                              #:select? not-config?)
+        #~(begin
+            (use-modules (guix build utils)
+                         (guix build store-copy)
+                         (rnrs io ports)
+                         (srfi srfi-1)
+                         (srfi srfi-26))
+
+            (define (concatenate-files result file1 file2)
+              "Creates a new file RESULT containing FILE1 followed by FILE2."
+              (call-with-output-file result
+                (lambda (output)
+                  (call-with-input-file file1
+                    (lambda (input)
+                      (dump-port input output)))
+                  (call-with-input-file file2
+                    (lambda (input)
+                      (dump-port input output))))))
+
+            (let* ((appdir "AppDir")
+                   (squashfs "squashfs")
+                   (profile-items (map store-info-item
+                                       (call-with-input-file "profile" read-reference-graph)))
+                   (profile (find (lambda (item)
+                                      (string-suffix? "-profile" item))
+                                  profile-items)))
+              (mkdir-p appdir)
+              ;; Copy all store items from the profile to the AppDir.
+              (populate-store '("profile") appdir)
+              ;; Symlink the provided entry-point to AppDir/AppRun.
+              (symlink (string-append "." profile "/" #$entry-point)
+                       (string-append appdir "/AppRun"))
+              ;; Create .desktop file as required by the spec.
+              (make-desktop-entry-file
+               (string-append appdir "/" #$name ".desktop")
+               #:name #$name
+               #:exec #$entry-point)
+              ;; Compress the AppDir.
+              (invoke #+(file-append squashfs-tools "/bin/mksquashfs") appdir
+                      squashfs "-root-owned" "-noappend"
+                      "-comp" #+(compressor-name compressor))
+              ;; Append runtime and squashFS into file AppImage.
+              (concatenate-files #$output
+                                 #$(file-append runtime-package "/" runtime-path)
+                                 squashfs)
+              ;; Add execution permission.
+              (chmod #$output #o555))))))
+  (gexp->derivation (string-append name ".AppImage") builder
+		    #:target target
+		    #:references-graphs `(("profile" ,profile))))
+\f
 ;;;
 ;;; Compiling C programs.
 ;;;
@@ -1311,6 +1408,7 @@ (define %formats
     (squashfs . ,squashfs-image)
     (docker  . ,docker-image)
     (deb . ,debian-archive)
+    (appimage . ,self-contained-appimage)
     (rpm . ,rpm-archive)))
 
 (define (show-formats)
@@ -1327,6 +1425,8 @@ (define (show-formats)
   deb           Debian archive installable via dpkg/apt"))
   (display (G_ "
   rpm           RPM archive installable via rpm/yum"))
+  (display (G_ "
+  appimage      AppImage self-contained and executable format"))
   (newline))
 
 (define (required-option symbol)
@@ -1694,6 +1794,8 @@ (define-command (guix-pack . args)
                                            (process-file-arg opts 'preun-file)
                                            #:postun-file
                                            (process-file-arg opts 'postun-file)))
+                                    ('appimage
+                                     (list #:relocatable? relocatable?))
                                     (_ '())))
                    (target      (assoc-ref opts 'target))
                    (bootstrap?  (assoc-ref opts 'bootstrap?))
diff --git a/tests/pack.scm b/tests/pack.scm
index f8a9e09c28..6ac9a966af 100644
--- a/tests/pack.scm
+++ b/tests/pack.scm
@@ -3,6 +3,7 @@
 ;;; Copyright © 2018 Ricardo Wurmus <rekado@elephly.net>
 ;;; Copyright © 2021, 2023 Maxim Cournoyer <maxim.cournoyer@gmail.com>
 ;;; Copyright © 2023 Oleg Pykhalov <go.wigust@gmail.com>
+;;; Copyright © 2024 Noé Lopez <noelopez@free.fr>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -32,7 +33,8 @@ (define-module (test-pack)
   #:use-module (guix utils)
   #:use-module ((guix build utils) #:select (%store-directory))
   #:use-module (gnu packages)
-  #:use-module ((gnu packages base) #:select (libc-utf8-locales-for-target))
+  #:use-module ((gnu packages base) #:select (libc-utf8-locales-for-target
+                                              hello))
   #:use-module (gnu packages bootstrap)
   #:use-module ((gnu packages package-management) #:select (rpm))
   #:use-module ((gnu packages compression) #:select (squashfs-tools))
@@ -340,6 +342,43 @@ (define rpm-for-tests
                              (mkdir #$output))))))))
       (built-derivations (list check))))
 
+  (unless store (test-skip 1))
+  (test-assertm "appimage"
+    (mlet* %store-monad
+        ((guile   (set-guile-for-build (default-guile)))
+         (profile -> (profile
+                      (content (packages->manifest (list %bootstrap-guile hello)))
+                      (hooks '())
+                      (locales? #f)))
+         (image   (self-contained-appimage "hello-appimage" profile
+                                           #:entry-point "bin/hello"
+                                           #:extra-options
+                                           (list #:relocatable? #t)))
+         (check   (gexp->derivation
+                   "check-appimage"
+                   #~(begin
+                       (invoke #$image)))))
+      (built-derivations (list check))))
+
+  (unless store (test-skip 1))
+  (test-assertm "appimage + localstatedir"
+    (mlet* %store-monad
+        ((guile   (set-guile-for-build (default-guile)))
+         (profile -> (profile
+                      (content (packages->manifest (list %bootstrap-guile hello)))
+                      (hooks '())
+                      (locales? #f)))
+         (image   (self-contained-appimage "hello-appimage" profile
+                                           #:entry-point "bin/hello"
+                                           #:localstatedir? #t
+                                           #:extra-options
+                                           (list #:relocatable? #t)))
+         (check   (gexp->derivation
+                   "check-appimage"
+                   #~(begin
+                       (invoke #$image)))))
+      (built-derivations (list check))))
+
   (unless store (test-skip 1))
   (test-assertm "deb archive with symlinks and control files"
     (mlet* %store-monad
-- 
2.46.0

[bug#74165] [PATCH v3 3/3] news: Add entry for guix pack’s AppImage format

[noe--- via Guix-patches via]

From: Sebastian Dümcke <code@sam-d.com>

* etc/news.scm: Add entry.

Change-Id: If37b3b578517c15c2868239998975f7718f7d689
---
 etc/news.scm | 38 ++++++++++++++++++++++++++++++++++++++
 1 file changed, 38 insertions(+)

diff --git a/etc/news.scm b/etc/news.scm
index 4929fa2a9a..4b9f768d8e 100644
--- a/etc/news.scm
+++ b/etc/news.scm
@@ -25,6 +25,7 @@
 ;; Copyright © 2024 Vivien Kraus <vivien@planete-kraus.eu>
 ;; Copyright © 2024 Guillaume Le Vaillant <glv@posteo.net>
 ;; Copyright © 2024 Zheng Junjie <873216071@qq.com>
+;; Copyright © 2024 Sebastian Dümcke <code@sam-d.com>
 ;;
 ;; Copying and distribution of this file, with or without modification, are
 ;; permitted in any medium without royalty provided the copyright notice and
@@ -32,6 +33,43 @@
 
 (channel-news
  (version 0)
+ (entry (commit "e6534c6ba947d3edbdcb090ae4a410cd9b5ef1c1")
+        (title
+         (de "Neues Format @samp{AppImage} für den Befehl @command{guix pack}")
+         (en "New @samp{AppImage} format for the @command{guix pack} command")
+         (fr "Nouveau format @samp{AppImage} pour la commande @command{guix pack}"))
+        (body
+         (de "@command{guix pack} kann nun AppImage Dateien erstellen. Das
+AppImage Dateiformat erlaubt es in einer einzelnen Datei Software zu verteilen. Die
+AppImage Datei lässt sich ohne besondere Benutzerrechte ausführen. Hier ist
+ein Beispiel:
+
+@example
+guix pack --format=appimage --entry-point=bin/hello hello
+@end example
+
+Siehe @command{info \"(guix.de) Aufruf von guix pack\"} für mehr
+Informationen.")
+         (en "@command{guix pack} can now produce AppImage a single file,
+self-contained software archive. AppImage files are easily distributed and can
+be run with user privileges.  Here is an example for the @code{hello} package:
+
+@example
+guix pack --format=appimage --entry-point=bin/hello hello
+@end example
+
+See @command{info \"(guix) Invoking guix pack\"} for more information.")
+         (fr "@command{guix pack} peut désormais produire un fichier
+AppImage. AppImage est une manière de distribuer les logiciels en un seul
+fichier, qui peut être executé avec des droits d’utilisateur. Voici un
+exemple pour le paquet @code{hello} :
+
+@example
+guix pack --format=appimage --entry-point=bin/hello hello
+@end example
+
+Consultez @command{info \"(guix.fr) Invoquer guix pack\"} pour plus
+d’informations.")))
 
  (entry (commit "5966e0fdc78771c562e0f484a22f381a77908be0")
         (title
-- 
2.46.0