gnu/packages/netpbm.scm

   1 ;;; GNU Guix --- Functional package management for GNU
   2 ;;; Copyright © 2013, 2015 Andreas Enge <andreas@enge.fr>
   3 ;;; Copyright © 2015, 2016, 2021 Ludovic Courtès <ludo@gnu.org>
   4 ;;; Copyright © 2019, 2020 Tobias Geerinckx-Rice <me@tobias.gr>
   5 ;;;
   6 ;;; This file is part of GNU Guix.
   7 ;;;
   8 ;;; GNU Guix is free software; you can redistribute it and/or modify it
   9 ;;; under the terms of the GNU General Public License as published by
  10 ;;; the Free Software Foundation; either version 3 of the License, or (at
  11 ;;; your option) any later version.
  12 ;;;
  13 ;;; GNU Guix is distributed in the hope that it will be useful, but
  14 ;;; WITHOUT ANY WARRANTY; without even the implied warranty of
  15 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  16 ;;; GNU General Public License for more details.
  17 ;;;
  18 ;;; You should have received a copy of the GNU General Public License
  19 ;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
  20
  21 (define-module (gnu packages netpbm)
  22   #:use-module (gnu packages)
  23   #:use-module (gnu packages compression)
  24   #:use-module (gnu packages flex)
  25   #:use-module (gnu packages ghostscript)
  26   #:use-module (gnu packages image)
  27   #:use-module (gnu packages perl)
  28   #:use-module (gnu packages pkg-config)
  29   #:use-module (gnu packages python)
  30   #:use-module (gnu packages xml)
  31   #:use-module (gnu packages xorg)
  32   #:use-module (guix build-system gnu)
  33   #:use-module ((guix licenses) #:select (gpl2))
  34   #:use-module (guix packages)
  35   #:use-module (guix svn-download))
  36
  37 (define-public netpbm
  38   (package
  39    (name "netpbm")
  40    (version "10.78.3")
  41    (source (origin
  42             (method svn-fetch)
  43             ;; At the time of first packaging, the "super-stable" and
  44             ;; "stable" versions did not compile with newer libpng;
  45             ;; we needed the "advanced" version.
  46             ;; The currently highest stable version is 10.47.53,
  47             ;; the currently highest advanced version is 10.69.4,
  48             ;; svn release 2397.
  49             ;; To determine the correct release: "svn log version.mk".
  50             (uri (svn-reference
  51                    (url "http://svn.code.sf.net/p/netpbm/code/advanced")
  52                    (revision 2965)))
  53             (sha256
  54               (base32
  55                "1k7as9qi1942wyjxpvbf02wg0h4braw44m3m3vvi8sm9y5z1m967"))
  56             (patches (search-patches "netpbm-CVE-2017-2586.patch"
  57                                      "netpbm-CVE-2017-2587.patch"))
  58             (file-name (string-append name "-" version "-checkout"))
  59             (modules '((guix build utils)))
  60             (snippet
  61              '(begin
  62                 ;; Remove non-FSDG-compliant code.
  63
  64                 (define-syntax drop
  65                   (syntax-rules (in)
  66                     ;; Remove PROGRAM from DIRECTORY/Makefile, and remove
  67                     ;; DIRECTORY/PROGRAM and DIRECTORY/PROGRAM.c.
  68                     ((_ program ... in directory)
  69                      (begin
  70                        (substitute* (string-append directory "/Makefile")
  71                          ((program) "") ...)
  72
  73                        (let* ((subdir (string-append directory "/" program))
  74                               (dot-c  (string-append subdir ".c")))
  75                          (when (file-exists? subdir)
  76                            (delete-file-recursively subdir))
  77                          (when (file-exists? dot-c)
  78                            (delete-file dot-c)))
  79
  80                        ...))))
  81
  82                 ;; Drop advertisement for non-free program.
  83                 (drop "hpcdtoppm" in "converter/ppm")
  84
  85                 ;; Drop programs without a license, see
  86                 ;; <http://packages.debian.org/changelogs/pool/main/n/netpbm-free/netpbm-free_10.0-12.2/libnetpbm10.copyright>.
  87                 (drop "pbmto4425" "pbmtoln03" "pbmtolps" "pbmtopk" "pktopbm"
  88                       in "converter/pbm")
  89                 (drop "spottopgm" in "converter/pgm")
  90                 (drop "ppmtopjxl" in "converter/ppm")
  91
  92                 ;; Remove timestamps from the generated code.
  93                 (substitute* "buildtools/makepointerman"
  94                   (("gmctime[(][)]")
  95                    "\"Thu Jan 1 00:00:00 1970\""))
  96                 (substitute* "buildtools/stamp-date"
  97                   (("^DATE=.*")
  98                    "DATE=\"Thu Jan 01 00:00:00+0000 1970\"\n")
  99                   (("^USER=.*")
 100                    "USER=Guix\n"))
 101                 #t))))
 102
 103    (build-system gnu-build-system)
 104    (inputs `(("ghostscript" ,ghostscript)
 105              ("libjpeg" ,libjpeg-turbo)
 106              ("libpng" ,libpng)
 107              ("libtiff" ,libtiff)
 108              ("libxml2" ,libxml2)
 109              ("xorg-rgb" ,xorg-rgb)
 110              ("zlib" ,zlib)))
 111    (native-inputs
 112      `(("flex" ,flex)
 113        ("perl" ,perl)
 114        ("pkg-config" ,pkg-config)
 115        ("python" ,python-wrapper)))
 116    (arguments
 117     `(#:modules ((guix build gnu-build-system)
 118                  (guix build utils)
 119                  (ice-9 match))
 120       #:phases
 121       (modify-phases %standard-phases
 122        (replace 'configure
 123          (lambda* (#:key inputs outputs #:allow-other-keys)
 124            (copy-file "config.mk.in" "config.mk")
 125            (chmod "config.mk" #o664)
 126            (let ((f (open-file "config.mk" "a")))
 127              (display "CC=gcc\n" f)
 128              (display "CFLAGS_SHLIB += -fPIC\n" f)
 129              (display "TIFFLIB = libtiff.so\n" f)
 130              (display "JPEGLIB = libjpeg.so\n" f)
 131              (display "ZLIB = libz.so\n" f)
 132              (display (string-append "LDFLAGS += -Wl,-rpath=" %output "/lib") f)
 133              (close-port f))
 134
 135            (let ((rgb (search-input-file inputs "/share/X11/rgb.txt")))
 136              (substitute* "config.mk"
 137                (("/usr/share/netpbm/rgb.txt") rgb))
 138
 139              ;; Our Ghostscript no longer provides the 'gs' command, only
 140              ;; 'gsc', so look for that instead.
 141              (substitute* "converter/other/pstopnm.c"
 142                (("\"%s/gs\"")
 143                 "\"%s/gsc\"")
 144                (("/usr/bin/gs")
 145                 (search-input-file inputs "/bin/gsc"))))))
 146        (add-before 'check 'setup-check
 147          (lambda _
 148            ;; install temporarily into /tmp/netpbm
 149            (invoke "make" "package")
 150            ;; remove test requiring X
 151            (substitute* "test/all-in-place.test" (("pamx") ""))
 152            ;; do not worry about non-existing file
 153            (substitute* "test/all-in-place.test" (("^rm ") "rm -f "))
 154            ;; remove four tests that fail for unknown reasons
 155            (substitute* "test/Test-Order"
 156              (("all-in-place.test") "")
 157              (("pnmpsnr.test") "")
 158              (("pnmremap1.test") "")
 159              (("gif-roundtrip.test") "")
 160
 161              ;; These two tests started failing in netpbm-10.78.3.
 162              (("jpeg-roundtrip.test") "")
 163              (("pbmtext.test") "")
 164
 165              ;; Skip tests that use nonfree programs that we don't build.
 166              (("ps-alt-roundtrip.test") "" )
 167              (("pbm-misc-converters.test") ""))
 168            #t))
 169        (replace 'install
 170          (lambda* (#:key outputs make-flags #:allow-other-keys)
 171            (let ((out (assoc-ref outputs "out")))
 172              (apply invoke "make" "package"
 173                     (string-append "pkgdir=" out) make-flags)
 174              ;; Remove superfluous files.
 175              (with-directory-excursion out
 176                (for-each delete-file-recursively
 177                          '("config_template" "pkginfo" "README" "VERSION"
 178                            "link/" "misc/"))
 179                ;; Install the required ‘libnetpbm.so’ link.
 180                ;; See <https://issues.guix.gnu.org/issue/40376>.
 181                (with-directory-excursion "lib"
 182                  (symlink
 183                   (match (find-files "." "^libnetpbm\\.so\\.[^.]*\\.[^.]*$")
 184                          ((head _ ...) head))
 185                   "libnetpbm.so"))
 186                #t)))))))
 187    (synopsis "Toolkit for manipulation of images")
 188    (description
 189     "Netpbm is a toolkit for the manipulation of graphic images, including
 190 the conversion of images between a variety of different formats.
 191 There are over 300 separate tools in the package including converters for
 192 about 100 graphics formats.")
 193    (license gpl2)
 194    (home-page "http://netpbm.sourceforge.net/")))