aboutsummaryrefslogtreecommitdiff
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2013, 2015 Andreas Enge <andreas@enge.fr>
;;; Copyright © 2015, 2016, 2021 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2019, 2020 Tobias Geerinckx-Rice <me@tobias.gr>
;;; Copyright © 2024 Efraim Flashner <efraim@flashner.co.il>
;;;
;;; 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 netpbm)
  #:use-module (gnu packages)
  #:use-module (gnu packages compression)
  #:use-module (gnu packages flex)
  #:use-module (gnu packages ghostscript)
  #:use-module (gnu packages image)
  #:use-module (gnu packages perl)
  #:use-module (gnu packages pkg-config)
  #:use-module (gnu packages python)
  #:use-module (gnu packages xml)
  #:use-module (gnu packages xorg)
  #:use-module (guix build-system gnu)
  #:use-module ((guix licenses) #:select (gpl2))
  #:use-module (guix packages)
  #:use-module (guix svn-download)
  #:use-module (guix utils))

(define-public netpbm
  (package
   (name "netpbm")
   (version "10.78.3")
   (source (origin
            (method svn-fetch)
            ;; At the time of first packaging, the "super-stable" and
            ;; "stable" versions did not compile with newer libpng;
            ;; we needed the "advanced" version.
            ;; The currently highest stable version is 10.47.53,
            ;; the currently highest advanced version is 10.69.4,
            ;; svn release 2397.
            ;; To determine the correct release: "svn log version.mk".
            (uri (svn-reference
                   (url "http://svn.code.sf.net/p/netpbm/code/advanced")
                   (revision 2965)))
            (sha256
              (base32
               "1k7as9qi1942wyjxpvbf02wg0h4braw44m3m3vvi8sm9y5z1m967"))
            (patches (search-patches "netpbm-CVE-2017-2586.patch"
                                     "netpbm-CVE-2017-2587.patch"))
            (file-name (string-append name "-" version "-checkout"))
            (modules '((guix build utils)))
            (snippet
             '(begin
                ;; Remove non-FSDG-compliant code.

                (define-syntax drop
                  (syntax-rules (in)
                    ;; Remove PROGRAM from DIRECTORY/Makefile, and remove
                    ;; DIRECTORY/PROGRAM and DIRECTORY/PROGRAM.c.
                    ((_ program ... in directory)
                     (begin
                       (substitute* (string-append directory "/Makefile")
                         ((program) "") ...)

                       (let* ((subdir (string-append directory "/" program))
                              (dot-c  (string-append subdir ".c")))
                         (when (file-exists? subdir)
                           (delete-file-recursively subdir))
                         (when (file-exists? dot-c)
                           (delete-file dot-c)))

                       ...))))

                ;; Drop advertisement for non-free program.
                (drop "hpcdtoppm" in "converter/ppm")

                ;; Drop programs without a license, see
                ;; <http://packages.debian.org/changelogs/pool/main/n/netpbm-free/netpbm-free_10.0-12.2/libnetpbm10.copyright>.
                (drop "pbmto4425" "pbmtoln03" "pbmtolps" "pbmtopk" "pktopbm"
                      in "converter/pbm")
                (drop "spottopgm" in "converter/pgm")
                (drop "ppmtopjxl" in "converter/ppm")

                ;; Remove timestamps from the generated code.
                (substitute* "buildtools/makepointerman"
                  (("gmctime[(][)]")
                   "\"Thu Jan 1 00:00:00 1970\""))
                (substitute* "buildtools/stamp-date"
                  (("^DATE=.*")
                   "DATE=\"Thu Jan 01 00:00:00+0000 1970\"\n")
                  (("^USER=.*")
                   "USER=Guix\n"))
                #t))))

   (build-system gnu-build-system)
   (inputs `(("ghostscript" ,ghostscript)
             ("libjpeg" ,libjpeg-turbo)
             ("libpng" ,libpng)
             ("libtiff" ,libtiff)
             ("libxml2" ,libxml2)
             ("xorg-rgb" ,xorg-rgb)
             ("zlib" ,zlib)))
   (native-inputs
     `(("flex" ,flex)
       ("perl" ,perl)
       ("pkg-config" ,pkg-config)
       ("python" ,python-wrapper)))
   (arguments
    `(#:modules ((guix build gnu-build-system)
                 (guix build utils)
                 (ice-9 match))
      #:phases
      (modify-phases %standard-phases
       (replace 'configure
         (lambda* (#:key inputs outputs #:allow-other-keys)
           (copy-file "config.mk.in" "config.mk")
           (chmod "config.mk" #o664)
           (let ((f (open-file "config.mk" "a")))
             (display "CC=gcc\n" f)
             (display "CFLAGS_SHLIB += -fPIC\n" f)
             (display "TIFFLIB = libtiff.so\n" f)
             (display "JPEGLIB = libjpeg.so\n" f)
             (display "ZLIB = libz.so\n" f)
             (display (string-append "LDFLAGS += -Wl,-rpath=" %output "/lib") f)
             (close-port f))

           (let ((rgb (search-input-file inputs "/share/X11/rgb.txt")))
             (substitute* "config.mk"
               (("/usr/share/netpbm/rgb.txt") rgb))

             ;; Our Ghostscript no longer provides the 'gs' command, only
             ;; 'gsc', so look for that instead.
             (substitute* "converter/other/pstopnm.c"
               (("\"%s/gs\"")
                "\"%s/gsc\"")
               (("/usr/bin/gs")
                (search-input-file inputs "/bin/gsc"))))))
       (add-before 'check 'setup-check
         (lambda _
           ;; install temporarily into /tmp/netpbm
           (invoke "make" "package")
           ;; remove test requiring X
           (substitute* "test/all-in-place.test" (("pamx") ""))
           ;; do not worry about non-existing file
           (substitute* "test/all-in-place.test" (("^rm ") "rm -f "))
           ;; remove four tests that fail for unknown reasons
           (substitute* "test/Test-Order"
             (("all-in-place.test") "")
             (("pnmpsnr.test") "")
             (("pnmremap1.test") "")
             (("gif-roundtrip.test") "")

             ;; These two tests fail on powerpc-linux.
             ,@(if (target-ppc32?)
                   `((("pbmtog3\\.test") "")
                     (("g3-roundtrip\\.test") ""))
                   '())

             ;; These two tests started failing in netpbm-10.78.3.
             (("jpeg-roundtrip.test") "")
             (("pbmtext.test") "")

             ;; Skip tests that use nonfree programs that we don't build.
             (("ps-alt-roundtrip.test") "" )
             (("pbm-misc-converters.test") ""))
           #t))
       (replace 'install
         (lambda* (#:key outputs make-flags #:allow-other-keys)
           (let ((out (assoc-ref outputs "out")))
             (apply invoke "make" "package"
                    (string-append "pkgdir=" out) make-flags)
             ;; Remove superfluous files.
             (with-directory-excursion out
               (for-each delete-file-recursively
                         '("config_template" "pkginfo" "README" "VERSION"
                           "link/" "misc/"))
               ;; Install the required ‘libnetpbm.so’ link.
               ;; See <https://issues.guix.gnu.org/issue/40376>.
               (with-directory-excursion "lib"
                 (symlink
                  (match (find-files "." "^libnetpbm\\.so\\.[^.]*\\.[^.]*$")
                         ((head _ ...) head))
                  "libnetpbm.so"))
               #t)))))))
   (synopsis "Toolkit for manipulation of images")
   (description
    "Netpbm is a toolkit for the manipulation of graphic images, including
the conversion of images between a variety of different formats.
There are over 300 separate tools in the package including converters for
about 100 graphics formats.")
   (license gpl2)
   (home-page "https://netpbm.sourceforge.net/")))
"$module_dir/foo" ( cd "$module_dir" ; \ guix package --bootstrap -i guile-bootstrap -p foo/prof ) test -f "$module_dir/foo/prof/bin/guile" rm "$module_dir/foo"/* rmdir "$module_dir/foo" rmdir "$module_dir" # # Try with the default profile. # XDG_CACHE_HOME="${XDG_CACHE_HOME:-$HOME/.cache}" export XDG_CACHE_HOME HOME="$PWD/t-home-$$" export HOME mkdir -p "$HOME" # Get the canonical directory name so that 'guix package' recognizes it. HOME="`cd $HOME; pwd -P`" guix package --bootstrap -i guile-bootstrap test -L "$HOME/.guix-profile" test -f "$HOME/.guix-profile/bin/guile" # Move to the empty profile. default_profile="`readlink "$HOME/.guix-profile"`" for i in `seq 1 3` do # Make sure the current generation is a GC root. profile_link="`readlink "$default_profile"`" guix gc --list-live | grep "`readlink "$profile_link"`" guix package --bootstrap --roll-back test ! -f "$HOME/.guix-profile/bin" test ! -f "$HOME/.guix-profile/lib" test "`readlink "$default_profile"`" = "`basename $default_profile-0-link`" done # Check whether '-p ~/.guix-profile' makes any difference. # See <http://bugs.gnu.org/17939>. test ! -e "$HOME/.guix-profile-0-link" test ! -e "$HOME/.guix-profile-1-link" guix package --bootstrap -p "$HOME/.guix-profile" -i guile-bootstrap test ! -e "$HOME/.guix-profile-1-link" guix package --bootstrap --roll-back -p "$HOME/.guix-profile" test ! -e "$HOME/.guix-profile-0-link" # Extraneous argument. guix package install foo-bar && false # Make sure the "broken pipe" doesn't yield an error. # Note: 'pipefail' is a Bash-specific option. set -o pipefail || true guix package -A g | head -1 2> "$HOME/err1" guix package -I | head -1 2> "$HOME/err2" test "`cat "$HOME/err1" "$HOME/err2"`" = "" # Make sure '-L' extends the package module search path. mkdir "$module_dir" cat > "$module_dir/foo.scm"<<EOF (define-module (foo) #:use-module (guix packages) #:use-module (gnu packages emacs)) (define-public x (package (inherit emacs) (name "emacs-foo-bar") (version "42.77.0"))) EOF guix package -A emacs-foo-bar -L "$module_dir" | grep 42 guix package -i emacs-foo-bar@42 -n -L "$module_dir" # Same thing using the 'GUIX_PACKAGE_PATH' environment variable. GUIX_PACKAGE_PATH="$module_dir" export GUIX_PACKAGE_PATH guix package -A emacs-foo-bar | grep 42 guix package -i emacs-foo-bar@42 -n # Make sure GUIX_PACKAGE_PATH/'-L' takes precedence in case of duplicate packages. cat > "$module_dir/bar.scm"<<EOF (define-module (bar) #:use-module (guix packages)) (define-public hello (package (inherit (@@ (gnu packages base) hello)) (synopsis "an overridden version of GNU hello"))) EOF guix package -i hello -n 2>&1 | grep choosing.*bar.scm ( unset GUIX_PACKAGE_PATH; \ guix package -i hello -n -L "$module_dir" 2>&1 | grep choosing.*bar.scm ) # Make sure patches that live under $GUIX_PACKAGE_PATH are found. cat > "$module_dir/emacs.patch"<<EOF This is a fake patch. EOF cat > "$module_dir/foo.scm"<<EOF (define-module (foo) #:use-module (guix packages) #:use-module (gnu packages) #:use-module (gnu packages emacs)) (define-public x (package (inherit emacs) (source (origin (inherit (package-source emacs)) (patches (list (search-patch "emacs.patch"))))) (name "emacs-foo-bar-patched") (version "42.42.42"))) (define-public y (package (inherit emacs) (name "super-non-portable-emacs") (supported-systems '("foobar64-hurd")))) EOF guix package -i emacs-foo-bar-patched -n # Same when -L is used. ( unset GUIX_PACKAGE_PATH; \ guix package -L "$module_dir" -i emacs-foo-bar-patched -n ) # Make sure installing from a file works. cat > "$module_dir/package.scm"<<EOF (use-modules (gnu)) (use-package-modules bootstrap) %bootstrap-guile EOF guix package --bootstrap --install-from-file="$module_dir/package.scm" # Make sure an error is raised if the file doesn't return a package. cat > "$module_dir/package.scm"<<EOF (use-modules (gnu packages base)) (define my-package coreutils) ;returns *unspecified* EOF guix package --bootstrap --install-from-file="$module_dir/package.scm" && false rm "$module_dir/package.scm" # This one should not show up in searches since it's no supported on the # current system. test "`guix package -A super-non-portable-emacs`" = "" test "`guix package -s super-non-portable-emacs | grep ^systems:`" = "systems: " # Don't upgrade packages marked for removal: <http://bugs.gnu.org/27262>. guix package --bootstrap -p "$profile" -i guile-bootstrap cat > "$module_dir/foo.scm"<<EOF (define-module (foo) #:use-module (guix) #:use-module (gnu packages bootstrap)) (define-public x (package (inherit %bootstrap-guile) (version "42"))) EOF guix package --bootstrap -p "$profile" -r guile-bootstrap -u guile test ! -f "$profile/bin/guile" guix package --bootstrap -p "$profile" --roll-back test -f "$profile/bin/guile" rm "$profile-2-link" unset GUIX_PACKAGE_PATH # Using 'GUIX_BUILD_OPTIONS'. available="`guix package -A | sort`" GUIX_BUILD_OPTIONS="--dry-run --no-grafts" export GUIX_BUILD_OPTIONS # Make sure $GUIX_BUILD_OPTIONS is not simply appended to the command-line, # which would break 'guix package -A' and similar. available2="`guix package -A | sort`" test "$available2" = "$available" guix package -I # Restore '--no-grafts', which makes sure we don't end up building stuff when # '--dry-run' is passed. GUIX_BUILD_OPTIONS="--no-grafts" # Install using the "imperative model", export a manifest, instantiate it, and # make sure we get the same profile. guix package --bootstrap -i guile-bootstrap --without-tests=foo profile_directory="$(readlink -f "$default_profile")" guix package --export-manifest > "$tmpfile" grep 'without-tests.*foo' "$tmpfile" guix package --rollback --bootstrap guix package --bootstrap -m "$tmpfile" test "$(readlink -f "$default_profile")" = "$profile_directory" guix package --export-manifest > "$tmpfile.2nd" cmp "$tmpfile" "$tmpfile.2nd" rm -f "$tmpfile.2nd" guix package --rollback --bootstrap # Applying a manifest file. cat > "$module_dir/manifest.scm"<<EOF (use-package-modules bootstrap) (packages->manifest (list %bootstrap-guile)) EOF guix package --bootstrap -m "$module_dir/manifest.scm" guix package -I | grep guile test `guix package -I | wc -l` -eq 1 # Export a manifest, instantiate it, and make sure we get the same profile. profile_directory="$(readlink -f "$default_profile")" guix package --export-manifest > "$tmpfile" guix package --rollback --bootstrap guix package --bootstrap -m "$tmpfile" test "$(readlink -f "$default_profile")" = "$profile_directory" guix package --rollback --bootstrap # Applying two manifests. cat > "$module_dir/manifest2.scm"<<EOF (use-modules (gnu packages bootstrap) (guix)) (define p (package (inherit %bootstrap-guile) (name "eliug"))) (packages->manifest (list p)) EOF guix package --bootstrap \ -m "$module_dir/manifest.scm" -m "$module_dir/manifest2.scm" guix package -I | grep guile guix package -I | grep eliug test `guix package -I | wc -l` -eq 2 guix package --rollback --bootstrap # Applying a manifest file with inferior packages. cat > "$module_dir/manifest.scm"<<EOF (use-modules (guix inferior)) (define i (open-inferior "$abs_top_srcdir" #:command "scripts/guix")) (let ((guile (car (lookup-inferior-packages i "guile-bootstrap")))) (packages->manifest (list guile))) EOF guix package --bootstrap -m "$module_dir/manifest.scm" guix package -I | grep guile test `guix package -I | wc -l` -eq 1 # Error reporting. cat > "$module_dir/manifest.scm"<<EOF (use-package-modules bootstrap) (packages->manifest (list %bootstrap-guile wonderful-package-that-does-not-exist)) EOF if guix package --bootstrap -n -m "$module_dir/manifest.scm" \ 2> "$module_dir/stderr" then false else cat "$module_dir/stderr" grep "manifest.scm:[1-4]:.*wonderful-package.*: unbound variable" \ "$module_dir/stderr" fi # Verify that package outputs are included in search results. rm -rf "$module_dir" mkdir "$module_dir" cat > "$module_dir/foo.scm"<<EOF (define-module (foo) #:use-module (guix packages) #:use-module (guix build-system trivial)) (define-public dummy-package (package (name "dummy-package") (version "dummy-version") (outputs '("out" "dummy-output")) (source #f) ;; Without a real build system, the "guix package -s" command will fail. (build-system trivial-build-system) (synopsis "dummy-synopsis") (description "dummy-description") (home-page "https://dummy-home-page") (license #f))) EOF guix package -L "$module_dir" -s dummy-output > /tmp/out test "`guix package -L "$module_dir" -s dummy-output | grep ^name:`" = "name: dummy-package" rm -rf "$module_dir" # Make sure we can see user profiles. guix package --list-profiles | grep "$profile" guix package --list-profiles | grep '\.guix-profile' # Make sure we can properly lock a profile. mkdir "$module_dir" echo "(open-output-file \"$module_dir/ready\") (sleep 60)" \ > "$module_dir/manifest.scm" guix package -m "$module_dir/manifest.scm" -p "$module_dir/profile" & pid=$! while [ ! -f "$module_dir/ready" ] ; do sleep 0.5 ; done if guix install emacs -p "$module_dir/profile"; then kill $pid; false; else true; fi kill $pid