Merge branch 'master' into core-updates

This commit is contained in:
Mark H Weaver 2016-10-19 10:54:36 -04:00
commit d2478b4cdd
No known key found for this signature in database
GPG key ID: 7CEF29847562C516
68 changed files with 1712 additions and 1976 deletions

View file

@ -4513,6 +4513,30 @@ This is a recursive, deep replacement. So in this example, both
This is implemented using the @code{package-input-rewriting} Scheme
procedure (@pxref{Defining Packages, @code{package-input-rewriting}}).
@item --with-graft=@var{package}=@var{replacement}
This is similar to @code{--with-input} but with an important difference:
instead of rebuilding all the dependency chain, @var{replacement} is
built and then @dfn{grafted} onto the binaries that were initially
referring to @var{package}. @xref{Security Updates}, for more
information on grafts.
For example, the command below grafts version 3.5.4 of GnuTLS onto Wget
and all its dependencies, replacing references to the version of GnuTLS
they currently refer to:
@example
guix build --with-graft=gnutls=gnutls@@3.5.4 wget
@end example
This has the advantage of being much faster than rebuilding everything.
But there is a caveat: it works if and only if @var{package} and
@var{replacement} are strictly compatible---for example, if they provide
a library, the application binary interface (ABI) of those libraries
must be compatible. If @var{replacement} is somehow incompatible with
@var{package}, then the resulting package may be unusable. Use with
care!
@end table
@node Additional Build Options

View file

@ -291,15 +291,17 @@ (define (namespace-file pid namespace)
(call-with-clean-exit
(lambda ()
(for-each (lambda (ns)
(call-with-input-file (namespace-file (getpid) ns)
(let ((source (namespace-file (getpid) ns))
(target (namespace-file pid ns)))
;; Joining the namespace that the process already
;; belongs to would throw an error so avoid that.
;; XXX: This /proc interface leads to TOCTTOU.
(unless (string=? (readlink source) (readlink target))
(call-with-input-file source
(lambda (current-ns-port)
(call-with-input-file (namespace-file pid ns)
(call-with-input-file target
(lambda (new-ns-port)
;; Joining the namespace that the process
;; already belongs to would throw an error.
(unless (= (port->fdes current-ns-port)
(port->fdes new-ns-port))
(setns (port->fdes new-ns-port) 0)))))))
(setns (fileno new-ns-port) 0))))))))
;; It's important that the user namespace is joined first,
;; so that the user will have the privileges to join the
;; other namespaces. Furthermore, it's important that the

View file

@ -70,6 +70,7 @@ GNU_SYSTEM_MODULES = \
%D%/packages/cdrom.scm \
%D%/packages/certs.scm \
%D%/packages/check.scm \
%D%/packages/chez.scm \
%D%/packages/ci.scm \
%D%/packages/cmake.scm \
%D%/packages/code.scm \
@ -583,8 +584,9 @@ dist_patch_DATA = \
%D%/packages/patches/gtk3-respect-GUIX_GTK3_PATH.patch \
%D%/packages/patches/gtk3-respect-GUIX_GTK3_IM_MODULE_FILE.patch \
%D%/packages/patches/gtkglext-disable-disable-deprecated.patch \
%D%/packages/patches/hdf4-shared-fortran.patch \
%D%/packages/patches/hdf4-architectures.patch \
%D%/packages/patches/hdf4-reproducibility.patch \
%D%/packages/patches/hdf4-shared-fortran.patch \
%D%/packages/patches/hdf5-config-date.patch \
%D%/packages/patches/hdf-eos5-build-shared.patch \
%D%/packages/patches/hdf-eos5-remove-gctp.patch \
@ -605,23 +607,16 @@ dist_patch_DATA = \
%D%/packages/patches/inkscape-drop-wait-for-targets.patch \
%D%/packages/patches/isl-0.11.1-aarch64-support.patch \
%D%/packages/patches/jansson-CVE-2016-4425.patch \
%D%/packages/patches/jasper-CVE-2007-2721.patch \
%D%/packages/patches/jasper-CVE-2008-3520.patch \
%D%/packages/patches/jasper-CVE-2008-3522.patch \
%D%/packages/patches/jasper-CVE-2011-4516-and-CVE-2011-4517.patch \
%D%/packages/patches/jasper-CVE-2014-8137.patch \
%D%/packages/patches/jasper-CVE-2014-8138.patch \
%D%/packages/patches/jasper-CVE-2014-8157.patch \
%D%/packages/patches/jasper-CVE-2014-8158.patch \
%D%/packages/patches/jasper-CVE-2014-9029.patch \
%D%/packages/patches/jasper-CVE-2016-1577.patch \
%D%/packages/patches/jasper-CVE-2016-1867.patch \
%D%/packages/patches/jasper-CVE-2016-2089.patch \
%D%/packages/patches/jasper-CVE-2016-2116.patch \
%D%/packages/patches/jbig2dec-ignore-testtest.patch \
%D%/packages/patches/jq-CVE-2015-8863.patch \
%D%/packages/patches/khmer-use-libraries.patch \
%D%/packages/patches/kmod-module-directory.patch \
%D%/packages/patches/kobodeluxe-paths.patch \
%D%/packages/patches/kobodeluxe-enemies-pipe-decl.patch \
%D%/packages/patches/kobodeluxe-const-charp-conversion.patch \
%D%/packages/patches/kobodeluxe-manpage-minus-not-hyphen.patch \
%D%/packages/patches/kobodeluxe-midicon-segmentation-fault.patch \
%D%/packages/patches/kobodeluxe-graphics-window-signed-char.patch \
%D%/packages/patches/laby-make-install.patch \
%D%/packages/patches/ldc-disable-tests.patch \
%D%/packages/patches/lftp-dont-save-unknown-host-fingerprint.patch \
@ -844,7 +839,6 @@ dist_patch_DATA = \
%D%/packages/patches/ttf2eot-cstddef.patch \
%D%/packages/patches/ttfautohint-source-date-epoch.patch \
%D%/packages/patches/tophat-build-with-later-seqan.patch \
%D%/packages/patches/torsocks-dns-test.patch \
%D%/packages/patches/totem-debug-format-fix.patch \
%D%/packages/patches/tuxpaint-stamps-path.patch \
%D%/packages/patches/unzip-CVE-2014-8139.patch \

View file

@ -5888,6 +5888,99 @@ (define-public r-biocinstaller
Bioconductor, CRAN, and Github.")
(license license:artistic2.0)))
(define-public r-biocviews
(package
(name "r-biocviews")
(version "1.42.0")
(source (origin
(method url-fetch)
(uri (bioconductor-uri "biocViews" version))
(sha256
(base32
"07rjk10b91pkriyq297w86199r2d3sfji3ggs9mq2gyalsa8y4b6"))))
(properties
`((upstream-name . "biocViews")))
(build-system r-build-system)
(propagated-inputs
`(("r-biobase" ,r-biobase)
("r-graph" ,r-graph)
("r-rbgl" ,r-rbgl)
("r-rcurl" ,r-rcurl)
("r-xml" ,r-xml)
("r-knitr" ,r-knitr)
("r-runit" ,r-runit)))
(home-page "http://bioconductor.org/packages/biocViews")
(synopsis "Bioconductor package categorization helper")
(description "The purpose of biocViews is to create HTML pages that
categorize packages in a Bioconductor package repository according to keywords,
also known as views, in a controlled vocabulary.")
(license license:artistic2.0)))
(define-public r-biocstyle
(package
(name "r-biocstyle")
(version "2.2.0")
(source (origin
(method url-fetch)
(uri (bioconductor-uri "BiocStyle" version))
(sha256
(base32
"0qbk23fz8cn260isd9xlh9lxfj4adar6iqzai01c4kz0p31f45za"))))
(properties
`((upstream-name . "BiocStyle")))
(build-system r-build-system)
(home-page "http://bioconductor.org/packages/BiocStyle")
(synopsis "Bioconductor formatting styles")
(description "This package provides standard formatting styles for
Bioconductor PDF and HTML documents. Package vignettes illustrate use and
functionality.")
(license license:artistic2.0)))
(define-public r-getopt
(package
(name "r-getopt")
(version "1.20.0")
(source
(origin
(method url-fetch)
(uri (cran-uri "getopt" version))
(sha256
(base32
"00f57vgnzmg7cz80rjmjz1556xqcmx8nhrlbbhaq4w7gl2ibl87r"))))
(build-system r-build-system)
(home-page "https://github.com/trevorld/getopt")
(synopsis "Command-line option processor for R")
(description
"This package is designed to be used with Rscript to write shebang
scripts that accept short and long options. Many users will prefer to
use the packages @code{optparse} or @code{argparse} which add extra
features like automatically generated help options and usage texts,
support for default values, positional argument support, etc.")
(license license:gpl2+)))
(define-public r-optparse
(package
(name "r-optparse")
(version "1.3.2")
(source
(origin
(method url-fetch)
(uri (cran-uri "optparse" version))
(sha256
(base32
"1g8as89r91xxi5j5azsd6vrfrhg84mnfx2683j7pacdp8s33radw"))))
(build-system r-build-system)
(propagated-inputs
`(("r-getopt" ,r-getopt)))
(home-page
"https://github.com/trevorld/optparse")
(synopsis "Command line option parser")
(description
"This package provides a command line parser inspired by Python's
@code{optparse} library to be used with Rscript to write shebang scripts
that accept short and long options.")
(license license:gpl2+)))
(define-public r-dnacopy
(package
(name "r-dnacopy")

472
gnu/packages/chez.scm Normal file
View file

@ -0,0 +1,472 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2016 Federico Beffa <beffa@fbengineering.ch>
;;;
;;; 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 chez)
#:use-module (gnu packages)
#:use-module ((guix licenses)
#:select (gpl2+ lgpl2.0+ lgpl2.1+ asl2.0 bsd-3 expat
public-domain))
#:use-module (guix packages)
#:use-module (guix download)
#:use-module (guix git-download)
#:use-module (guix utils)
#:use-module (guix build-system gnu)
#:use-module (gnu packages compression)
#:use-module (gnu packages ncurses)
#:use-module (gnu packages ghostscript)
#:use-module (gnu packages netpbm)
#:use-module (gnu packages tex)
#:use-module (gnu packages compression)
#:use-module (gnu packages image)
#:use-module (gnu packages xorg)
#:use-module (ice-9 match))
(define nanopass
(let ((version "1.9"))
(origin
(method url-fetch)
(uri (string-append
"https://github.com/nanopass/nanopass-framework-scheme/archive"
"/v" version ".tar.gz"))
(sha256 (base32 "11pwyy4jiwhcl2am3a4ciczacjbjkyvdizqzdglb3l1hj2gj6nv2"))
(file-name (string-append "nanopass-" version ".tar.gz")))))
(define stex
(let ((version "1.2.1"))
(origin
(method url-fetch)
(uri (string-append
"https://github.com/dybvig/stex/archive"
"/v" version ".tar.gz"))
(sha256 (base32 "03pl3f668h24dn51vccr1sj5lsba9zq3j37bnxjvdadcdaj4qy5z"))
(file-name (string-append "stex-" version ".tar.gz")))))
(define-public chez-scheme
(package
(name "chez-scheme")
(version "9.4")
(source
(origin
(method url-fetch)
(uri (string-append "https://github.com/cisco/ChezScheme/archive/"
"v" version ".tar.gz"))
(sha256
(base32 "0lprmpsjg2plc6ykgkz482zyvhkzv6gd0vnar71ph21h6zknyklz"))
(file-name (string-append "chez-scheme-" version ".tar.gz"))))
(build-system gnu-build-system)
(inputs
`(("ncurses" ,ncurses)
("libx11" ,libx11)
("xorg-rgb" ,xorg-rgb)
("nanopass" ,nanopass)
("zlib" ,zlib)
("stex" ,stex)))
(native-inputs
`(("texlive" ,texlive)
("ghostscript" ,ghostscript-gs)
("netpbm" ,netpbm)))
(native-search-paths
(list (search-path-specification
(variable "CHEZSCHEMELIBDIRS")
(files (list (string-append "lib/csv" version "-site"))))))
(outputs '("out" "doc"))
(arguments
`(#:modules ((guix build gnu-build-system)
(guix build utils)
(ice-9 match))
#:test-target "test"
#:configure-flags
(list ,(match (or (%current-target-system) (%current-system))
("x86_64-linux" '(list "--machine=ta6le"))
("i686-linux" '(list "--machine=ti3le"))
;; FIXME: Some people succeeded in cross-compiling to
;; ARM. https://github.com/cisco/ChezScheme/issues/13
(_
'())))
#:phases
(modify-phases %standard-phases
;; Adapt the custom 'configure' script.
(replace 'configure
(lambda* (#:key inputs outputs #:allow-other-keys)
(let ((out (assoc-ref outputs "out"))
(nanopass (assoc-ref inputs "nanopass"))
(stex (assoc-ref inputs "stex"))
(zlib (assoc-ref inputs "zlib"))
(unpack (assoc-ref %standard-phases 'unpack))
(patch-source-shebangs
(assoc-ref %standard-phases 'patch-source-shebangs)))
(map (match-lambda
((src orig-name new-name)
(with-directory-excursion "."
(apply unpack (list #:source src))
(apply patch-source-shebangs (list #:source src)))
(delete-file-recursively new-name)
(system* "mv" orig-name new-name)))
`((,nanopass "nanopass-framework-scheme-1.9" "nanopass")
(,stex "stex-1.2.1" "stex")))
;; The Makefile wants to download and compile "zlib". We patch
;; it to use the one from our 'zlib' package.
(substitute* "configure"
(("rmdir zlib .*$") "echo \"using system zlib\"\n"))
(substitute* (find-files "./c" "Mf-[a-zA-Z0-9.]+")
(("\\$\\{Kernel\\}: \\$\\{kernelobj\\} \\.\\./zlib/libz\\.a")
"${Kernel}: ${kernelobj}")
(("ld ([-a-zA-Z0-9_${} ]+) \\.\\./zlib/libz\\.a" all args)
(string-append "ld " args " " zlib "/lib/libz.a"))
(("\\(cd \\.\\./zlib; ([-a-zA-Z0-9=./ ]+))")
(which "true")))
(substitute* (find-files "mats" "Mf-.*")
(("^[[:space:]]+(cc ) *") "\tgcc "))
(substitute*
(find-files "." (string-append
"("
"Mf-[a-zA-Z0-9.]+"
"|Makefile[a-zA-Z0-9.]*"
"|checkin"
"|stex\\.stex"
"|newrelease"
"|workarea"
;;"|[a-zA-Z0-9.]+\\.ms" ; guile can't read
")"))
(("/bin/rm") (which "rm"))
(("/bin/ln") (which "ln"))
(("/bin/cp") (which "cp")))
(substitute* "makefiles/installsh"
(("/bin/true") (which "true")))
(substitute* "stex/Makefile"
(("PREFIX=/usr") (string-append "PREFIX=" out)))
(zero? (system* "./configure" "--threads"
(string-append "--installprefix=" out))))))
;; Installation of the documentation requires a running "chez".
(add-after 'install 'install-doc
(lambda* (#:key inputs outputs #:allow-other-keys)
(let ((bin (string-append (assoc-ref outputs "out") "/bin"))
(doc (string-append (assoc-ref outputs "doc")
"/share/doc/" ,name "-" ,version)))
(setenv "HOME" (getcwd))
(setenv "PATH" (string-append (getenv "PATH") ":" bin))
(with-directory-excursion "stex"
(system* "make" (string-append "BIN=" bin)))
(system* "make" "docs")
(with-directory-excursion "csug"
(substitute* "Makefile"
(("/tmp/csug9") doc))
(system* "make" "install")
(install-file "csug.pdf" doc))
(with-directory-excursion "release_notes"
(install-file "release_notes.pdf" doc))
#t)))
;; The binary file name is called "scheme" as the one from MIT/GNU
;; Scheme. We add a symlink to use in case both are installed.
(add-after 'install 'install-symlink
(lambda* (#:key outputs #:allow-other-keys)
(let* ((out (assoc-ref outputs "out"))
(bin (string-append out "/bin"))
(lib (string-append out "/lib"))
(name "chez-scheme"))
(symlink (string-append bin "/scheme")
(string-append bin "/" name))
(map (lambda (file)
(symlink file (string-append (dirname file)
"/" name ".boot")))
(find-files lib "scheme.boot"))
#t))))))
;; According to the documentation MIPS is not supported.
(supported-systems (delete "mips64el-linux" %supported-systems))
(home-page "http://www.scheme.com")
(synopsis "R6RS Scheme compiler and run-time")
(description
"Chez Scheme is a compiler and run-time system for the language of the
Revised^6 Report on Scheme (R6RS), with numerous extensions. The compiler
generates native code for each target processor, with support for x86, x86_64,
and 32-bit PowerPC architectures.")
(license asl2.0)))
(define-public chez-srfi
(package
(name "chez-srfi")
(version "1.0")
(source
(origin
(method url-fetch)
(uri (string-append
"https://github.com/fedeinthemix/chez-srfi/archive"
"/v" version ".tar.gz"))
(sha256
(base32 "17i4wly7bcr5kb5hf04ljpbvv4r5hsr9xsmw650fj43z9jr303gs"))
(file-name (string-append name "-" version ".tar.gz"))))
(build-system gnu-build-system)
(native-inputs
`(("chez-scheme" ,chez-scheme)))
(arguments
`(#:make-flags (let ((out (assoc-ref %outputs "out")))
(list (string-append "PREFIX=" out)))
#:test-target "test"
#:phases (modify-phases %standard-phases
(delete 'configure))))
(home-page "https://github.com/fedeinthemix/chez-srfi")
(synopsis "SRFI libraries for Chez Scheme")
(description
"This package provides a collection of SRFI libraries for Chez Scheme.")
(license expat)))
(define-public chez-web
(let ((commit "5fd177fe53f31f466bf88720d03c95a3711a8bea")
(revision "1"))
(package
(name "chez-web")
;; release 2.0 is different and doesn't work.
(version (string-append "2.0-" revision "."
(string-take commit 7)))
(source
(origin
(method git-fetch)
(uri (git-reference
(url "https://github.com/arcfide/ChezWEB.git")
(commit commit)))
(file-name (string-append name "-" version "-checkout"))
(sha256
(base32 "1dq25qygyncbfq4kwwqqgyyakfqjwhp5q23vrf3bff1p66nyfl3b"))))
(build-system gnu-build-system)
(native-inputs
`(("chez-scheme" ,chez-scheme)
("texlive" ,texlive)))
(arguments
`(#:make-flags (list (string-append "PREFIX=" %output)
(string-append "DOCDIR=" %output "/share/doc/"
,name "-" ,version)
(string-append "LIBDIR=" %output "/lib/chezweb")
(string-append "TEXDIR=" %output "/share/texmf-local"))
#:tests? #f ; no tests
#:phases
(modify-phases %standard-phases
(replace 'configure
(lambda* _
(copy-file "config.mk.template" "config.mk")
(substitute* "tangleit"
(("\\./cheztangle\\.ss" all)
(string-append "chez-scheme --program " all)))
(substitute* "weaveit"
(("mpost chezweb\\.mp")
"mpost --tex=tex chezweb.mp")
(("\\./chezweave" all)
(string-append "chez-scheme --program " all)))
(substitute* "installit"
(("-g \\$GROUP -o \\$OWNER") "")))))))
(home-page "https://github.com/arcfide/ChezWEB")
(synopsis "Hygienic Literate Programming for Chez Scheme")
(description "ChezWEB is a system for doing Knuthian style WEB
programming in Scheme.")
(license expat))))
(define-public chez-sockets
(let ((commit "bce96881c06bd69a6757a6bff139744153924140")
(revision "1"))
(package
(name "chez-sockets")
(version (string-append "0.0-" revision "."
(string-take commit 7)))
(source
(origin
(method git-fetch)
(uri (git-reference
(url "https://github.com/arcfide/chez-sockets.git")
(commit commit)))
(file-name (string-append name "-" version "-checkout"))
(sha256
(base32 "1n5fbwwz51fdzvjackgmnsgh363g9inyxv7kmzi0469cwavwcx5m"))))
(build-system gnu-build-system)
(native-inputs
`(("chez-scheme" ,chez-scheme)
("chez-web" ,chez-web)
("texlive" ,texlive)))
(arguments
`(#:tests? #f ; no tests
#:phases
(modify-phases %standard-phases
(replace 'configure
(lambda* (#:key outputs inputs #:allow-other-keys)
(let* ((out (assoc-ref outputs "out"))
(chez-web (assoc-ref inputs "chez-web"))
(chez (assoc-ref inputs "chez-scheme"))
(chez-h (dirname (car (find-files chez "scheme\\.h")))))
(substitute* "Makefile"
(("(SCHEMEH=).*$" all var)
(string-append var chez-h)))
#t)))
(add-before 'build 'tangle
(lambda _
;; just using "make" tries to build the .c files before
;; they are created.
(and (zero? (system* "make" "sockets"))
(zero? (system* "make")))))
(replace 'build
(lambda* (#:key outputs inputs #:allow-other-keys)
(let* ((out (assoc-ref outputs "out"))
(chez-site (string-append out "/lib/csv"
,(package-version chez-scheme)
"-site/arcfide")))
;; make sure Chez Scheme can find the shared libraries.
(substitute* "sockets.ss"
(("(load-shared-object) \"(socket-ffi-values\\.[sd][oy].*)\""
all cmd so)
(string-append cmd " \"" chez-site "/" so "\""))
(("sockets-stub\\.[sd][oy].*" all)
(string-append chez-site "/" all)))
;; to compile chez-sockets, the .so files must be
;; installed (because of the absolute path we
;; inserted above).
(for-each (lambda (f d) (install-file f d))
'("socket-ffi-values.so" "sockets-stub.so")
(list chez-site chez-site))
(zero? (system "echo '(compile-file \"sockets.sls\")' | scheme -q")))))
(replace 'install
(lambda* (#:key outputs inputs #:allow-other-keys)
(let* ((out (assoc-ref outputs "out"))
(lib (string-append out "/lib/chez-sockets"))
(doc (string-append out "/share/doc/" ,name "-" ,version))
(chez-site (string-append out "/lib/csv"
,(package-version chez-scheme)
"-site/arcfide")))
(for-each (lambda (f d) (install-file f d))
'("sockets.pdf" "sockets.so")
(list doc chez-site))
#t))))))
(home-page "https://github.com/arcfide/chez-sockets")
(synopsis "Extensible sockets library for Chez Scheme")
(description "Chez-sockets is an extensible sockets library for
Chez Scheme.")
(license expat))))
;; Help function for Chez Scheme to add the current path to
;; CHEZSCHEMELIBDIRS.
(define chez-configure
'(lambda _
(let ((chez-env (getenv "CHEZSCHEMELIBDIRS")))
(setenv "CHEZSCHEMELIBDIRS"
(if chez-env
(string-append ".:" chez-env)
"."))
#t)))
;; Help function to define make flags for some Chez Scheme custom make
;; files.
(define (chez-make-flags name version)
`(let ((out (assoc-ref %outputs "out")))
(list (string-append "PREFIX=" out)
(string-append "DOCDIR=" out "/share/doc/"
,name "-" ,version))))
(define-public chez-matchable
(package
(name "chez-matchable")
(version "20160306")
(home-page "https://github.com/fedeinthemix/chez-matchable")
(source
(origin
(method url-fetch)
(uri (string-append home-page "/archive" "/v" version ".tar.gz"))
(sha256
(base32 "0cl4vc6487pikjq159pj4n5ghyaax31nywb5n4yn1682h3ir1hs0"))
(file-name (string-append name "-" version ".tar.gz"))))
(build-system gnu-build-system)
(inputs
`(("chez-srfi" ,chez-srfi))) ; for tests
(native-inputs
`(("chez-scheme" ,chez-scheme)))
(arguments
`(#:make-flags ,(chez-make-flags name version)
#:test-target "test"
#:phases (modify-phases %standard-phases
(replace 'configure ,chez-configure))))
(synopsis "Portable hygienic pattern matcher for Scheme")
(description "This package provides a superset of the popular Scheme
@code{match} package by Andrew Wright, written in fully portable
@code{syntax-rules} and thus preserving hygiene.")
(license public-domain)))
(define-public chez-irregex
(package
(name "chez-irregex")
(version "0.9.4")
(source
(origin
(method url-fetch)
(uri (string-append
"https://github.com/fedeinthemix/chez-irregex/archive"
"/v" version ".tar.gz"))
(sha256
(base32 "0ywy5syaw549a58viz68dmgnv756ic705rcnlqxgjq27lnaim53b"))
(file-name (string-append name "-" version ".tar.gz"))))
(build-system gnu-build-system)
(inputs
`(("chez-matchable" ,chez-matchable))) ; for tests
(propagated-inputs
`(("chez-srfi" ,chez-srfi))) ; for irregex-utils
(native-inputs
`(("chez-scheme" ,chez-scheme)))
(arguments
`(#:make-flags ,(chez-make-flags name version)
#:test-target "test"
#:phases (modify-phases %standard-phases
(replace 'configure ,chez-configure))))
(home-page "https://github.com/fedeinthemix/chez-irregex")
(synopsis "Portable regular expression library for Scheme")
(description "This package provides a portable and efficient
R[4567]RS implementation of regular expressions, supporting both POSIX
syntax with various (irregular) PCRE extensions, as well as SCSH's SRE
syntax, with various aliases for commonly used patterns.")
(license bsd-3)))
(define-public chez-fmt
(package
(name "chez-fmt")
(version "0.8.11")
(source
(origin
(method url-fetch)
(uri (string-append
"http://synthcode.com/scheme/fmt/fmt-" version ".tar.gz"))
(sha256
(base32 "1zxqlw1jyg85yzclylh8bp2b3fwcy3l3xal68jw837n5illvsjcl"))
(file-name (string-append name "-" version ".tar.gz"))))
(build-system gnu-build-system)
(propagated-inputs
`(("chez-srfi" ,chez-srfi))) ; for irregex-utils
(native-inputs
`(("chez-scheme" ,chez-scheme)))
(arguments
`(#:make-flags ,(chez-make-flags name version)
#:test-target "chez-check"
#:phases
(modify-phases %standard-phases
(replace 'configure ,chez-configure)
(replace 'build
(lambda* (#:key (make-flags '()) #:allow-other-keys)
(zero? (apply system* "make" "chez-build" make-flags))))
(replace 'install
(lambda* (#:key (make-flags '()) #:allow-other-keys)
(zero? (apply system* "make" "chez-install" make-flags)))))))
(home-page "http://synthcode.com/scheme/fmt")
(synopsis "Combinator formatting library for Chez Scheme")
(description "This package provides a library of procedures for
formatting Scheme objects to text in various ways, and for easily
concatenating, composing and extending these formatters efficiently
without resorting to capturing and manipulating intermediate
strings.")
(license bsd-3)))

View file

@ -210,7 +210,7 @@ (define-public bdb-5.3
(define-public mysql
(package
(name "mysql")
(version "5.7.15")
(version "5.7.16")
(source (origin
(method url-fetch)
(uri (list (string-append
@ -222,7 +222,7 @@ (define-public mysql
name "-" version ".tar.gz")))
(sha256
(base32
"0mlrxcvkn6bf869hjw9fb6m24ak26ndffnd91b4mknmz8cqkb1ch"))))
"198qhd9bdm0fnpp307mgby2aar92yzya0937kxi7bcpdfjcvada9"))))
(build-system cmake-build-system)
(arguments
`(#:configure-flags
@ -285,7 +285,7 @@ (define-public mysql
(define-public mariadb
(package
(name "mariadb")
(version "10.1.17")
(version "10.1.18")
(source (origin
(method url-fetch)
(uri (string-append "https://downloads.mariadb.org/f/"
@ -293,7 +293,7 @@ (define-public mariadb
name "-" version ".tar.gz"))
(sha256
(base32
"1ddalhxxcn95qp5b50z213niylcd0s6bqphid0c7c624wg2mm92c"))))
"0wrvhyck95czhz553834i9im7ljvn8k2byakcinlji7zx43njcyp"))))
(build-system cmake-build-system)
(arguments
'(#:configure-flags

View file

@ -4,6 +4,7 @@
;;; Copyright © 2016 Ricardo Wurmus <rekado@elephly.net>
;;; Copyright © 2016 Efraim Flashner <efraim@flashner.co.il>
;;; Copyright © 2016 John Darrington <jmd@gnu.org>
;;; Copyright © 2016 ng0 <ng0@we.make.ritual.n0.is>
;;;
;;; This file is part of GNU Guix.
;;;
@ -21,9 +22,12 @@
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (gnu packages dns)
#:use-module (gnu packages autotools)
#:use-module (gnu packages databases)
#:use-module (gnu packages groff)
#:use-module (gnu packages linux)
#:use-module (gnu packages perl)
#:use-module (gnu packages pkg-config)
#:use-module (gnu packages tls)
#:use-module (gnu packages xml)
#:use-module ((guix licenses) #:prefix license:)
@ -128,3 +132,32 @@ (define-public bind
(home-page "https://www.isc.org/downloads/bind")
(license (list license:isc))))
(define-public libasr
(package
(name "libasr")
(version "201602131606")
(source
(origin
(method url-fetch)
(uri (string-append "https://www.opensmtpd.org/archives/"
name "-" version ".tar.gz"))
(sha256
(base32
"18kdmbjsxrfai16d66qslp48b1zf7gr8him2jj5dcqgbsl44ls75"))))
(build-system gnu-build-system)
(native-inputs
`(("autoconf" ,autoconf)
("automake" ,automake)
("pkg-config" ,pkg-config)
("groff" ,groff)))
(home-page "https://www.opensmtpd.org")
(synopsis "Asynchronous resolver library by the OpenBSD project")
(description
"libasr is a free, simple and portable asynchronous resolver library.
It allows to run DNS queries and perform hostname resolutions in a fully
asynchronous fashion.")
(license (list license:isc
license:bsd-2 ; last part of getrrsetbyname_async.c
license:bsd-3
(license:non-copyleft "file://LICENSE") ; includes.h
license:openssl))))

View file

@ -3,6 +3,7 @@
;;; Copyright © 2015 Federico Beffa <beffa@fbengineering.ch>
;;; Copyright © 2016 Efraim Flashner <efraim@flashner.co.il>
;;; Copyright © 2016 David Thompson <davet@gnu.org>
;;; Copyright © 2016 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
@ -29,11 +30,14 @@ (define-module (gnu packages engineering)
#:use-module (guix utils)
#:use-module ((guix licenses) #:prefix license:)
#:use-module (guix build-system gnu)
#:use-module (guix build-system cmake)
#:use-module (gnu packages)
#:use-module (gnu packages algebra)
#:use-module (gnu packages autotools)
#:use-module (gnu packages base)
#:use-module (gnu packages bison)
#:use-module (gnu packages boost)
#:use-module (gnu packages check)
#:use-module (gnu packages compression)
#:use-module (gnu packages flex)
#:use-module (gnu packages fontutils)
@ -45,6 +49,7 @@ (define-module (gnu packages engineering)
#:use-module (gnu packages gnome)
#:use-module (gnu packages gtk)
#:use-module (gnu packages guile)
#:use-module (gnu packages image)
#:use-module (gnu packages linux) ;FIXME: for pcb
#:use-module (gnu packages m4)
#:use-module (gnu packages maths)
@ -459,3 +464,100 @@ (define-public gerbv
image, etc. Besides viewing Gerbers, you may also view Excellon drill files
as well as pick-place files.")
(license license:gpl2+)))
(define-public ao
(let ((commit "0bc2354b8dcd1a82a0fd6647706b126045e52734"))
(package
(name "ao-cad") ;XXX: really "ao", but it collides with libao
(version (string-append "0." (string-take commit 7)))
(source (origin
(method git-fetch)
(uri (git-reference
(url "https://github.com/mkeeter/ao")
(commit commit)))
(sha256
(base32
"0lm7iljklafs8dhlvaab2yhwx4xymrdjrqk9c5xvn59hlvbgl1j5"))
(file-name (string-append name "-" version "-checkout"))
(modules '((guix build utils)))
(snippet
;; Remove bundled libraries: Eigen, glm, and catch. TODO:
;; Unbundle efsw <https://github.com/diegostamigni/efsw>.
'(begin
(delete-file-recursively "vendor")
;; Use #include <catch.hpp>.
(substitute* (find-files "." "\\.[ch]pp$")
(("catch/catch\\.hpp")
"catch.hpp"))))))
(build-system cmake-build-system)
(arguments
`(;; Have the RUNPATH of libao.so point to $libdir, where libefsw.so
;; lives.
#:configure-flags (list (string-append "-DCMAKE_SHARED_LINKER_FLAGS="
"-Wl,-rpath="
(assoc-ref %outputs "out")
"/lib"))
#:phases
(modify-phases %standard-phases
(add-before 'build 'add-eigen-to-search-path
(lambda* (#:key inputs #:allow-other-keys)
;; Allow things to find our own Eigen and Catch.
(let ((eigen (assoc-ref inputs "eigen")))
(setenv "CPLUS_INCLUDE_PATH"
(string-append eigen "/include/eigen3:"
(getenv "CPLUS_INCLUDE_PATH")))
#t)))
(add-after 'install 'install-guile-bindings
(lambda* (#:key outputs #:allow-other-keys)
;; Install the Guile bindings (the build system only installs
;; libao.so.)
(let* ((out (assoc-ref outputs "out"))
(moddir (string-append out "/share/guile/site/2.0")))
(install-file "bind/libao.so"
(string-append out "/lib"))
;; Go to the source directory.
(with-directory-excursion ,(string-append "../"
name "-" version
"-checkout")
(substitute* "bind/guile/ao/bind.scm"
(("\\(define libao \\(dynamic-link .*$")
(string-append "(define libao (dynamic-link \""
out "/lib/libao\")) ;")))
(for-each (lambda (file)
(install-file file
(string-append moddir
"/ao")))
(find-files "bind/guile" "\\.scm$"))
(substitute* "bin/ao-guile"
(("\\(add-to-load-path .*")
(string-append "(add-to-load-path \"" moddir "\")")))
(install-file "bin/ao-guile"
(string-append out "/bin"))
#t)))))))
(native-inputs
`(("pkg-config" ,pkg-config)))
(inputs
`(("boost" ,boost)
("catch" ,catch-framework)
("libpng" ,libpng)
("glfw" ,glfw)
("libepoxy" ,libepoxy)
("eigen" ,eigen)
("glm" ,glm)
("guile" ,guile-2.0)))
(home-page "http://www.mattkeeter.com/projects/ao/")
(synopsis "Tool for programmatic computer-aided design")
(description
"Ao is a tool for programmatic computer-aided design (CAD). In Ao,
solid models are defined as Scheme scripts, and there are no opaque function
calls into the geometry kernel: everything is visible to the user. Even
fundamental, primitive shapes are represented as code in the user-level
language.")
(license (list license:lgpl2.1+ ;library
license:gpl2+))))) ;Guile bindings

View file

@ -196,7 +196,7 @@ (define-public rage
(define-public enlightenment
(package
(name "enlightenment")
(version "0.21.2")
(version "0.21.3")
(source (origin
(method url-fetch)
(uri
@ -204,7 +204,7 @@ (define-public enlightenment
name "/" name "-" version ".tar.xz"))
(sha256
(base32
"0fi5dxrprnvhnn2y51gnfpsjj44snriqi20k20a73vhaqxfn8xx8"))))
"1ljzcq775njhbcaj8vdnypf2rgc6yqqdwfkf7c22603qvv9if1dr"))))
(build-system gnu-build-system)
(arguments
`(#:configure-flags '("--enable-mount-eeze")))

View file

@ -23,6 +23,7 @@
;;; Copyright © 2016 Alex Griffin <a@ajgrf.com>
;;; Copyright © 2016 Efraim Flashner <efraim@flashner.co.il>
;;; Copyright © 2016 Jan Nieuwenhuizen <janneke@gnu.org>
;;; Copyright © 2016 Steve Webber <webber.sl@gmail.com>
;;;
;;; This file is part of GNU Guix.
;;;
@ -2966,3 +2967,35 @@ (define-public hyperrogue
license:public-domain ; src/direntx.*
license:zlib ; src/savepng.*
license:gpl2+)))) ; remaining files
(define-public kobodeluxe
(package
(name "kobodeluxe")
(version "0.5.1")
(source (origin
(method url-fetch)
(uri (string-append "http://olofson.net/kobodl/download/KoboDeluxe-"
version ".tar.bz2"))
(sha256
(base32
"0b2wvdpnmaibsy419c16dfwj5kvd3pccby2aaqvm964x74592yqg"))
(patches (search-patches
"kobodeluxe-const-charp-conversion.patch"
"kobodeluxe-enemies-pipe-decl.patch"
"kobodeluxe-graphics-window-signed-char.patch"
"kobodeluxe-manpage-minus-not-hyphen.patch"
"kobodeluxe-midicon-segmentation-fault.patch"
"kobodeluxe-paths.patch"))))
(build-system gnu-build-system)
(arguments
'(#:configure-flags
(list (string-append "CPPFLAGS=-I"
(assoc-ref %build-inputs "sdl-union")
"/include/SDL"))))
(inputs `(("sdl-union" ,(sdl-union (list sdl sdl-image)))))
(synopsis "Shooter with space station destruction")
(description
"Kobo Deluxe is an enhanced version of Akira Higuchi's XKobo graphical game
for Un*x systems with X11.")
(home-page "http://olofson.net/kobodl/")
(license license:gpl2+)))

View file

@ -570,12 +570,15 @@ (define-public glfw
(native-inputs
`(("doxygen" ,doxygen)
("unzip" ,unzip)))
(inputs
`(("mesa" ,mesa)
(propagated-inputs
`(("mesa" ,mesa) ;included in public headers
;; These are in 'Requires.private' of 'glfw3.pc'.
("libx11" ,libx11)
("libxrandr" ,libxrandr)
("libxinerama" ,libxinerama)
("libxcursor" ,libxcursor)))
("libxcursor" ,libxcursor)
("libxxf86vm" ,libxxf86vm)))
(home-page "http://www.glfw.org")
(synopsis "OpenGL application development library")
(description

View file

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2015 Federico Beffa <beffa@fbengineering.ch>
;;; Copyright © 2015, 2016 Federico Beffa <beffa@fbengineering.ch>
;;; Copyright © 2015 Siniša Biđin <sinisa@bidin.eu>
;;; Copyright © 2015 Paul van der Walt <paul@denknerd.org>
;;; Copyright © 2015 Eric Bavier <bavier@member.fsf.org>
@ -44,6 +44,7 @@ (define-module (gnu packages haskell)
#:use-module (gnu packages libffi)
#:use-module (gnu packages libedit)
#:use-module (gnu packages lua)
#:use-module (gnu packages maths)
#:use-module (gnu packages multiprecision)
#:use-module (gnu packages ncurses)
#:use-module (gnu packages python)
@ -260,6 +261,134 @@ (define-public ghc
interactive environment for the functional language Haskell.")
(license license:bsd-3)))
(define-public ghc-8
(package
(name "ghc")
(version "8.0.1")
(source
(origin
(method url-fetch)
(uri (string-append "https://www.haskell.org/ghc/dist/"
version "/" name "-" version "-src.tar.xz"))
(sha256
(base32 "1lniqy29djhjkddnailpaqhlqh4ld2mqvb1fxgxw1qqjhz6j1ywh"))))
(build-system gnu-build-system)
(supported-systems '("i686-linux" "x86_64-linux"))
(outputs '("out" "doc"))
(inputs
`(("gmp" ,gmp)
("ncurses" ,ncurses)
("libffi" ,libffi)
("libedit" ,libedit)
("ghc-testsuite"
,(origin
(method url-fetch)
(uri (string-append
"https://www.haskell.org/ghc/dist/"
version "/" name "-" version "-testsuite.tar.xz"))
(sha256
(base32 "0lc1vjivkxn01aw3jg2gd7fmqb5pj7a5j987c7pn5r7caqv1cmxw"))))))
(native-inputs
`(("perl" ,perl)
("python" ,python-2) ; for tests
("ghostscript" ,ghostscript) ; for tests
;; GHC is built with GHC.
("ghc-bootstrap" ,ghc)))
(arguments
`(#:test-target "test"
;; We get a smaller number of test failures by disabling parallel test
;; execution.
#:parallel-tests? #f
;; The DSOs use $ORIGIN to refer to each other, but (guix build
;; gremlin) doesn't support it yet, so skip this phase.
#:validate-runpath? #f
;; Don't pass --build=<triplet>, because the configure script
;; auto-detects slightly different triplets for --host and --target and
;; then complains that they don't match.
#:build #f
#:modules ((guix build gnu-build-system)
(guix build utils)
(guix build rpath)
(srfi srfi-26)
(srfi srfi-1))
#:imported-modules (,@%gnu-build-system-modules
(guix build rpath))
#:configure-flags
(list
(string-append "--with-gmp-libraries="
(assoc-ref %build-inputs "gmp") "/lib")
(string-append "--with-gmp-includes="
(assoc-ref %build-inputs "gmp") "/include")
"--with-system-libffi"
(string-append "--with-ffi-libraries="
(assoc-ref %build-inputs "libffi") "/lib")
(string-append "--with-ffi-includes="
(assoc-ref %build-inputs "libffi") "/include")
(string-append "--with-curses-libraries="
(assoc-ref %build-inputs "ncurses") "/lib")
(string-append "--with-curses-includes="
(assoc-ref %build-inputs "ncurses") "/include"))
#:phases
(modify-phases %standard-phases
(add-after 'unpack 'unpack-testsuite
(lambda* (#:key inputs #:allow-other-keys)
(with-directory-excursion ".."
(copy-file (assoc-ref inputs "ghc-testsuite")
"ghc-testsuite.tar.xz")
(zero? (system* "tar" "xvf" "ghc-testsuite.tar.xz")))))
(add-before 'build 'fix-lib-paths
(lambda _
(substitute*
(list "libraries/process/System/Process/Posix.hs"
"libraries/process/tests/process001.hs"
"libraries/process/tests/process002.hs"
"libraries/unix/cbits/execvpe.c")
(("/bin/sh") (which "sh"))
(("/bin/ls") (which "ls")))
#t))
(add-before 'build 'fix-environment
(lambda _
(unsetenv "GHC_PACKAGE_PATH")
(setenv "CONFIG_SHELL" (which "bash"))
#t))
(add-before 'check 'fix-testsuite
(lambda _
(substitute*
(list "testsuite/timeout/Makefile"
"testsuite/timeout/timeout.py"
"testsuite/timeout/timeout.hs"
"testsuite/tests/programs/life_space_leak/life.test")
(("/bin/sh") (which "sh"))
(("/bin/rm") "rm"))
#t))
;; the testsuite can't find shared libraries.
(add-before 'check 'configure-testsuite
(lambda* (#:key inputs #:allow-other-keys)
(let* ((gmp (assoc-ref inputs "gmp"))
(gmp-lib (string-append gmp "/lib"))
(ffi (assoc-ref inputs "libffi"))
(ffi-lib (string-append ffi "/lib"))
(ncurses (assoc-ref inputs "ncurses"))
(ncurses-lib (string-append ncurses "/lib")))
(setenv "LD_LIBRARY_PATH"
(string-append gmp-lib ":" ffi-lib ":" ncurses-lib))
#t))))))
(native-search-paths (list (search-path-specification
(variable "GHC_PACKAGE_PATH")
(files (list
(string-append "lib/ghc-" version)))
(file-pattern ".*\\.conf\\.d$")
(file-type 'directory))))
(home-page "https://www.haskell.org/ghc")
(synopsis "The Glasgow Haskell Compiler")
(description
"The Glasgow Haskell Compiler (GHC) is a state-of-the-art compiler and
interactive environment for the functional language Haskell.")
(license license:bsd-3)))
(define-public ghc-hostname
(package
(name "ghc-hostname")
@ -7598,4 +7727,179 @@ (define-public ghc-system-fileio
In particular, this library supports working with POSIX files that have paths
which can't be decoded in the current locale encoding.")
(license license:expat)))
(define-public ghc-storable-complex
(package
(name "ghc-storable-complex")
(version "0.2.2")
(source
(origin
(method url-fetch)
(uri (string-append
"http://hackage.haskell.org/package/storable-complex/storable-complex-"
version ".tar.gz"))
(sha256
(base32 "01kwwkpbfjrv26vj83cd92px5qbq1bpgxj0r45534aksqhany1xb"))))
(build-system haskell-build-system)
(home-page "https://github.com/cartazio/storable-complex")
(synopsis "Haskell Storable instance for Complex")
(description "This package provides a Haskell library including a
Storable instance for Complex which is binary compatible with C99, C++
and Fortran complex data types.")
(license license:bsd-3)))
(define-public ghc-hmatrix
(package
(name "ghc-hmatrix")
(version "0.17.0.2")
(source
(origin
(method url-fetch)
(uri (string-append
"http://hackage.haskell.org/package/hmatrix/hmatrix-"
version ".tar.gz"))
(sha256
(base32 "1fgsrh2y9y971pzrd3767rg97bjr1ghpdvwmn1nn65s90rc9bv98"))))
(build-system haskell-build-system)
(inputs
`(("ghc-random" ,ghc-random)
("ghc-split" ,ghc-split)
("ghc-storable-complex" ,ghc-storable-complex)
("ghc-vector" ,ghc-vector)
;;("openblas" ,openblas)
("lapack" ,lapack)))
;; Guix's OpenBLAS is built with the flag "NO_LAPACK=1" which
;; disables inclusion of the LAPACK functions.
;; (arguments `(#:configure-flags '("--flags=openblas")))
(home-page "https://github.com/albertoruiz/hmatrix")
(synopsis "Haskell numeric linear algebra library")
(description "The HMatrix package provices a Haskell library for
dealing with linear systems, matrix decompositions, and other
numerical computations based on BLAS and LAPACK.")
(license license:bsd-3)))
(define-public ghc-hmatrix-gsl
(package
(name "ghc-hmatrix-gsl")
(version "0.17.0.0")
(source
(origin
(method url-fetch)
(uri (string-append
"http://hackage.haskell.org/package/hmatrix-gsl/hmatrix-gsl-"
version ".tar.gz"))
(sha256
(base32 "1jbqwn9d2nldc4klhy0n8gcxr889h0daw2mjfhwgksfy1bwfjl7w"))))
(build-system haskell-build-system)
(inputs
`(("ghc-hmatrix" ,ghc-hmatrix)
("ghc-vector" ,ghc-vector)
("ghc-random" ,ghc-random)
("gsl" ,gsl)))
(native-inputs `(("pkg-config" ,pkg-config)))
(home-page "https://github.com/albertoruiz/hmatrix")
(synopsis "Haskell GSL binding")
(description "This Haskell library provides a purely functional
interface to selected numerical computations, internally implemented
using GSL.")
(license license:gpl3+)))
(define-public ghc-hmatrix-special
(package
(name "ghc-hmatrix-special")
(version "0.4.0.0")
(source
(origin
(method url-fetch)
(uri
(string-append
"http://hackage.haskell.org/package/hmatrix-special/hmatrix-special-"
version ".tar.gz"))
(sha256
(base32 "0cr9y3swzj7slrd84g1nhdkp1kpq4q5ihwapmiaidpr2bv3hrfhz"))))
(build-system haskell-build-system)
(inputs
`(("ghc-hmatrix" ,ghc-hmatrix)
("ghc-hmatrix-gsl" ,ghc-hmatrix-gsl)))
(home-page "https://github.com/albertoruiz/hmatrix")
(synopsis "Haskell interface to GSL special functions")
(description "This library provides an interface to GSL special
functions for Haskell.")
(license license:gpl3+)))
(define-public ghc-hmatrix-gsl-stats
(package
(name "ghc-hmatrix-gsl-stats")
(version "0.4.1.3")
(source
(origin
(method url-fetch)
(uri
(string-append
"http://hackage.haskell.org/package/hmatrix-gsl-stats/hmatrix-gsl-stats-"
version ".tar.gz"))
(sha256
(base32 "0f3pzi494n4js0xiq5b38n07cnby0h9da6gmwywf8plvxm9271fl"))))
(build-system haskell-build-system)
(inputs
`(("ghc-vector" ,ghc-vector)
("ghc-storable-complex" ,ghc-storable-complex)
("ghc-hmatrix" ,ghc-hmatrix)
("gsl" ,gsl)))
(native-inputs `(("pkg-config" ,pkg-config)))
(home-page "http://code.haskell.org/hmatrix-gsl-stats")
(synopsis "GSL Statistics interface for Haskell")
(description "This Haskell library provides a purely functional
interface for statistics based on hmatrix and GSL.")
(license license:bsd-3)))
(define-public ghc-easyplot
(package
(name "ghc-easyplot")
(version "1.0")
(source
(origin
(method url-fetch)
(uri (string-append
"http://hackage.haskell.org/package/easyplot/easyplot-"
version ".tar.gz"))
(sha256
(base32 "18kndgvdj2apjpfga6fp7m16y1gx8zrwp3c5vfj03sx4v6jvciqk"))))
(build-system haskell-build-system)
(propagated-inputs `(("gnuplot" ,gnuplot)))
(arguments
`(#:phases (modify-phases %standard-phases
(add-after 'unpack 'fix-setup-suffix
(lambda _ (rename-file "Setup.lhs" "Setup.hs") #t)))))
(home-page "http://hub.darcs.net/scravy/easyplot")
(synopsis "Haskell plotting library based on gnuplot")
(description "This package provides a plotting library for
Haskell, using gnuplot for rendering.")
(license license:expat)))
(define-public ghc-hashtables
(package
(name "ghc-hashtables")
(version "1.2.1.0")
(source
(origin
(method url-fetch)
(uri (string-append
"http://hackage.haskell.org/package/hashtables/hashtables-"
version ".tar.gz"))
(sha256
(base32 "1b6w9xznk42732vpd8ili60k12yq190xnajgga0iwbdpyg424lgg"))))
(build-system haskell-build-system)
(inputs
`(("ghc-hashable" ,ghc-hashable)
("ghc-primitive" ,ghc-primitive)
("ghc-vector" ,ghc-vector)))
(home-page "http://github.com/gregorycollins/hashtables")
(synopsis "Haskell Mutable hash tables in the ST monad")
(description "This package provides a Haskell library including a
couple of different implementations of mutable hash tables in the ST
monad, as well as a typeclass abstracting their common operations, and
a set of wrappers to use the hash tables in the IO monad.")
(license license:bsd-3)))
;;; haskell.scm ends here

View file

@ -770,31 +770,15 @@ (define-public devil
(define-public jasper
(package
(name "jasper")
(version "1.900.1")
(version "1.900.5")
(source (origin
(method url-fetch)
(uri (string-append "https://www.ece.uvic.ca/~frodo/jasper"
"/software/jasper-" version ".zip"))
"/software/jasper-" version ".tar.gz"))
(sha256
(base32
"154l7zk7yh3v8l2l6zm5s2alvd2fzkp6c9i18iajfbna5af5m43b"))
(patches (search-patches
"jasper-CVE-2007-2721.patch"
"jasper-CVE-2008-3520.patch"
"jasper-CVE-2008-3522.patch"
"jasper-CVE-2011-4516-and-CVE-2011-4517.patch"
"jasper-CVE-2014-8137.patch"
"jasper-CVE-2014-8138.patch"
"jasper-CVE-2014-8157.patch"
"jasper-CVE-2014-8158.patch"
"jasper-CVE-2014-9029.patch"
"jasper-CVE-2016-1577.patch"
"jasper-CVE-2016-1867.patch"
"jasper-CVE-2016-2089.patch"
"jasper-CVE-2016-2116.patch"))))
"1fvy4ngc6064g128q4484qpinsn05y9qw6lrccc4czhalla2w26m"))))
(build-system gnu-build-system)
(native-inputs
`(("unzip" ,unzip)))
(synopsis "JPEG-2000 library")
(description "The JasPer Project is an initiative to provide a reference
implementation of the codec specified in the JPEG-2000 Part-1 standard (i.e.,
@ -805,7 +789,7 @@ (define-public jasper
(define-public zimg
(package
(name "zimg")
(version "2.2.1")
(version "2.3")
(source
(origin
(method url-fetch)
@ -814,7 +798,7 @@ (define-public zimg
(file-name (string-append name "-" version ".tar.gz"))
(sha256
(base32
"0m2gjpkb0dlg4j77nr41z284zvyfq9qg3ahsv8p1xy8jfr7h1hqa"))))
"1yh6kkq8596a9cxcmcxzqvwbwmxwqapwsq31xpccznw6z62j75h9"))))
(build-system gnu-build-system)
(native-inputs
`(("autoconf" ,autoconf)

View file

@ -46,19 +46,23 @@ (define-module (gnu packages mail)
#:use-module (gnu packages cyrus-sasl)
#:use-module (gnu packages databases)
#:use-module (gnu packages dejagnu)
#:use-module (gnu packages dns)
#:use-module (gnu packages emacs)
#:use-module (gnu packages enchant)
#:use-module (gnu packages ghostscript)
#:use-module (gnu packages glib)
#:use-module (gnu packages gnome)
#:use-module (gnu packages gnupg)
#:use-module (gnu packages groff)
#:use-module (gnu packages gsasl)
#:use-module (gnu packages gtk)
#:use-module (gnu packages guile)
#:use-module (gnu packages flex)
#:use-module (gnu packages libcanberra)
#:use-module (gnu packages libevent)
#:use-module (gnu packages libidn)
#:use-module (gnu packages linux)
#:use-module (gnu packages lua)
#:use-module (gnu packages m4)
#:use-module (gnu packages ncurses)
#:use-module (gnu packages pcre)
@ -81,7 +85,8 @@ (define-module (gnu packages mail)
#:use-module ((guix licenses)
#:select (gpl2 gpl2+ gpl3 gpl3+ lgpl2.1 lgpl2.1+ lgpl3+
non-copyleft (expat . license:expat) bsd-3
public-domain))
public-domain bsd-4 isc (openssl . license:openssl)
bsd-2))
#:use-module (guix packages)
#:use-module (guix download)
#:use-module (guix git-download)
@ -1541,3 +1546,121 @@ (define-public sendmail
(license (non-copyleft "file://LICENSE"
"See LICENSE in the distribution."))))
(define-public opensmtpd
(package
(name "opensmtpd")
(version "5.9.2p1")
(source (origin
(method url-fetch)
(uri (string-append "https://www.opensmtpd.org/archives/"
name "-" version ".tar.gz"))
(sha256
(base32
"07d7f1m5sxyz6mkk228rcm7fsf7350994ayvmhgph333q5rz48im"))))
(build-system gnu-build-system)
(inputs
`(("bdb" ,bdb)
("libressl" ,libressl)
("libevent" ,libevent)
("libasr" ,libasr)
("linux-pam" ,linux-pam)
("zlib" ,zlib)))
(native-inputs
`(("bison" ,bison)))
(arguments
`(#:configure-flags (list "--with-table-db" "--localstatedir=/var"
"--with-user-smtpd=smtpd" "--with-user-queue=smtpq"
"--with-group-queue=smtpq")
#:phases
(modify-phases %standard-phases
;; OpenSMTPD provides a single utility smtpctl to control the daemon and
;; the local submission subsystem. To accomodate systems that require
;; historical interfaces such as sendmail, newaliases or makemap, the
;; smtpctl utility can operate in compatibility mode if called with the
;; historical name.
(add-after 'install 'install-compabilitymode
(lambda _
(let* ((out (assoc-ref %outputs "out"))
(sbin (string-append out "/sbin/")))
(for-each (lambda (cmd)
(symlink "smtpctl" (string-append sbin cmd)))
'("makemap" "sendmail" "send-mail"
"newaliases" "mailq")))
#t)))))
(synopsis "Lightweight SMTP daemon")
(description
"OpenSMTPD is an implementation of the server-side SMTP protocol, with
some additional standard extensions. It allows ordinary machines to exchange
e-mails with other systems speaking the SMTP protocol.")
(home-page "https://www.opensmtpd.org")
(license (list bsd-2 bsd-3 bsd-4 (non-copyleft "file://COPYING")
public-domain isc openssl))))
(define-public opensmtpd-extras
(package
(name "opensmtpd-extras")
(version "5.7.1")
(source (origin
(method url-fetch)
(uri (string-append "https://www.opensmtpd.org/archives/"
name "-" version ".tar.gz"))
(sha256
(base32
"1kld4hxgz792s0cb2gl7m2n618ikzqkj88w5dhaxdrxg4x2c4vdm"))))
(build-system gnu-build-system)
(inputs
`(("libressl" ,libressl)
("libevent" ,libevent)
("libasr" ,libasr)
("python-2" ,python-2)
("opensmtpd" ,opensmtpd)
("perl" ,perl)
("lua" ,lua)
("postgresql" ,postgresql)
("sqlite" ,sqlite)
("linux-pam" ,linux-pam)))
(native-inputs
`(("bison" ,bison)
("pkg-config" ,pkg-config)
("groff" ,groff)
("automake" ,automake)
("autoconf" ,autoconf)))
(arguments
`(;; We have to configure it like this because the default checks for for example
;; python in /usr/local/bin, /usr/bin and fails otherwise.
#:configure-flags (list
"--with-filter-clamav" "--with-filter-dkim-signer"
"--with-filter-dnsbl" "--with-filter-lua"
"--with-filter-monkey" "--with-filter-pause"
"--with-filter-perl" "--with-filter-python"
"--with-filter-regex" "--with-filter-spamassassin"
"--with-filter-stub" "--with-filter-trace"
"--with-filter-void"
"--with-queue-null" "--with-queue-python"
"--with-queue-ram" "--with-queue-stub"
"--with-scheduler-python" "--with-scheduler-ram"
"--with-scheduler-stub"
"--with-table-ldap" ; "--with-table-mysql"
"--with-table-passwd" "--with-table-postgres"
"--with-table-python" "--with-table-socketmap"
"--with-table-sqlite" "--with-table-stub"
;;"--with-table-redis" ; TODO: package hiredis
"--with-user=smtpd" "--with-privsep-user=smtpd"
"--localstatedir=/var" "--sysconfdir=/etc"
"--with-lua-type=lua" ; can use lua or luajit
(string-append "--with-python="
(assoc-ref %build-inputs "python-2"))
(string-append "--with-lua="
(assoc-ref %build-inputs "lua")))))
(license (list bsd-2 bsd-3 bsd-4 non-copyleft
public-domain isc openssl))
(synopsis "Extra tables, filters, and various other addons for OpenSMTPD")
(description
"This package provides extra tables, filters, and various other addons
for OpenSMTPD to extend its functionality.")
(home-page "https://www.opensmtpd.org")))

View file

@ -456,7 +456,8 @@ (define-public hdf4
version "/src/hdf-" version ".tar.bz2"))
(sha256
(base32 "16yr50j845zlfx20skmw3y75ww77akk9gg0affjqkg66ih5r03mv"))
(patches (search-patches "hdf4-reproducibility.patch"
(patches (search-patches "hdf4-architectures.patch"
"hdf4-reproducibility.patch"
"hdf4-shared-fortran.patch"))))
(build-system gnu-build-system)

View file

@ -10,6 +10,7 @@
;;; Copyright © 2016 Eric Bavier <bavier@member.fsf.org>
;;; Copyright © 2016 ng0 <ng0@we.make.ritual.n0.is>
;;; Copyright © 2016 Arun Isaac <arunisaac@systemreboot.net>
;;; Copyright © 2016 Benz Schenk <benz.schenk@uzh.ch>
;;;
;;; This file is part of GNU Guix.
;;;
@ -927,3 +928,27 @@ (define-public sslh
that block port 22.")
(license (list license:bsd-2 ; tls.[ch]
license:gpl2+)))) ; everything else
(define-public iperf
(package
(name "iperf")
(version "3.1.3")
(source (origin
(method url-fetch)
(uri (string-append "http://downloads.es.net/pub/iperf"
"/iperf-" version ".tar.gz"))
(sha256
(base32
"1gwmhm29zlp5grrpglmqj7vgx19s6xy33hk6hpbn8jnpn5lxpn30"))))
(build-system gnu-build-system)
(synopsis "TCP, UDP and SCTP bandwidth measurement tool")
(description
"iPerf is a tool to measure achievable bandwidth on IP networks. It
supports tuning of various parameters related to timing, buffers and
protocols (TCP, UDP, SCTP with IPv4 and IPv6). For each test it reports
the bandwidth, loss, and other parameters.")
(home-page "http://software.es.net/iperf/")
(license (list license:bsd-3 ; Main distribution.
license:ncsa ; src/{units,iperf_locale,tcp_window_size}.c
license:expat ; src/{cjson,net}.[ch]
license:public-domain)))) ; src/portable_endian.h

View file

@ -476,13 +476,13 @@ (define-public rpm
(define-public diffoscope
(package
(name "diffoscope")
(version "60")
(version "61")
(source (origin
(method url-fetch)
(uri (pypi-uri name version))
(sha256
(base32
"0qwsnh7sldjlwi4qydn1ljzh3322k2ga45d867ml49xr2wnsivcc"))))
"1qpk2l6p9z58s61jfx6adm96f5r21ns128db0876zd6b6h34411p"))))
(build-system python-build-system)
(arguments
`(#:phases (modify-phases %standard-phases

View file

@ -1,20 +0,0 @@
Fix CVE-2007-2721 (heap corruption in jpc_qcx_getcompparms()).
Copied from Fedora.
http://pkgs.fedoraproject.org/cgit/rpms/jasper.git/tree/patch-libjasper-stepsizes-overflow.diff
--- jasper-1.900.1.orig/src/libjasper/jpc/jpc_cs.c 2007-01-19 22:43:07.000000000 +0100
+++ jasper-1.900.1/src/libjasper/jpc/jpc_cs.c 2007-04-06 01:29:02.000000000 +0200
@@ -982,7 +982,10 @@ static int jpc_qcx_getcompparms(jpc_qcxc
compparms->numstepsizes = (len - n) / 2;
break;
}
- if (compparms->numstepsizes > 0) {
+ if (compparms->numstepsizes > 3 * JPC_MAXRLVLS + 1) {
+ jpc_qcx_destroycompparms(compparms);
+ return -1;
+ } else if (compparms->numstepsizes > 0) {
compparms->stepsizes = jas_malloc(compparms->numstepsizes *
sizeof(uint_fast16_t));
assert(compparms->stepsizes);

View file

@ -1,931 +0,0 @@
Fix CVE-2008-3520 (multiple integer overflows in jas_alloc calls).
Copied from Fedora.
http://pkgs.fedoraproject.org/cgit/rpms/jasper.git/tree/jasper-1.900.1-CVE-2008-3520.patch
https://bugzilla.redhat.com/show_bug.cgi?id=461476
diff -pruN jasper-1.900.1.orig/src/libjasper/base/jas_cm.c jasper-1.900.1/src/libjasper/base/jas_cm.c
--- jasper-1.900.1.orig/src/libjasper/base/jas_cm.c 2007-01-19 22:43:05.000000000 +0100
+++ jasper-1.900.1/src/libjasper/base/jas_cm.c 2009-10-22 10:27:45.000000000 +0200
@@ -704,8 +704,7 @@ static int jas_cmpxformseq_resize(jas_cm
{
jas_cmpxform_t **p;
assert(n >= pxformseq->numpxforms);
- p = (!pxformseq->pxforms) ? jas_malloc(n * sizeof(jas_cmpxform_t *)) :
- jas_realloc(pxformseq->pxforms, n * sizeof(jas_cmpxform_t *));
+ p = jas_realloc2(pxformseq->pxforms, n, sizeof(jas_cmpxform_t *));
if (!p) {
return -1;
}
@@ -889,13 +888,13 @@ static int jas_cmshapmatlut_set(jas_cmsh
jas_cmshapmatlut_cleanup(lut);
if (curv->numents == 0) {
lut->size = 2;
- if (!(lut->data = jas_malloc(lut->size * sizeof(jas_cmreal_t))))
+ if (!(lut->data = jas_alloc2(lut->size, sizeof(jas_cmreal_t))))
goto error;
lut->data[0] = 0.0;
lut->data[1] = 1.0;
} else if (curv->numents == 1) {
lut->size = 256;
- if (!(lut->data = jas_malloc(lut->size * sizeof(jas_cmreal_t))))
+ if (!(lut->data = jas_alloc2(lut->size, sizeof(jas_cmreal_t))))
goto error;
gamma = curv->ents[0] / 256.0;
for (i = 0; i < lut->size; ++i) {
@@ -903,7 +902,7 @@ static int jas_cmshapmatlut_set(jas_cmsh
}
} else {
lut->size = curv->numents;
- if (!(lut->data = jas_malloc(lut->size * sizeof(jas_cmreal_t))))
+ if (!(lut->data = jas_alloc2(lut->size, sizeof(jas_cmreal_t))))
goto error;
for (i = 0; i < lut->size; ++i) {
lut->data[i] = curv->ents[i] / 65535.0;
@@ -953,7 +952,7 @@ static int jas_cmshapmatlut_invert(jas_c
return -1;
}
}
- if (!(invlut->data = jas_malloc(n * sizeof(jas_cmreal_t))))
+ if (!(invlut->data = jas_alloc2(n, sizeof(jas_cmreal_t))))
return -1;
invlut->size = n;
for (i = 0; i < invlut->size; ++i) {
diff -pruN jasper-1.900.1.orig/src/libjasper/base/jas_icc.c jasper-1.900.1/src/libjasper/base/jas_icc.c
--- jasper-1.900.1.orig/src/libjasper/base/jas_icc.c 2007-01-19 22:43:05.000000000 +0100
+++ jasper-1.900.1/src/libjasper/base/jas_icc.c 2009-10-22 10:27:45.000000000 +0200
@@ -373,7 +373,7 @@ int jas_iccprof_save(jas_iccprof_t *prof
jas_icctagtab_t *tagtab;
tagtab = &prof->tagtab;
- if (!(tagtab->ents = jas_malloc(prof->attrtab->numattrs *
+ if (!(tagtab->ents = jas_alloc2(prof->attrtab->numattrs,
sizeof(jas_icctagtabent_t))))
goto error;
tagtab->numents = prof->attrtab->numattrs;
@@ -522,7 +522,7 @@ static int jas_iccprof_gettagtab(jas_str
}
if (jas_iccgetuint32(in, &tagtab->numents))
goto error;
- if (!(tagtab->ents = jas_malloc(tagtab->numents *
+ if (!(tagtab->ents = jas_alloc2(tagtab->numents,
sizeof(jas_icctagtabent_t))))
goto error;
tagtabent = tagtab->ents;
@@ -743,8 +743,7 @@ static int jas_iccattrtab_resize(jas_icc
{
jas_iccattr_t *newattrs;
assert(maxents >= tab->numattrs);
- newattrs = tab->attrs ? jas_realloc(tab->attrs, maxents *
- sizeof(jas_iccattr_t)) : jas_malloc(maxents * sizeof(jas_iccattr_t));
+ newattrs = jas_realloc2(tab->attrs, maxents, sizeof(jas_iccattr_t));
if (!newattrs)
return -1;
tab->attrs = newattrs;
@@ -999,7 +998,7 @@ static int jas_icccurv_input(jas_iccattr
if (jas_iccgetuint32(in, &curv->numents))
goto error;
- if (!(curv->ents = jas_malloc(curv->numents * sizeof(jas_iccuint16_t))))
+ if (!(curv->ents = jas_alloc2(curv->numents, sizeof(jas_iccuint16_t))))
goto error;
for (i = 0; i < curv->numents; ++i) {
if (jas_iccgetuint16(in, &curv->ents[i]))
@@ -1100,7 +1099,7 @@ static int jas_icctxtdesc_input(jas_icca
if (jas_iccgetuint32(in, &txtdesc->uclangcode) ||
jas_iccgetuint32(in, &txtdesc->uclen))
goto error;
- if (!(txtdesc->ucdata = jas_malloc(txtdesc->uclen * 2)))
+ if (!(txtdesc->ucdata = jas_alloc2(txtdesc->uclen, 2)))
goto error;
if (jas_stream_read(in, txtdesc->ucdata, txtdesc->uclen * 2) !=
JAS_CAST(int, txtdesc->uclen * 2))
@@ -1292,17 +1291,17 @@ static int jas_icclut8_input(jas_iccattr
jas_iccgetuint16(in, &lut8->numouttabents))
goto error;
clutsize = jas_iccpowi(lut8->clutlen, lut8->numinchans) * lut8->numoutchans;
- if (!(lut8->clut = jas_malloc(clutsize * sizeof(jas_iccuint8_t))) ||
- !(lut8->intabsbuf = jas_malloc(lut8->numinchans *
- lut8->numintabents * sizeof(jas_iccuint8_t))) ||
- !(lut8->intabs = jas_malloc(lut8->numinchans *
+ if (!(lut8->clut = jas_alloc2(clutsize, sizeof(jas_iccuint8_t))) ||
+ !(lut8->intabsbuf = jas_alloc3(lut8->numinchans,
+ lut8->numintabents, sizeof(jas_iccuint8_t))) ||
+ !(lut8->intabs = jas_alloc2(lut8->numinchans,
sizeof(jas_iccuint8_t *))))
goto error;
for (i = 0; i < lut8->numinchans; ++i)
lut8->intabs[i] = &lut8->intabsbuf[i * lut8->numintabents];
- if (!(lut8->outtabsbuf = jas_malloc(lut8->numoutchans *
- lut8->numouttabents * sizeof(jas_iccuint8_t))) ||
- !(lut8->outtabs = jas_malloc(lut8->numoutchans *
+ if (!(lut8->outtabsbuf = jas_alloc3(lut8->numoutchans,
+ lut8->numouttabents, sizeof(jas_iccuint8_t))) ||
+ !(lut8->outtabs = jas_alloc2(lut8->numoutchans,
sizeof(jas_iccuint8_t *))))
goto error;
for (i = 0; i < lut8->numoutchans; ++i)
@@ -1461,17 +1460,17 @@ static int jas_icclut16_input(jas_iccatt
jas_iccgetuint16(in, &lut16->numouttabents))
goto error;
clutsize = jas_iccpowi(lut16->clutlen, lut16->numinchans) * lut16->numoutchans;
- if (!(lut16->clut = jas_malloc(clutsize * sizeof(jas_iccuint16_t))) ||
- !(lut16->intabsbuf = jas_malloc(lut16->numinchans *
- lut16->numintabents * sizeof(jas_iccuint16_t))) ||
- !(lut16->intabs = jas_malloc(lut16->numinchans *
+ if (!(lut16->clut = jas_alloc2(clutsize, sizeof(jas_iccuint16_t))) ||
+ !(lut16->intabsbuf = jas_alloc3(lut16->numinchans,
+ lut16->numintabents, sizeof(jas_iccuint16_t))) ||
+ !(lut16->intabs = jas_alloc2(lut16->numinchans,
sizeof(jas_iccuint16_t *))))
goto error;
for (i = 0; i < lut16->numinchans; ++i)
lut16->intabs[i] = &lut16->intabsbuf[i * lut16->numintabents];
- if (!(lut16->outtabsbuf = jas_malloc(lut16->numoutchans *
- lut16->numouttabents * sizeof(jas_iccuint16_t))) ||
- !(lut16->outtabs = jas_malloc(lut16->numoutchans *
+ if (!(lut16->outtabsbuf = jas_alloc3(lut16->numoutchans,
+ lut16->numouttabents, sizeof(jas_iccuint16_t))) ||
+ !(lut16->outtabs = jas_alloc2(lut16->numoutchans,
sizeof(jas_iccuint16_t *))))
goto error;
for (i = 0; i < lut16->numoutchans; ++i)
diff -pruN jasper-1.900.1.orig/src/libjasper/base/jas_image.c jasper-1.900.1/src/libjasper/base/jas_image.c
--- jasper-1.900.1.orig/src/libjasper/base/jas_image.c 2007-01-19 22:43:05.000000000 +0100
+++ jasper-1.900.1/src/libjasper/base/jas_image.c 2009-10-22 10:27:45.000000000 +0200
@@ -142,7 +142,7 @@ jas_image_t *jas_image_create(int numcmp
image->inmem_ = true;
/* Allocate memory for the per-component information. */
- if (!(image->cmpts_ = jas_malloc(image->maxcmpts_ *
+ if (!(image->cmpts_ = jas_alloc2(image->maxcmpts_,
sizeof(jas_image_cmpt_t *)))) {
jas_image_destroy(image);
return 0;
@@ -774,8 +774,7 @@ static int jas_image_growcmpts(jas_image
jas_image_cmpt_t **newcmpts;
int cmptno;
- newcmpts = (!image->cmpts_) ? jas_malloc(maxcmpts * sizeof(jas_image_cmpt_t *)) :
- jas_realloc(image->cmpts_, maxcmpts * sizeof(jas_image_cmpt_t *));
+ newcmpts = jas_realloc2(image->cmpts_, maxcmpts, sizeof(jas_image_cmpt_t *));
if (!newcmpts) {
return -1;
}
diff -pruN jasper-1.900.1.orig/src/libjasper/base/jas_malloc.c jasper-1.900.1/src/libjasper/base/jas_malloc.c
--- jasper-1.900.1.orig/src/libjasper/base/jas_malloc.c 2007-01-19 22:43:05.000000000 +0100
+++ jasper-1.900.1/src/libjasper/base/jas_malloc.c 2009-10-22 10:27:45.000000000 +0200
@@ -76,6 +76,9 @@
/* We need the prototype for memset. */
#include <string.h>
+#include <limits.h>
+#include <errno.h>
+#include <stdint.h>
#include "jasper/jas_malloc.h"
@@ -113,18 +116,50 @@ void jas_free(void *ptr)
void *jas_realloc(void *ptr, size_t size)
{
- return realloc(ptr, size);
+ return ptr ? realloc(ptr, size) : malloc(size);
}
-void *jas_calloc(size_t nmemb, size_t size)
+void *jas_realloc2(void *ptr, size_t nmemb, size_t size)
+{
+ if (!ptr)
+ return jas_alloc2(nmemb, size);
+ if (nmemb && SIZE_MAX / nmemb < size) {
+ errno = ENOMEM;
+ return NULL;
+ }
+ return jas_realloc(ptr, nmemb * size);
+
+}
+
+void *jas_alloc2(size_t nmemb, size_t size)
+{
+ if (nmemb && SIZE_MAX / nmemb < size) {
+ errno = ENOMEM;
+ return NULL;
+ }
+
+ return jas_malloc(nmemb * size);
+}
+
+void *jas_alloc3(size_t a, size_t b, size_t c)
{
- void *ptr;
size_t n;
- n = nmemb * size;
- if (!(ptr = jas_malloc(n * sizeof(char)))) {
- return 0;
+
+ if (a && SIZE_MAX / a < b) {
+ errno = ENOMEM;
+ return NULL;
}
- memset(ptr, 0, n);
+
+ return jas_alloc2(a*b, c);
+}
+
+void *jas_calloc(size_t nmemb, size_t size)
+{
+ void *ptr;
+
+ ptr = jas_alloc2(nmemb, size);
+ if (ptr)
+ memset(ptr, 0, nmemb*size);
return ptr;
}
diff -pruN jasper-1.900.1.orig/src/libjasper/base/jas_seq.c jasper-1.900.1/src/libjasper/base/jas_seq.c
--- jasper-1.900.1.orig/src/libjasper/base/jas_seq.c 2007-01-19 22:43:05.000000000 +0100
+++ jasper-1.900.1/src/libjasper/base/jas_seq.c 2009-10-22 10:27:45.000000000 +0200
@@ -114,7 +114,7 @@ jas_matrix_t *jas_matrix_create(int numr
matrix->datasize_ = numrows * numcols;
if (matrix->maxrows_ > 0) {
- if (!(matrix->rows_ = jas_malloc(matrix->maxrows_ *
+ if (!(matrix->rows_ = jas_alloc2(matrix->maxrows_,
sizeof(jas_seqent_t *)))) {
jas_matrix_destroy(matrix);
return 0;
@@ -122,7 +122,7 @@ jas_matrix_t *jas_matrix_create(int numr
}
if (matrix->datasize_ > 0) {
- if (!(matrix->data_ = jas_malloc(matrix->datasize_ *
+ if (!(matrix->data_ = jas_alloc2(matrix->datasize_,
sizeof(jas_seqent_t)))) {
jas_matrix_destroy(matrix);
return 0;
@@ -220,7 +220,7 @@ void jas_matrix_bindsub(jas_matrix_t *ma
mat0->numrows_ = r1 - r0 + 1;
mat0->numcols_ = c1 - c0 + 1;
mat0->maxrows_ = mat0->numrows_;
- mat0->rows_ = jas_malloc(mat0->maxrows_ * sizeof(jas_seqent_t *));
+ mat0->rows_ = jas_alloc2(mat0->maxrows_, sizeof(jas_seqent_t *));
for (i = 0; i < mat0->numrows_; ++i) {
mat0->rows_[i] = mat1->rows_[r0 + i] + c0;
}
diff -pruN jasper-1.900.1.orig/src/libjasper/base/jas_stream.c jasper-1.900.1/src/libjasper/base/jas_stream.c
--- jasper-1.900.1.orig/src/libjasper/base/jas_stream.c 2007-01-19 22:43:05.000000000 +0100
+++ jasper-1.900.1/src/libjasper/base/jas_stream.c 2009-10-22 10:27:45.000000000 +0200
@@ -212,7 +212,7 @@ jas_stream_t *jas_stream_memopen(char *b
if (buf) {
obj->buf_ = (unsigned char *) buf;
} else {
- obj->buf_ = jas_malloc(obj->bufsize_ * sizeof(char));
+ obj->buf_ = jas_malloc(obj->bufsize_);
obj->myalloc_ = 1;
}
if (!obj->buf_) {
@@ -992,7 +992,7 @@ static int mem_resize(jas_stream_memobj_
unsigned char *buf;
assert(m->buf_);
- if (!(buf = jas_realloc(m->buf_, bufsize * sizeof(unsigned char)))) {
+ if (!(buf = jas_realloc(m->buf_, bufsize))) {
return -1;
}
m->buf_ = buf;
diff -pruN jasper-1.900.1.orig/src/libjasper/bmp/bmp_dec.c jasper-1.900.1/src/libjasper/bmp/bmp_dec.c
--- jasper-1.900.1.orig/src/libjasper/bmp/bmp_dec.c 2007-01-19 22:43:07.000000000 +0100
+++ jasper-1.900.1/src/libjasper/bmp/bmp_dec.c 2009-10-22 10:27:45.000000000 +0200
@@ -283,7 +283,7 @@ static bmp_info_t *bmp_getinfo(jas_strea
}
if (info->numcolors > 0) {
- if (!(info->palents = jas_malloc(info->numcolors *
+ if (!(info->palents = jas_alloc2(info->numcolors,
sizeof(bmp_palent_t)))) {
bmp_info_destroy(info);
return 0;
diff -pruN jasper-1.900.1.orig/src/libjasper/include/jasper/jas_malloc.h jasper-1.900.1/src/libjasper/include/jasper/jas_malloc.h
--- jasper-1.900.1.orig/src/libjasper/include/jasper/jas_malloc.h 2007-01-19 22:43:04.000000000 +0100
+++ jasper-1.900.1/src/libjasper/include/jasper/jas_malloc.h 2009-10-22 10:27:45.000000000 +0200
@@ -95,6 +95,9 @@ extern "C" {
#define jas_free MEMFREE
#define jas_realloc MEMREALLOC
#define jas_calloc MEMCALLOC
+#define jas_alloc2(a, b) MEMALLOC((a)*(b))
+#define jas_alloc3(a, b, c) MEMALLOC((a)*(b)*(c))
+#define jas_realloc2(p, a, b) MEMREALLOC((p), (a)*(b))
#endif
/******************************************************************************\
@@ -115,6 +118,12 @@ void *jas_realloc(void *ptr, size_t size
/* Allocate a block of memory and initialize the contents to zero. */
void *jas_calloc(size_t nmemb, size_t size);
+/* size-checked double allocation .*/
+void *jas_alloc2(size_t, size_t);
+
+void *jas_alloc3(size_t, size_t, size_t);
+
+void *jas_realloc2(void *, size_t, size_t);
#endif
#ifdef __cplusplus
diff -pruN jasper-1.900.1.orig/src/libjasper/jp2/jp2_cod.c jasper-1.900.1/src/libjasper/jp2/jp2_cod.c
--- jasper-1.900.1.orig/src/libjasper/jp2/jp2_cod.c 2007-01-19 22:43:05.000000000 +0100
+++ jasper-1.900.1/src/libjasper/jp2/jp2_cod.c 2009-10-22 10:30:24.000000000 +0200
@@ -247,7 +247,7 @@ jp2_box_t *jp2_box_get(jas_stream_t *in)
box = 0;
tmpstream = 0;
- if (!(box = jas_malloc(sizeof(jp2_box_t)))) {
+ if (!(box = jas_calloc(1, sizeof(jp2_box_t)))) {
goto error;
}
box->ops = &jp2_boxinfo_unk.ops;
@@ -372,7 +372,7 @@ static int jp2_bpcc_getdata(jp2_box_t *b
jp2_bpcc_t *bpcc = &box->data.bpcc;
unsigned int i;
bpcc->numcmpts = box->datalen;
- if (!(bpcc->bpcs = jas_malloc(bpcc->numcmpts * sizeof(uint_fast8_t)))) {
+ if (!(bpcc->bpcs = jas_alloc2(bpcc->numcmpts, sizeof(uint_fast8_t)))) {
return -1;
}
for (i = 0; i < bpcc->numcmpts; ++i) {
@@ -416,7 +416,7 @@ static int jp2_colr_getdata(jp2_box_t *b
break;
case JP2_COLR_ICC:
colr->iccplen = box->datalen - 3;
- if (!(colr->iccp = jas_malloc(colr->iccplen * sizeof(uint_fast8_t)))) {
+ if (!(colr->iccp = jas_alloc2(colr->iccplen, sizeof(uint_fast8_t)))) {
return -1;
}
if (jas_stream_read(in, colr->iccp, colr->iccplen) != colr->iccplen) {
@@ -453,7 +453,7 @@ static int jp2_cdef_getdata(jp2_box_t *b
if (jp2_getuint16(in, &cdef->numchans)) {
return -1;
}
- if (!(cdef->ents = jas_malloc(cdef->numchans * sizeof(jp2_cdefchan_t)))) {
+ if (!(cdef->ents = jas_alloc2(cdef->numchans, sizeof(jp2_cdefchan_t)))) {
return -1;
}
for (channo = 0; channo < cdef->numchans; ++channo) {
@@ -766,7 +766,7 @@ static int jp2_cmap_getdata(jp2_box_t *b
unsigned int i;
cmap->numchans = (box->datalen) / 4;
- if (!(cmap->ents = jas_malloc(cmap->numchans * sizeof(jp2_cmapent_t)))) {
+ if (!(cmap->ents = jas_alloc2(cmap->numchans, sizeof(jp2_cmapent_t)))) {
return -1;
}
for (i = 0; i < cmap->numchans; ++i) {
@@ -828,10 +828,10 @@ static int jp2_pclr_getdata(jp2_box_t *b
return -1;
}
lutsize = pclr->numlutents * pclr->numchans;
- if (!(pclr->lutdata = jas_malloc(lutsize * sizeof(int_fast32_t)))) {
+ if (!(pclr->lutdata = jas_alloc2(lutsize, sizeof(int_fast32_t)))) {
return -1;
}
- if (!(pclr->bpc = jas_malloc(pclr->numchans * sizeof(uint_fast8_t)))) {
+ if (!(pclr->bpc = jas_alloc2(pclr->numchans, sizeof(uint_fast8_t)))) {
return -1;
}
for (i = 0; i < pclr->numchans; ++i) {
diff -pruN jasper-1.900.1.orig/src/libjasper/jp2/jp2_dec.c jasper-1.900.1/src/libjasper/jp2/jp2_dec.c
--- jasper-1.900.1.orig/src/libjasper/jp2/jp2_dec.c 2007-01-19 22:43:05.000000000 +0100
+++ jasper-1.900.1/src/libjasper/jp2/jp2_dec.c 2009-10-22 10:27:45.000000000 +0200
@@ -336,7 +336,7 @@ jas_image_t *jp2_decode(jas_stream_t *in
}
/* Allocate space for the channel-number to component-number LUT. */
- if (!(dec->chantocmptlut = jas_malloc(dec->numchans * sizeof(uint_fast16_t)))) {
+ if (!(dec->chantocmptlut = jas_alloc2(dec->numchans, sizeof(uint_fast16_t)))) {
jas_eprintf("error: no memory\n");
goto error;
}
@@ -354,7 +354,7 @@ jas_image_t *jp2_decode(jas_stream_t *in
if (cmapent->map == JP2_CMAP_DIRECT) {
dec->chantocmptlut[channo] = channo;
} else if (cmapent->map == JP2_CMAP_PALETTE) {
- lutents = jas_malloc(pclrd->numlutents * sizeof(int_fast32_t));
+ lutents = jas_alloc2(pclrd->numlutents, sizeof(int_fast32_t));
for (i = 0; i < pclrd->numlutents; ++i) {
lutents[i] = pclrd->lutdata[cmapent->pcol + i * pclrd->numchans];
}
diff -pruN jasper-1.900.1.orig/src/libjasper/jp2/jp2_enc.c jasper-1.900.1/src/libjasper/jp2/jp2_enc.c
--- jasper-1.900.1.orig/src/libjasper/jp2/jp2_enc.c 2007-01-19 22:43:05.000000000 +0100
+++ jasper-1.900.1/src/libjasper/jp2/jp2_enc.c 2009-10-22 10:27:45.000000000 +0200
@@ -191,7 +191,7 @@ int sgnd;
}
bpcc = &box->data.bpcc;
bpcc->numcmpts = jas_image_numcmpts(image);
- if (!(bpcc->bpcs = jas_malloc(bpcc->numcmpts *
+ if (!(bpcc->bpcs = jas_alloc2(bpcc->numcmpts,
sizeof(uint_fast8_t)))) {
goto error;
}
@@ -285,7 +285,7 @@ int sgnd;
}
cdef = &box->data.cdef;
cdef->numchans = jas_image_numcmpts(image);
- cdef->ents = jas_malloc(cdef->numchans * sizeof(jp2_cdefchan_t));
+ cdef->ents = jas_alloc2(cdef->numchans, sizeof(jp2_cdefchan_t));
for (i = 0; i < jas_image_numcmpts(image); ++i) {
cdefchanent = &cdef->ents[i];
cdefchanent->channo = i;
diff -pruN jasper-1.900.1.orig/src/libjasper/jpc/jpc_cs.c jasper-1.900.1/src/libjasper/jpc/jpc_cs.c
--- jasper-1.900.1.orig/src/libjasper/jpc/jpc_cs.c 2009-10-22 09:58:16.000000000 +0200
+++ jasper-1.900.1/src/libjasper/jpc/jpc_cs.c 2009-10-22 10:27:45.000000000 +0200
@@ -502,7 +502,7 @@ static int jpc_siz_getparms(jpc_ms_t *ms
!siz->tileheight || !siz->numcomps) {
return -1;
}
- if (!(siz->comps = jas_malloc(siz->numcomps * sizeof(jpc_sizcomp_t)))) {
+ if (!(siz->comps = jas_alloc2(siz->numcomps, sizeof(jpc_sizcomp_t)))) {
return -1;
}
for (i = 0; i < siz->numcomps; ++i) {
@@ -986,7 +986,7 @@ static int jpc_qcx_getcompparms(jpc_qcxc
jpc_qcx_destroycompparms(compparms);
return -1;
} else if (compparms->numstepsizes > 0) {
- compparms->stepsizes = jas_malloc(compparms->numstepsizes *
+ compparms->stepsizes = jas_alloc2(compparms->numstepsizes,
sizeof(uint_fast16_t));
assert(compparms->stepsizes);
for (i = 0; i < compparms->numstepsizes; ++i) {
@@ -1094,7 +1094,7 @@ static int jpc_ppm_getparms(jpc_ms_t *ms
ppm->len = ms->len - 1;
if (ppm->len > 0) {
- if (!(ppm->data = jas_malloc(ppm->len * sizeof(unsigned char)))) {
+ if (!(ppm->data = jas_malloc(ppm->len))) {
goto error;
}
if (JAS_CAST(uint, jas_stream_read(in, ppm->data, ppm->len)) != ppm->len) {
@@ -1163,7 +1163,7 @@ static int jpc_ppt_getparms(jpc_ms_t *ms
}
ppt->len = ms->len - 1;
if (ppt->len > 0) {
- if (!(ppt->data = jas_malloc(ppt->len * sizeof(unsigned char)))) {
+ if (!(ppt->data = jas_malloc(ppt->len))) {
goto error;
}
if (jas_stream_read(in, (char *) ppt->data, ppt->len) != JAS_CAST(int, ppt->len)) {
@@ -1226,7 +1226,7 @@ static int jpc_poc_getparms(jpc_ms_t *ms
uint_fast8_t tmp;
poc->numpchgs = (cstate->numcomps > 256) ? (ms->len / 9) :
(ms->len / 7);
- if (!(poc->pchgs = jas_malloc(poc->numpchgs * sizeof(jpc_pocpchg_t)))) {
+ if (!(poc->pchgs = jas_alloc2(poc->numpchgs, sizeof(jpc_pocpchg_t)))) {
goto error;
}
for (pchgno = 0, pchg = poc->pchgs; pchgno < poc->numpchgs; ++pchgno,
@@ -1331,7 +1331,7 @@ static int jpc_crg_getparms(jpc_ms_t *ms
jpc_crgcomp_t *comp;
uint_fast16_t compno;
crg->numcomps = cstate->numcomps;
- if (!(crg->comps = jas_malloc(cstate->numcomps * sizeof(uint_fast16_t)))) {
+ if (!(crg->comps = jas_alloc2(cstate->numcomps, sizeof(uint_fast16_t)))) {
return -1;
}
for (compno = 0, comp = crg->comps; compno < cstate->numcomps;
@@ -1470,7 +1470,7 @@ static int jpc_unk_getparms(jpc_ms_t *ms
cstate = 0;
if (ms->len > 0) {
- if (!(unk->data = jas_malloc(ms->len * sizeof(unsigned char)))) {
+ if (!(unk->data = jas_malloc(ms->len))) {
return -1;
}
if (jas_stream_read(in, (char *) unk->data, ms->len) != JAS_CAST(int, ms->len)) {
diff -pruN jasper-1.900.1.orig/src/libjasper/jpc/jpc_dec.c jasper-1.900.1/src/libjasper/jpc/jpc_dec.c
--- jasper-1.900.1.orig/src/libjasper/jpc/jpc_dec.c 2009-10-22 09:58:16.000000000 +0200
+++ jasper-1.900.1/src/libjasper/jpc/jpc_dec.c 2009-10-22 10:30:50.000000000 +0200
@@ -449,7 +449,7 @@ static int jpc_dec_process_sot(jpc_dec_t
if (dec->state == JPC_MH) {
- compinfos = jas_malloc(dec->numcomps * sizeof(jas_image_cmptparm_t));
+ compinfos = jas_alloc2(dec->numcomps, sizeof(jas_image_cmptparm_t));
assert(compinfos);
for (cmptno = 0, cmpt = dec->cmpts, compinfo = compinfos;
cmptno < dec->numcomps; ++cmptno, ++cmpt, ++compinfo) {
@@ -692,7 +692,7 @@ static int jpc_dec_tileinit(jpc_dec_t *d
tile->realmode = 1;
}
tcomp->numrlvls = ccp->numrlvls;
- if (!(tcomp->rlvls = jas_malloc(tcomp->numrlvls *
+ if (!(tcomp->rlvls = jas_alloc2(tcomp->numrlvls,
sizeof(jpc_dec_rlvl_t)))) {
return -1;
}
@@ -764,7 +764,7 @@ rlvl->bands = 0;
rlvl->cbgheightexpn);
rlvl->numbands = (!rlvlno) ? 1 : 3;
- if (!(rlvl->bands = jas_malloc(rlvl->numbands *
+ if (!(rlvl->bands = jas_alloc2(rlvl->numbands,
sizeof(jpc_dec_band_t)))) {
return -1;
}
@@ -797,7 +797,7 @@ rlvl->bands = 0;
assert(rlvl->numprcs);
- if (!(band->prcs = jas_malloc(rlvl->numprcs * sizeof(jpc_dec_prc_t)))) {
+ if (!(band->prcs = jas_alloc2(rlvl->numprcs, sizeof(jpc_dec_prc_t)))) {
return -1;
}
@@ -834,7 +834,7 @@ rlvl->bands = 0;
if (!(prc->numimsbstagtree = jpc_tagtree_create(prc->numhcblks, prc->numvcblks))) {
return -1;
}
- if (!(prc->cblks = jas_malloc(prc->numcblks * sizeof(jpc_dec_cblk_t)))) {
+ if (!(prc->cblks = jas_alloc2(prc->numcblks, sizeof(jpc_dec_cblk_t)))) {
return -1;
}
@@ -1181,7 +1181,7 @@ static int jpc_dec_process_siz(jpc_dec_t
return -1;
}
- if (!(dec->cmpts = jas_malloc(dec->numcomps * sizeof(jpc_dec_cmpt_t)))) {
+ if (!(dec->cmpts = jas_alloc2(dec->numcomps, sizeof(jpc_dec_cmpt_t)))) {
return -1;
}
@@ -1204,7 +1204,7 @@ static int jpc_dec_process_siz(jpc_dec_t
dec->numhtiles = JPC_CEILDIV(dec->xend - dec->tilexoff, dec->tilewidth);
dec->numvtiles = JPC_CEILDIV(dec->yend - dec->tileyoff, dec->tileheight);
dec->numtiles = dec->numhtiles * dec->numvtiles;
- if (!(dec->tiles = jas_malloc(dec->numtiles * sizeof(jpc_dec_tile_t)))) {
+ if (!(dec->tiles = jas_calloc(dec->numtiles, sizeof(jpc_dec_tile_t)))) {
return -1;
}
@@ -1228,7 +1228,7 @@ static int jpc_dec_process_siz(jpc_dec_t
tile->pkthdrstreampos = 0;
tile->pptstab = 0;
tile->cp = 0;
- if (!(tile->tcomps = jas_malloc(dec->numcomps *
+ if (!(tile->tcomps = jas_calloc(dec->numcomps,
sizeof(jpc_dec_tcomp_t)))) {
return -1;
}
@@ -1489,7 +1489,7 @@ static jpc_dec_cp_t *jpc_dec_cp_create(u
cp->numlyrs = 0;
cp->mctid = 0;
cp->csty = 0;
- if (!(cp->ccps = jas_malloc(cp->numcomps * sizeof(jpc_dec_ccp_t)))) {
+ if (!(cp->ccps = jas_alloc2(cp->numcomps, sizeof(jpc_dec_ccp_t)))) {
return 0;
}
if (!(cp->pchglist = jpc_pchglist_create())) {
@@ -2048,7 +2048,7 @@ jpc_streamlist_t *jpc_streamlist_create(
}
streamlist->numstreams = 0;
streamlist->maxstreams = 100;
- if (!(streamlist->streams = jas_malloc(streamlist->maxstreams *
+ if (!(streamlist->streams = jas_alloc2(streamlist->maxstreams,
sizeof(jas_stream_t *)))) {
jas_free(streamlist);
return 0;
@@ -2068,8 +2068,8 @@ int jpc_streamlist_insert(jpc_streamlist
/* Grow the array of streams if necessary. */
if (streamlist->numstreams >= streamlist->maxstreams) {
newmaxstreams = streamlist->maxstreams + 1024;
- if (!(newstreams = jas_realloc(streamlist->streams,
- (newmaxstreams + 1024) * sizeof(jas_stream_t *)))) {
+ if (!(newstreams = jas_realloc2(streamlist->streams,
+ (newmaxstreams + 1024), sizeof(jas_stream_t *)))) {
return -1;
}
for (i = streamlist->numstreams; i < streamlist->maxstreams; ++i) {
@@ -2155,8 +2155,7 @@ int jpc_ppxstab_grow(jpc_ppxstab_t *tab,
{
jpc_ppxstabent_t **newents;
if (tab->maxents < maxents) {
- newents = (tab->ents) ? jas_realloc(tab->ents, maxents *
- sizeof(jpc_ppxstabent_t *)) : jas_malloc(maxents * sizeof(jpc_ppxstabent_t *));
+ newents = jas_realloc2(tab->ents, maxents, sizeof(jpc_ppxstabent_t *));
if (!newents) {
return -1;
}
diff -pruN jasper-1.900.1.orig/src/libjasper/jpc/jpc_enc.c jasper-1.900.1/src/libjasper/jpc/jpc_enc.c
--- jasper-1.900.1.orig/src/libjasper/jpc/jpc_enc.c 2007-01-19 22:43:07.000000000 +0100
+++ jasper-1.900.1/src/libjasper/jpc/jpc_enc.c 2009-10-22 10:27:45.000000000 +0200
@@ -403,7 +403,7 @@ static jpc_enc_cp_t *cp_create(char *opt
vsteplcm *= jas_image_cmptvstep(image, cmptno);
}
- if (!(cp->ccps = jas_malloc(cp->numcmpts * sizeof(jpc_enc_ccp_t)))) {
+ if (!(cp->ccps = jas_alloc2(cp->numcmpts, sizeof(jpc_enc_ccp_t)))) {
goto error;
}
for (cmptno = 0, ccp = cp->ccps; cmptno < JAS_CAST(int, cp->numcmpts); ++cmptno,
@@ -656,7 +656,7 @@ static jpc_enc_cp_t *cp_create(char *opt
if (ilyrrates && numilyrrates > 0) {
tcp->numlyrs = numilyrrates + 1;
- if (!(tcp->ilyrrates = jas_malloc((tcp->numlyrs - 1) *
+ if (!(tcp->ilyrrates = jas_alloc2((tcp->numlyrs - 1),
sizeof(jpc_fix_t)))) {
goto error;
}
@@ -940,7 +940,7 @@ startoff = jas_stream_getrwcount(enc->ou
siz->tilewidth = cp->tilewidth;
siz->tileheight = cp->tileheight;
siz->numcomps = cp->numcmpts;
- siz->comps = jas_malloc(siz->numcomps * sizeof(jpc_sizcomp_t));
+ siz->comps = jas_alloc2(siz->numcomps, sizeof(jpc_sizcomp_t));
assert(siz->comps);
for (i = 0; i < JAS_CAST(int, cp->numcmpts); ++i) {
siz->comps[i].prec = cp->ccps[i].prec;
@@ -977,7 +977,7 @@ startoff = jas_stream_getrwcount(enc->ou
return -1;
}
crg = &enc->mrk->parms.crg;
- crg->comps = jas_malloc(crg->numcomps * sizeof(jpc_crgcomp_t));
+ crg->comps = jas_alloc2(crg->numcomps, sizeof(jpc_crgcomp_t));
if (jpc_putms(enc->out, enc->cstate, enc->mrk)) {
jas_eprintf("cannot write CRG marker\n");
return -1;
@@ -1955,7 +1955,7 @@ jpc_enc_tile_t *jpc_enc_tile_create(jpc_
tile->mctid = cp->tcp.mctid;
tile->numlyrs = cp->tcp.numlyrs;
- if (!(tile->lyrsizes = jas_malloc(tile->numlyrs *
+ if (!(tile->lyrsizes = jas_alloc2(tile->numlyrs,
sizeof(uint_fast32_t)))) {
goto error;
}
@@ -1964,7 +1964,7 @@ jpc_enc_tile_t *jpc_enc_tile_create(jpc_
}
/* Allocate an array for the per-tile-component information. */
- if (!(tile->tcmpts = jas_malloc(cp->numcmpts * sizeof(jpc_enc_tcmpt_t)))) {
+ if (!(tile->tcmpts = jas_alloc2(cp->numcmpts, sizeof(jpc_enc_tcmpt_t)))) {
goto error;
}
/* Initialize a few members critical for error recovery. */
@@ -2110,7 +2110,7 @@ static jpc_enc_tcmpt_t *tcmpt_create(jpc
jas_seq2d_ystart(tcmpt->data), jas_seq2d_xend(tcmpt->data),
jas_seq2d_yend(tcmpt->data), bandinfos);
- if (!(tcmpt->rlvls = jas_malloc(tcmpt->numrlvls * sizeof(jpc_enc_rlvl_t)))) {
+ if (!(tcmpt->rlvls = jas_alloc2(tcmpt->numrlvls, sizeof(jpc_enc_rlvl_t)))) {
goto error;
}
for (rlvlno = 0, rlvl = tcmpt->rlvls; rlvlno < tcmpt->numrlvls;
@@ -2213,7 +2213,7 @@ static jpc_enc_rlvl_t *rlvl_create(jpc_e
rlvl->numvprcs = JPC_FLOORDIVPOW2(brprcbry - tlprctly, rlvl->prcheightexpn);
rlvl->numprcs = rlvl->numhprcs * rlvl->numvprcs;
- if (!(rlvl->bands = jas_malloc(rlvl->numbands * sizeof(jpc_enc_band_t)))) {
+ if (!(rlvl->bands = jas_alloc2(rlvl->numbands, sizeof(jpc_enc_band_t)))) {
goto error;
}
for (bandno = 0, band = rlvl->bands; bandno < rlvl->numbands;
@@ -2290,7 +2290,7 @@ if (bandinfo->xstart != bandinfo->xend &
band->synweight = bandinfo->synenergywt;
if (band->data) {
- if (!(band->prcs = jas_malloc(rlvl->numprcs * sizeof(jpc_enc_prc_t)))) {
+ if (!(band->prcs = jas_alloc2(rlvl->numprcs, sizeof(jpc_enc_prc_t)))) {
goto error;
}
for (prcno = 0, prc = band->prcs; prcno < rlvl->numprcs; ++prcno,
@@ -2422,7 +2422,7 @@ if (!rlvlno) {
goto error;
}
- if (!(prc->cblks = jas_malloc(prc->numcblks * sizeof(jpc_enc_cblk_t)))) {
+ if (!(prc->cblks = jas_alloc2(prc->numcblks, sizeof(jpc_enc_cblk_t)))) {
goto error;
}
for (cblkno = 0, cblk = prc->cblks; cblkno < prc->numcblks;
diff -pruN jasper-1.900.1.orig/src/libjasper/jpc/jpc_mqdec.c jasper-1.900.1/src/libjasper/jpc/jpc_mqdec.c
--- jasper-1.900.1.orig/src/libjasper/jpc/jpc_mqdec.c 2007-01-19 22:43:07.000000000 +0100
+++ jasper-1.900.1/src/libjasper/jpc/jpc_mqdec.c 2009-10-22 10:27:45.000000000 +0200
@@ -118,7 +118,7 @@ jpc_mqdec_t *jpc_mqdec_create(int maxctx
mqdec->in = in;
mqdec->maxctxs = maxctxs;
/* Allocate memory for the per-context state information. */
- if (!(mqdec->ctxs = jas_malloc(mqdec->maxctxs * sizeof(jpc_mqstate_t *)))) {
+ if (!(mqdec->ctxs = jas_alloc2(mqdec->maxctxs, sizeof(jpc_mqstate_t *)))) {
goto error;
}
/* Set the current context to the first context. */
diff -pruN jasper-1.900.1.orig/src/libjasper/jpc/jpc_mqenc.c jasper-1.900.1/src/libjasper/jpc/jpc_mqenc.c
--- jasper-1.900.1.orig/src/libjasper/jpc/jpc_mqenc.c 2007-01-19 22:43:07.000000000 +0100
+++ jasper-1.900.1/src/libjasper/jpc/jpc_mqenc.c 2009-10-22 10:27:45.000000000 +0200
@@ -197,7 +197,7 @@ jpc_mqenc_t *jpc_mqenc_create(int maxctx
mqenc->maxctxs = maxctxs;
/* Allocate memory for the per-context state information. */
- if (!(mqenc->ctxs = jas_malloc(mqenc->maxctxs * sizeof(jpc_mqstate_t *)))) {
+ if (!(mqenc->ctxs = jas_alloc2(mqenc->maxctxs, sizeof(jpc_mqstate_t *)))) {
goto error;
}
diff -pruN jasper-1.900.1.orig/src/libjasper/jpc/jpc_qmfb.c jasper-1.900.1/src/libjasper/jpc/jpc_qmfb.c
--- jasper-1.900.1.orig/src/libjasper/jpc/jpc_qmfb.c 2007-01-19 22:43:07.000000000 +0100
+++ jasper-1.900.1/src/libjasper/jpc/jpc_qmfb.c 2009-10-22 10:27:45.000000000 +0200
@@ -321,7 +321,7 @@ void jpc_qmfb_split_row(jpc_fix_t *a, in
#if !defined(HAVE_VLA)
/* Get a buffer. */
if (bufsize > QMFB_SPLITBUFSIZE) {
- if (!(buf = jas_malloc(bufsize * sizeof(jpc_fix_t)))) {
+ if (!(buf = jas_alloc2(bufsize, sizeof(jpc_fix_t)))) {
/* We have no choice but to commit suicide in this case. */
abort();
}
@@ -389,7 +389,7 @@ void jpc_qmfb_split_col(jpc_fix_t *a, in
#if !defined(HAVE_VLA)
/* Get a buffer. */
if (bufsize > QMFB_SPLITBUFSIZE) {
- if (!(buf = jas_malloc(bufsize * sizeof(jpc_fix_t)))) {
+ if (!(buf = jas_alloc2(bufsize, sizeof(jpc_fix_t)))) {
/* We have no choice but to commit suicide in this case. */
abort();
}
@@ -460,7 +460,7 @@ void jpc_qmfb_split_colgrp(jpc_fix_t *a,
#if !defined(HAVE_VLA)
/* Get a buffer. */
if (bufsize > QMFB_SPLITBUFSIZE) {
- if (!(buf = jas_malloc(bufsize * sizeof(jpc_fix_t)))) {
+ if (!(buf = jas_alloc2(bufsize, sizeof(jpc_fix_t)))) {
/* We have no choice but to commit suicide in this case. */
abort();
}
@@ -549,7 +549,7 @@ void jpc_qmfb_split_colres(jpc_fix_t *a,
#if !defined(HAVE_VLA)
/* Get a buffer. */
if (bufsize > QMFB_SPLITBUFSIZE) {
- if (!(buf = jas_malloc(bufsize * sizeof(jpc_fix_t)))) {
+ if (!(buf = jas_alloc2(bufsize, sizeof(jpc_fix_t)))) {
/* We have no choice but to commit suicide in this case. */
abort();
}
@@ -633,7 +633,7 @@ void jpc_qmfb_join_row(jpc_fix_t *a, int
#if !defined(HAVE_VLA)
/* Allocate memory for the join buffer from the heap. */
if (bufsize > QMFB_JOINBUFSIZE) {
- if (!(buf = jas_malloc(bufsize * sizeof(jpc_fix_t)))) {
+ if (!(buf = jas_alloc2(bufsize, sizeof(jpc_fix_t)))) {
/* We have no choice but to commit suicide. */
abort();
}
@@ -698,7 +698,7 @@ void jpc_qmfb_join_col(jpc_fix_t *a, int
#if !defined(HAVE_VLA)
/* Allocate memory for the join buffer from the heap. */
if (bufsize > QMFB_JOINBUFSIZE) {
- if (!(buf = jas_malloc(bufsize * sizeof(jpc_fix_t)))) {
+ if (!(buf = jas_alloc2(bufsize, sizeof(jpc_fix_t)))) {
/* We have no choice but to commit suicide. */
abort();
}
@@ -766,7 +766,7 @@ void jpc_qmfb_join_colgrp(jpc_fix_t *a,
#if !defined(HAVE_VLA)
/* Allocate memory for the join buffer from the heap. */
if (bufsize > QMFB_JOINBUFSIZE) {
- if (!(buf = jas_malloc(bufsize * JPC_QMFB_COLGRPSIZE * sizeof(jpc_fix_t)))) {
+ if (!(buf = jas_alloc2(bufsize, JPC_QMFB_COLGRPSIZE * sizeof(jpc_fix_t)))) {
/* We have no choice but to commit suicide. */
abort();
}
@@ -852,7 +852,7 @@ void jpc_qmfb_join_colres(jpc_fix_t *a,
#if !defined(HAVE_VLA)
/* Allocate memory for the join buffer from the heap. */
if (bufsize > QMFB_JOINBUFSIZE) {
- if (!(buf = jas_malloc(bufsize * numcols * sizeof(jpc_fix_t)))) {
+ if (!(buf = jas_alloc3(bufsize, numcols, sizeof(jpc_fix_t)))) {
/* We have no choice but to commit suicide. */
abort();
}
diff -pruN jasper-1.900.1.orig/src/libjasper/jpc/jpc_t1enc.c jasper-1.900.1/src/libjasper/jpc/jpc_t1enc.c
--- jasper-1.900.1.orig/src/libjasper/jpc/jpc_t1enc.c 2007-01-19 22:43:07.000000000 +0100
+++ jasper-1.900.1/src/libjasper/jpc/jpc_t1enc.c 2009-10-22 10:27:45.000000000 +0200
@@ -219,7 +219,7 @@ int jpc_enc_enccblk(jpc_enc_t *enc, jas_
cblk->numpasses = (cblk->numbps > 0) ? (3 * cblk->numbps - 2) : 0;
if (cblk->numpasses > 0) {
- cblk->passes = jas_malloc(cblk->numpasses * sizeof(jpc_enc_pass_t));
+ cblk->passes = jas_alloc2(cblk->numpasses, sizeof(jpc_enc_pass_t));
assert(cblk->passes);
} else {
cblk->passes = 0;
diff -pruN jasper-1.900.1.orig/src/libjasper/jpc/jpc_t2cod.c jasper-1.900.1/src/libjasper/jpc/jpc_t2cod.c
--- jasper-1.900.1.orig/src/libjasper/jpc/jpc_t2cod.c 2007-01-19 22:43:07.000000000 +0100
+++ jasper-1.900.1/src/libjasper/jpc/jpc_t2cod.c 2009-10-22 10:27:45.000000000 +0200
@@ -573,7 +573,7 @@ int jpc_pchglist_insert(jpc_pchglist_t *
}
if (pchglist->numpchgs >= pchglist->maxpchgs) {
newmaxpchgs = pchglist->maxpchgs + 128;
- if (!(newpchgs = jas_realloc(pchglist->pchgs, newmaxpchgs * sizeof(jpc_pchg_t *)))) {
+ if (!(newpchgs = jas_realloc2(pchglist->pchgs, newmaxpchgs, sizeof(jpc_pchg_t *)))) {
return -1;
}
pchglist->maxpchgs = newmaxpchgs;
diff -pruN jasper-1.900.1.orig/src/libjasper/jpc/jpc_t2dec.c jasper-1.900.1/src/libjasper/jpc/jpc_t2dec.c
--- jasper-1.900.1.orig/src/libjasper/jpc/jpc_t2dec.c 2007-01-19 22:43:07.000000000 +0100
+++ jasper-1.900.1/src/libjasper/jpc/jpc_t2dec.c 2009-10-22 10:27:45.000000000 +0200
@@ -478,7 +478,7 @@ jpc_pi_t *jpc_dec_pi_create(jpc_dec_t *d
return 0;
}
pi->numcomps = dec->numcomps;
- if (!(pi->picomps = jas_malloc(pi->numcomps * sizeof(jpc_picomp_t)))) {
+ if (!(pi->picomps = jas_alloc2(pi->numcomps, sizeof(jpc_picomp_t)))) {
jpc_pi_destroy(pi);
return 0;
}
@@ -490,7 +490,7 @@ jpc_pi_t *jpc_dec_pi_create(jpc_dec_t *d
for (compno = 0, tcomp = tile->tcomps, picomp = pi->picomps;
compno < pi->numcomps; ++compno, ++tcomp, ++picomp) {
picomp->numrlvls = tcomp->numrlvls;
- if (!(picomp->pirlvls = jas_malloc(picomp->numrlvls *
+ if (!(picomp->pirlvls = jas_alloc2(picomp->numrlvls,
sizeof(jpc_pirlvl_t)))) {
jpc_pi_destroy(pi);
return 0;
@@ -503,7 +503,7 @@ jpc_pi_t *jpc_dec_pi_create(jpc_dec_t *d
rlvlno < picomp->numrlvls; ++rlvlno, ++pirlvl, ++rlvl) {
/* XXX sizeof(long) should be sizeof different type */
pirlvl->numprcs = rlvl->numprcs;
- if (!(pirlvl->prclyrnos = jas_malloc(pirlvl->numprcs *
+ if (!(pirlvl->prclyrnos = jas_alloc2(pirlvl->numprcs,
sizeof(long)))) {
jpc_pi_destroy(pi);
return 0;
diff -pruN jasper-1.900.1.orig/src/libjasper/jpc/jpc_t2enc.c jasper-1.900.1/src/libjasper/jpc/jpc_t2enc.c
--- jasper-1.900.1.orig/src/libjasper/jpc/jpc_t2enc.c 2007-01-19 22:43:07.000000000 +0100
+++ jasper-1.900.1/src/libjasper/jpc/jpc_t2enc.c 2009-10-22 10:27:45.000000000 +0200
@@ -565,7 +565,7 @@ jpc_pi_t *jpc_enc_pi_create(jpc_enc_cp_t
}
pi->pktno = -1;
pi->numcomps = cp->numcmpts;
- if (!(pi->picomps = jas_malloc(pi->numcomps * sizeof(jpc_picomp_t)))) {
+ if (!(pi->picomps = jas_alloc2(pi->numcomps, sizeof(jpc_picomp_t)))) {
jpc_pi_destroy(pi);
return 0;
}
@@ -577,7 +577,7 @@ jpc_pi_t *jpc_enc_pi_create(jpc_enc_cp_t
for (compno = 0, tcomp = tile->tcmpts, picomp = pi->picomps;
compno < pi->numcomps; ++compno, ++tcomp, ++picomp) {
picomp->numrlvls = tcomp->numrlvls;
- if (!(picomp->pirlvls = jas_malloc(picomp->numrlvls *
+ if (!(picomp->pirlvls = jas_alloc2(picomp->numrlvls,
sizeof(jpc_pirlvl_t)))) {
jpc_pi_destroy(pi);
return 0;
@@ -591,7 +591,7 @@ jpc_pi_t *jpc_enc_pi_create(jpc_enc_cp_t
/* XXX sizeof(long) should be sizeof different type */
pirlvl->numprcs = rlvl->numprcs;
if (rlvl->numprcs) {
- if (!(pirlvl->prclyrnos = jas_malloc(pirlvl->numprcs *
+ if (!(pirlvl->prclyrnos = jas_alloc2(pirlvl->numprcs,
sizeof(long)))) {
jpc_pi_destroy(pi);
return 0;
diff -pruN jasper-1.900.1.orig/src/libjasper/jpc/jpc_tagtree.c jasper-1.900.1/src/libjasper/jpc/jpc_tagtree.c
--- jasper-1.900.1.orig/src/libjasper/jpc/jpc_tagtree.c 2007-01-19 22:43:07.000000000 +0100
+++ jasper-1.900.1/src/libjasper/jpc/jpc_tagtree.c 2009-10-22 10:27:45.000000000 +0200
@@ -125,7 +125,7 @@ jpc_tagtree_t *jpc_tagtree_create(int nu
++numlvls;
} while (n > 1);
- if (!(tree->nodes_ = jas_malloc(tree->numnodes_ * sizeof(jpc_tagtreenode_t)))) {
+ if (!(tree->nodes_ = jas_alloc2(tree->numnodes_, sizeof(jpc_tagtreenode_t)))) {
return 0;
}
diff -pruN jasper-1.900.1.orig/src/libjasper/jpc/jpc_util.c jasper-1.900.1/src/libjasper/jpc/jpc_util.c
--- jasper-1.900.1.orig/src/libjasper/jpc/jpc_util.c 2007-01-19 22:43:07.000000000 +0100
+++ jasper-1.900.1/src/libjasper/jpc/jpc_util.c 2009-10-22 10:27:45.000000000 +0200
@@ -109,7 +109,7 @@ int jpc_atoaf(char *s, int *numvalues, d
}
if (n) {
- if (!(vs = jas_malloc(n * sizeof(double)))) {
+ if (!(vs = jas_alloc2(n, sizeof(double)))) {
return -1;
}
diff -pruN jasper-1.900.1.orig/src/libjasper/mif/mif_cod.c jasper-1.900.1/src/libjasper/mif/mif_cod.c
--- jasper-1.900.1.orig/src/libjasper/mif/mif_cod.c 2007-01-19 22:43:05.000000000 +0100
+++ jasper-1.900.1/src/libjasper/mif/mif_cod.c 2009-10-22 10:27:45.000000000 +0200
@@ -438,8 +438,7 @@ static int mif_hdr_growcmpts(mif_hdr_t *
int cmptno;
mif_cmpt_t **newcmpts;
assert(maxcmpts >= hdr->numcmpts);
- newcmpts = (!hdr->cmpts) ? jas_malloc(maxcmpts * sizeof(mif_cmpt_t *)) :
- jas_realloc(hdr->cmpts, maxcmpts * sizeof(mif_cmpt_t *));
+ newcmpts = jas_realloc2(hdr->cmpts, maxcmpts, sizeof(mif_cmpt_t *));
if (!newcmpts) {
return -1;
}

View file

@ -1,14 +0,0 @@
Fix CVE-2008-3522 (buffer overflow in 'jas_stream_printf').
Patch from <https://bugzilla.redhat.com/show_bug.cgi?id=CVE-2008-3522>.
--- jasper-1.900.1/src/libjasper/base/jas_stream.c 2008-09-08 14:56:01.000000000 +0200
+++ jasper-1.900.1/src/libjasper/base/jas_stream.c 2008-09-08 14:58:16.000000000 +0200
@@ -553,7 +553,7 @@ int jas_stream_printf(jas_stream_t *stre
int ret;
va_start(ap, fmt);
- ret = vsprintf(buf, fmt, ap);
+ ret = vsnprintf(buf, sizeof buf, fmt, ap);
jas_stream_puts(stream, buf);
va_end(ap);
return ret;

View file

@ -1,31 +0,0 @@
Fix CVE-2011-4516 and CVE-2011-4517 (heap buffer overflow flaws lead to
arbitrary code execution).
Copied from Fedora.
http://pkgs.fedoraproject.org/cgit/rpms/jasper.git/tree/jasper-1.900.1-CVE-2011-4516-CVE-2011-4517-CERT-VU-887409.patch
https://bugzilla.redhat.com/show_bug.cgi?id=747726
diff -up jasper-1.900.1/src/libjasper/jpc/jpc_cs.c.CERT-VU-887409 jasper-1.900.1/src/libjasper/jpc/jpc_cs.c
--- jasper-1.900.1/src/libjasper/jpc/jpc_cs.c.CERT-VU-887409 2011-10-25 17:25:39.000000000 +0200
+++ jasper-1.900.1/src/libjasper/jpc/jpc_cs.c 2011-10-25 17:29:14.379371908 +0200
@@ -744,6 +744,10 @@ static int jpc_cox_getcompparms(jpc_ms_t
return -1;
}
compparms->numrlvls = compparms->numdlvls + 1;
+ if (compparms->numrlvls > JPC_MAXRLVLS) {
+ jpc_cox_destroycompparms(compparms);
+ return -1;
+ }
if (prtflag) {
for (i = 0; i < compparms->numrlvls; ++i) {
if (jpc_getuint8(in, &tmp)) {
@@ -1331,7 +1335,7 @@ static int jpc_crg_getparms(jpc_ms_t *ms
jpc_crgcomp_t *comp;
uint_fast16_t compno;
crg->numcomps = cstate->numcomps;
- if (!(crg->comps = jas_alloc2(cstate->numcomps, sizeof(uint_fast16_t)))) {
+ if (!(crg->comps = jas_alloc2(cstate->numcomps, sizeof(jpc_crgcomp_t)))) {
return -1;
}
for (compno = 0, comp = crg->comps; compno < cstate->numcomps;

View file

@ -1,64 +0,0 @@
Fix CVE-2014-8137 (double-free in jas_iccattrval_destroy()).
Copied from Fedora.
http://pkgs.fedoraproject.org/cgit/rpms/jasper.git/tree/jasper-CVE-2014-8137.patch
https://bugzilla.redhat.com/show_bug.cgi?id=1173157
--- jasper-1.900.1.orig/src/libjasper/base/jas_icc.c 2014-12-11 14:06:44.000000000 +0100
+++ jasper-1.900.1/src/libjasper/base/jas_icc.c 2014-12-11 15:16:37.971272386 +0100
@@ -1009,7 +1009,6 @@ static int jas_icccurv_input(jas_iccattr
return 0;
error:
- jas_icccurv_destroy(attrval);
return -1;
}
@@ -1127,7 +1126,6 @@ static int jas_icctxtdesc_input(jas_icca
#endif
return 0;
error:
- jas_icctxtdesc_destroy(attrval);
return -1;
}
@@ -1206,8 +1204,6 @@ static int jas_icctxt_input(jas_iccattrv
goto error;
return 0;
error:
- if (txt->string)
- jas_free(txt->string);
return -1;
}
@@ -1328,7 +1324,6 @@ static int jas_icclut8_input(jas_iccattr
goto error;
return 0;
error:
- jas_icclut8_destroy(attrval);
return -1;
}
@@ -1497,7 +1492,6 @@ static int jas_icclut16_input(jas_iccatt
goto error;
return 0;
error:
- jas_icclut16_destroy(attrval);
return -1;
}
--- jasper-1.900.1.orig/src/libjasper/jp2/jp2_dec.c 2014-12-11 14:30:54.193209780 +0100
+++ jasper-1.900.1/src/libjasper/jp2/jp2_dec.c 2014-12-11 14:36:46.313217814 +0100
@@ -291,7 +291,10 @@ jas_image_t *jp2_decode(jas_stream_t *in
case JP2_COLR_ICC:
iccprof = jas_iccprof_createfrombuf(dec->colr->data.colr.iccp,
dec->colr->data.colr.iccplen);
- assert(iccprof);
+ if (!iccprof) {
+ jas_eprintf("error: failed to parse ICC profile\n");
+ goto error;
+ }
jas_iccprof_gethdr(iccprof, &icchdr);
jas_eprintf("ICC Profile CS %08x\n", icchdr.colorspc);
jas_image_setclrspc(dec->image, fromiccpcs(icchdr.colorspc));

View file

@ -1,21 +0,0 @@
Fix CVE-2014-8138 (heap overflow in jp2_decode()).
Copied from Fedora.
http://pkgs.fedoraproject.org/cgit/rpms/jasper.git/tree/jasper-CVE-2014-8138.patch
https://bugzilla.redhat.com/show_bug.cgi?id=1173162
--- jasper-1.900.1.orig/src/libjasper/jp2/jp2_dec.c 2014-12-11 14:06:44.000000000 +0100
+++ jasper-1.900.1/src/libjasper/jp2/jp2_dec.c 2014-12-11 14:06:26.000000000 +0100
@@ -386,6 +386,11 @@ jas_image_t *jp2_decode(jas_stream_t *in
/* Determine the type of each component. */
if (dec->cdef) {
for (i = 0; i < dec->numchans; ++i) {
+ /* Is the channel number reasonable? */
+ if (dec->cdef->data.cdef.ents[i].channo >= dec->numchans) {
+ jas_eprintf("error: invalid channel number in CDEF box\n");
+ goto error;
+ }
jas_image_setcmpttype(dec->image,
dec->chantocmptlut[dec->cdef->data.cdef.ents[i].channo],
jp2_getct(jas_image_clrspc(dec->image),

View file

@ -1,19 +0,0 @@
Fix CVE-2014-8157 (dec->numtiles off-by-one check in jpc_dec_process_sot()).
Copied from Fedora.
http://pkgs.fedoraproject.org/cgit/rpms/jasper.git/tree/jasper-CVE-2014-8157.patch
https://bugzilla.redhat.com/show_bug.cgi?id=1179282
diff -up jasper-1.900.1/src/libjasper/jpc/jpc_dec.c.CVE-2014-8157 jasper-1.900.1/src/libjasper/jpc/jpc_dec.c
--- jasper-1.900.1/src/libjasper/jpc/jpc_dec.c.CVE-2014-8157 2015-01-19 16:59:36.000000000 +0100
+++ jasper-1.900.1/src/libjasper/jpc/jpc_dec.c 2015-01-19 17:07:41.609863268 +0100
@@ -489,7 +489,7 @@ static int jpc_dec_process_sot(jpc_dec_t
dec->curtileendoff = 0;
}
- if (JAS_CAST(int, sot->tileno) > dec->numtiles) {
+ if (JAS_CAST(int, sot->tileno) >= dec->numtiles) {
jas_eprintf("invalid tile number in SOT marker segment\n");
return -1;
}

View file

@ -1,336 +0,0 @@
Fix CVE-2014-8158 (unrestricted stack memory use in jpc_qmfb.c).
Copied from Fedora.
http://pkgs.fedoraproject.org/cgit/rpms/jasper.git/tree/jasper-CVE-2014-8158.patch
https://bugzilla.redhat.com/show_bug.cgi?id=1179298
diff -up jasper-1.900.1/src/libjasper/jpc/jpc_qmfb.c.CVE-2014-8158 jasper-1.900.1/src/libjasper/jpc/jpc_qmfb.c
--- jasper-1.900.1/src/libjasper/jpc/jpc_qmfb.c.CVE-2014-8158 2015-01-19 17:25:28.730195502 +0100
+++ jasper-1.900.1/src/libjasper/jpc/jpc_qmfb.c 2015-01-19 17:27:20.214663127 +0100
@@ -306,11 +306,7 @@ void jpc_qmfb_split_row(jpc_fix_t *a, in
{
int bufsize = JPC_CEILDIVPOW2(numcols, 1);
-#if !defined(HAVE_VLA)
jpc_fix_t splitbuf[QMFB_SPLITBUFSIZE];
-#else
- jpc_fix_t splitbuf[bufsize];
-#endif
jpc_fix_t *buf = splitbuf;
register jpc_fix_t *srcptr;
register jpc_fix_t *dstptr;
@@ -318,7 +314,6 @@ void jpc_qmfb_split_row(jpc_fix_t *a, in
register int m;
int hstartcol;
-#if !defined(HAVE_VLA)
/* Get a buffer. */
if (bufsize > QMFB_SPLITBUFSIZE) {
if (!(buf = jas_alloc2(bufsize, sizeof(jpc_fix_t)))) {
@@ -326,7 +321,6 @@ void jpc_qmfb_split_row(jpc_fix_t *a, in
abort();
}
}
-#endif
if (numcols >= 2) {
hstartcol = (numcols + 1 - parity) >> 1;
@@ -360,12 +354,10 @@ void jpc_qmfb_split_row(jpc_fix_t *a, in
}
}
-#if !defined(HAVE_VLA)
/* If the split buffer was allocated on the heap, free this memory. */
if (buf != splitbuf) {
jas_free(buf);
}
-#endif
}
@@ -374,11 +366,7 @@ void jpc_qmfb_split_col(jpc_fix_t *a, in
{
int bufsize = JPC_CEILDIVPOW2(numrows, 1);
-#if !defined(HAVE_VLA)
jpc_fix_t splitbuf[QMFB_SPLITBUFSIZE];
-#else
- jpc_fix_t splitbuf[bufsize];
-#endif
jpc_fix_t *buf = splitbuf;
register jpc_fix_t *srcptr;
register jpc_fix_t *dstptr;
@@ -386,7 +374,6 @@ void jpc_qmfb_split_col(jpc_fix_t *a, in
register int m;
int hstartcol;
-#if !defined(HAVE_VLA)
/* Get a buffer. */
if (bufsize > QMFB_SPLITBUFSIZE) {
if (!(buf = jas_alloc2(bufsize, sizeof(jpc_fix_t)))) {
@@ -394,7 +381,6 @@ void jpc_qmfb_split_col(jpc_fix_t *a, in
abort();
}
}
-#endif
if (numrows >= 2) {
hstartcol = (numrows + 1 - parity) >> 1;
@@ -428,12 +414,10 @@ void jpc_qmfb_split_col(jpc_fix_t *a, in
}
}
-#if !defined(HAVE_VLA)
/* If the split buffer was allocated on the heap, free this memory. */
if (buf != splitbuf) {
jas_free(buf);
}
-#endif
}
@@ -442,11 +426,7 @@ void jpc_qmfb_split_colgrp(jpc_fix_t *a,
{
int bufsize = JPC_CEILDIVPOW2(numrows, 1);
-#if !defined(HAVE_VLA)
jpc_fix_t splitbuf[QMFB_SPLITBUFSIZE * JPC_QMFB_COLGRPSIZE];
-#else
- jpc_fix_t splitbuf[bufsize * JPC_QMFB_COLGRPSIZE];
-#endif
jpc_fix_t *buf = splitbuf;
jpc_fix_t *srcptr;
jpc_fix_t *dstptr;
@@ -457,7 +437,6 @@ void jpc_qmfb_split_colgrp(jpc_fix_t *a,
int m;
int hstartcol;
-#if !defined(HAVE_VLA)
/* Get a buffer. */
if (bufsize > QMFB_SPLITBUFSIZE) {
if (!(buf = jas_alloc2(bufsize, sizeof(jpc_fix_t)))) {
@@ -465,7 +444,6 @@ void jpc_qmfb_split_colgrp(jpc_fix_t *a,
abort();
}
}
-#endif
if (numrows >= 2) {
hstartcol = (numrows + 1 - parity) >> 1;
@@ -517,12 +495,10 @@ void jpc_qmfb_split_colgrp(jpc_fix_t *a,
}
}
-#if !defined(HAVE_VLA)
/* If the split buffer was allocated on the heap, free this memory. */
if (buf != splitbuf) {
jas_free(buf);
}
-#endif
}
@@ -531,11 +507,7 @@ void jpc_qmfb_split_colres(jpc_fix_t *a,
{
int bufsize = JPC_CEILDIVPOW2(numrows, 1);
-#if !defined(HAVE_VLA)
jpc_fix_t splitbuf[QMFB_SPLITBUFSIZE * JPC_QMFB_COLGRPSIZE];
-#else
- jpc_fix_t splitbuf[bufsize * numcols];
-#endif
jpc_fix_t *buf = splitbuf;
jpc_fix_t *srcptr;
jpc_fix_t *dstptr;
@@ -546,7 +518,6 @@ void jpc_qmfb_split_colres(jpc_fix_t *a,
int m;
int hstartcol;
-#if !defined(HAVE_VLA)
/* Get a buffer. */
if (bufsize > QMFB_SPLITBUFSIZE) {
if (!(buf = jas_alloc2(bufsize, sizeof(jpc_fix_t)))) {
@@ -554,7 +525,6 @@ void jpc_qmfb_split_colres(jpc_fix_t *a,
abort();
}
}
-#endif
if (numrows >= 2) {
hstartcol = (numrows + 1 - parity) >> 1;
@@ -606,12 +576,10 @@ void jpc_qmfb_split_colres(jpc_fix_t *a,
}
}
-#if !defined(HAVE_VLA)
/* If the split buffer was allocated on the heap, free this memory. */
if (buf != splitbuf) {
jas_free(buf);
}
-#endif
}
@@ -619,18 +587,13 @@ void jpc_qmfb_join_row(jpc_fix_t *a, int
{
int bufsize = JPC_CEILDIVPOW2(numcols, 1);
-#if !defined(HAVE_VLA)
jpc_fix_t joinbuf[QMFB_JOINBUFSIZE];
-#else
- jpc_fix_t joinbuf[bufsize];
-#endif
jpc_fix_t *buf = joinbuf;
register jpc_fix_t *srcptr;
register jpc_fix_t *dstptr;
register int n;
int hstartcol;
-#if !defined(HAVE_VLA)
/* Allocate memory for the join buffer from the heap. */
if (bufsize > QMFB_JOINBUFSIZE) {
if (!(buf = jas_alloc2(bufsize, sizeof(jpc_fix_t)))) {
@@ -638,7 +601,6 @@ void jpc_qmfb_join_row(jpc_fix_t *a, int
abort();
}
}
-#endif
hstartcol = (numcols + 1 - parity) >> 1;
@@ -670,12 +632,10 @@ void jpc_qmfb_join_row(jpc_fix_t *a, int
++srcptr;
}
-#if !defined(HAVE_VLA)
/* If the join buffer was allocated on the heap, free this memory. */
if (buf != joinbuf) {
jas_free(buf);
}
-#endif
}
@@ -684,18 +644,13 @@ void jpc_qmfb_join_col(jpc_fix_t *a, int
{
int bufsize = JPC_CEILDIVPOW2(numrows, 1);
-#if !defined(HAVE_VLA)
jpc_fix_t joinbuf[QMFB_JOINBUFSIZE];
-#else
- jpc_fix_t joinbuf[bufsize];
-#endif
jpc_fix_t *buf = joinbuf;
register jpc_fix_t *srcptr;
register jpc_fix_t *dstptr;
register int n;
int hstartcol;
-#if !defined(HAVE_VLA)
/* Allocate memory for the join buffer from the heap. */
if (bufsize > QMFB_JOINBUFSIZE) {
if (!(buf = jas_alloc2(bufsize, sizeof(jpc_fix_t)))) {
@@ -703,7 +658,6 @@ void jpc_qmfb_join_col(jpc_fix_t *a, int
abort();
}
}
-#endif
hstartcol = (numrows + 1 - parity) >> 1;
@@ -735,12 +689,10 @@ void jpc_qmfb_join_col(jpc_fix_t *a, int
++srcptr;
}
-#if !defined(HAVE_VLA)
/* If the join buffer was allocated on the heap, free this memory. */
if (buf != joinbuf) {
jas_free(buf);
}
-#endif
}
@@ -749,11 +701,7 @@ void jpc_qmfb_join_colgrp(jpc_fix_t *a,
{
int bufsize = JPC_CEILDIVPOW2(numrows, 1);
-#if !defined(HAVE_VLA)
jpc_fix_t joinbuf[QMFB_JOINBUFSIZE * JPC_QMFB_COLGRPSIZE];
-#else
- jpc_fix_t joinbuf[bufsize * JPC_QMFB_COLGRPSIZE];
-#endif
jpc_fix_t *buf = joinbuf;
jpc_fix_t *srcptr;
jpc_fix_t *dstptr;
@@ -763,7 +711,6 @@ void jpc_qmfb_join_colgrp(jpc_fix_t *a,
register int i;
int hstartcol;
-#if !defined(HAVE_VLA)
/* Allocate memory for the join buffer from the heap. */
if (bufsize > QMFB_JOINBUFSIZE) {
if (!(buf = jas_alloc2(bufsize, JPC_QMFB_COLGRPSIZE * sizeof(jpc_fix_t)))) {
@@ -771,7 +718,6 @@ void jpc_qmfb_join_colgrp(jpc_fix_t *a,
abort();
}
}
-#endif
hstartcol = (numrows + 1 - parity) >> 1;
@@ -821,12 +767,10 @@ void jpc_qmfb_join_colgrp(jpc_fix_t *a,
srcptr += JPC_QMFB_COLGRPSIZE;
}
-#if !defined(HAVE_VLA)
/* If the join buffer was allocated on the heap, free this memory. */
if (buf != joinbuf) {
jas_free(buf);
}
-#endif
}
@@ -835,11 +779,7 @@ void jpc_qmfb_join_colres(jpc_fix_t *a,
{
int bufsize = JPC_CEILDIVPOW2(numrows, 1);
-#if !defined(HAVE_VLA)
jpc_fix_t joinbuf[QMFB_JOINBUFSIZE * JPC_QMFB_COLGRPSIZE];
-#else
- jpc_fix_t joinbuf[bufsize * numcols];
-#endif
jpc_fix_t *buf = joinbuf;
jpc_fix_t *srcptr;
jpc_fix_t *dstptr;
@@ -849,7 +789,6 @@ void jpc_qmfb_join_colres(jpc_fix_t *a,
register int i;
int hstartcol;
-#if !defined(HAVE_VLA)
/* Allocate memory for the join buffer from the heap. */
if (bufsize > QMFB_JOINBUFSIZE) {
if (!(buf = jas_alloc3(bufsize, numcols, sizeof(jpc_fix_t)))) {
@@ -857,7 +796,6 @@ void jpc_qmfb_join_colres(jpc_fix_t *a,
abort();
}
}
-#endif
hstartcol = (numrows + 1 - parity) >> 1;
@@ -907,12 +845,10 @@ void jpc_qmfb_join_colres(jpc_fix_t *a,
srcptr += numcols;
}
-#if !defined(HAVE_VLA)
/* If the join buffer was allocated on the heap, free this memory. */
if (buf != joinbuf) {
jas_free(buf);
}
-#endif
}

View file

@ -1,36 +0,0 @@
Fix CVE-2014-9029 (Heap overflows in libjasper).
Copied from Fedora.
http://pkgs.fedoraproject.org/cgit/rpms/jasper.git/tree/jasper-CVE-2014-9029.patch
https://bugzilla.redhat.com/show_bug.cgi?id=1167537
--- jasper-1.900.1.orig/src/libjasper/jpc/jpc_dec.c 2014-11-27 12:45:44.000000000 +0100
+++ jasper-1.900.1/src/libjasper/jpc/jpc_dec.c 2014-11-27 12:44:58.000000000 +0100
@@ -1281,7 +1281,7 @@ static int jpc_dec_process_coc(jpc_dec_t
jpc_coc_t *coc = &ms->parms.coc;
jpc_dec_tile_t *tile;
- if (JAS_CAST(int, coc->compno) > dec->numcomps) {
+ if (JAS_CAST(int, coc->compno) >= dec->numcomps) {
jas_eprintf("invalid component number in COC marker segment\n");
return -1;
}
@@ -1307,7 +1307,7 @@ static int jpc_dec_process_rgn(jpc_dec_t
jpc_rgn_t *rgn = &ms->parms.rgn;
jpc_dec_tile_t *tile;
- if (JAS_CAST(int, rgn->compno) > dec->numcomps) {
+ if (JAS_CAST(int, rgn->compno) >= dec->numcomps) {
jas_eprintf("invalid component number in RGN marker segment\n");
return -1;
}
@@ -1356,7 +1356,7 @@ static int jpc_dec_process_qcc(jpc_dec_t
jpc_qcc_t *qcc = &ms->parms.qcc;
jpc_dec_tile_t *tile;
- if (JAS_CAST(int, qcc->compno) > dec->numcomps) {
+ if (JAS_CAST(int, qcc->compno) >= dec->numcomps) {
jas_eprintf("invalid component number in QCC marker segment\n");
return -1;
}

View file

@ -1,19 +0,0 @@
Description: CVE-2016-1577: Prevent double-free in jas_iccattrval_destroy()
Origin: vendor, http://www.openwall.com/lists/oss-security/2016/03/03/12
Bug-Ubuntu: https://launchpad.net/bugs/1547865
Bug-Debian: https://bugs.debian.org/816625
Forwarded: not-needed
Author: Tyler Hicks <tyhicks@canonical.com>
Reviewed-by: Salvatore Bonaccorso <carnil@debian.org>
Last-Update: 2016-03-05
--- a/src/libjasper/base/jas_icc.c
+++ b/src/libjasper/base/jas_icc.c
@@ -300,6 +300,7 @@ jas_iccprof_t *jas_iccprof_load(jas_stre
if (jas_iccprof_setattr(prof, tagtabent->tag, attrval))
goto error;
jas_iccattrval_destroy(attrval);
+ attrval = 0;
} else {
#if 0
jas_eprintf("warning: skipping unknown tag type\n");

View file

@ -1,18 +0,0 @@
Fix CVE-2016-1867 (Out-of-bounds read in jpc_pi_nextcprl()).
Copied from SUSE.
https://bugzilla.suse.com/show_bug.cgi?id=961886
https://bugzilla.redhat.com/show_bug.cgi?id=1298135
--- jasper-1.900.1/src/libjasper/jpc/jpc_t2cod.c 2007-01-19 22:43:07.000000000 +0100
+++ jasper-1.900.1/src/libjasper/jpc/jpc_t2cod.c 2016-01-14 14:22:24.569056412 +0100
@@ -429,7 +429,7 @@
}
for (pi->compno = pchg->compnostart, pi->picomp =
- &pi->picomps[pi->compno]; pi->compno < JAS_CAST(int, pchg->compnoend); ++pi->compno,
+ &pi->picomps[pi->compno]; pi->compno < JAS_CAST(int, pchg->compnoend) && pi->compno < pi->numcomps; ++pi->compno,
++pi->picomp) {
pirlvl = pi->picomp->pirlvls;
pi->xstep = pi->picomp->hsamp * (1 << (pirlvl->prcwidthexpn +

View file

@ -1,90 +0,0 @@
Description: CVE-2016-2089: matrix rows_ NULL pointer dereference in jas_matrix_clip()
Origin: vendor
Bug-RedHat: https://bugzilla.redhat.com/show_bug.cgi?id=1302636
Bug-Debian: https://bugs.debian.org/812978
Forwarded: not-needed
Author: Tomas Hoger <thoger@redhat.com>
Reviewed-by: Salvatore Bonaccorso <carnil@debian.org>
Last-Update: 2016-03-05
--- a/src/libjasper/base/jas_image.c
+++ b/src/libjasper/base/jas_image.c
@@ -426,6 +426,10 @@ int jas_image_readcmpt(jas_image_t *imag
return -1;
}
+ if (!data->rows_) {
+ return -1;
+ }
+
if (jas_matrix_numrows(data) != height || jas_matrix_numcols(data) != width) {
if (jas_matrix_resize(data, height, width)) {
return -1;
@@ -479,6 +483,10 @@ int jas_image_writecmpt(jas_image_t *ima
return -1;
}
+ if (!data->rows_) {
+ return -1;
+ }
+
if (jas_matrix_numrows(data) != height || jas_matrix_numcols(data) != width) {
return -1;
}
--- a/src/libjasper/base/jas_seq.c
+++ b/src/libjasper/base/jas_seq.c
@@ -262,6 +262,10 @@ void jas_matrix_divpow2(jas_matrix_t *ma
int rowstep;
jas_seqent_t *data;
+ if (!matrix->rows_) {
+ return;
+ }
+
rowstep = jas_matrix_rowstep(matrix);
for (i = matrix->numrows_, rowstart = matrix->rows_[0]; i > 0; --i,
rowstart += rowstep) {
@@ -282,6 +286,10 @@ void jas_matrix_clip(jas_matrix_t *matri
jas_seqent_t *data;
int rowstep;
+ if (!matrix->rows_) {
+ return;
+ }
+
rowstep = jas_matrix_rowstep(matrix);
for (i = matrix->numrows_, rowstart = matrix->rows_[0]; i > 0; --i,
rowstart += rowstep) {
@@ -306,6 +314,10 @@ void jas_matrix_asr(jas_matrix_t *matrix
int rowstep;
jas_seqent_t *data;
+ if (!matrix->rows_) {
+ return;
+ }
+
assert(n >= 0);
rowstep = jas_matrix_rowstep(matrix);
for (i = matrix->numrows_, rowstart = matrix->rows_[0]; i > 0; --i,
@@ -325,6 +337,10 @@ void jas_matrix_asl(jas_matrix_t *matrix
int rowstep;
jas_seqent_t *data;
+ if (!matrix->rows_) {
+ return;
+ }
+
rowstep = jas_matrix_rowstep(matrix);
for (i = matrix->numrows_, rowstart = matrix->rows_[0]; i > 0; --i,
rowstart += rowstep) {
@@ -367,6 +383,10 @@ void jas_matrix_setall(jas_matrix_t *mat
int rowstep;
jas_seqent_t *data;
+ if (!matrix->rows_) {
+ return;
+ }
+
rowstep = jas_matrix_rowstep(matrix);
for (i = matrix->numrows_, rowstart = matrix->rows_[0]; i > 0; --i,
rowstart += rowstep) {

View file

@ -1,19 +0,0 @@
Description: CVE-2016-2116: Prevent jas_stream_t memory leak in jas_iccprof_createfrombuf()
Origin: vendor, http://www.openwall.com/lists/oss-security/2016/03/03/12
Bug-Debian: https://bugs.debian.org/816626
Forwarded: not-needed
Author: Tyler Hicks <tyhicks@canoonical.com>
Reviewed-by: Salvatore Bonaccorso <carnil@debian.org>
Last-Update: 2016-03-05
--- a/src/libjasper/base/jas_icc.c
+++ b/src/libjasper/base/jas_icc.c
@@ -1693,6 +1693,8 @@ jas_iccprof_t *jas_iccprof_createfrombuf
jas_stream_close(in);
return prof;
error:
+ if (in)
+ jas_stream_close(in);
return 0;
}

View file

@ -0,0 +1,17 @@
Description: Avoid compilation error with gcc-4.4.
"const char* -> char*" conversion is fatal in that version
Origin: vendor, https://bugs.launchpad.net/ubuntu/+source/kobodeluxe/+bug/461373
Bug-Ubuntu: https://bugs.launchpad.net/ubuntu/+source/kobodeluxe/+bug/461373
Bug-Debian: http://bugs.debian.org/552548
Forwarded: http://www.freelists.org/post/olofsonprojects/kobodlpatch-compile-error-in-windowcpp-with-g44
--- a/graphics/window.cpp
+++ b/graphics/window.cpp
@@ -398,7 +398,7 @@ void window_t::center_token_fxp(int _x,
*/
if(token)
{
- char *tok = strchr(txt, token);
+ const char *tok = strchr(txt, token);
if(tok)
tokpos = tok-txt;
else

View file

@ -0,0 +1,67 @@
# Authhor: Damyan Ivanov <dmn@debian.org>
# Description: rename pipe2 symbol to pipe2_kbdl to avoid clashes with the one
# declared in system unistd.h
# Debian-Bug: 527705
# Upstream-Report: http://www.freelists.org/post/olofsonprojects/kobodeluxe-failing-to-build-in-Debian-enemiesh75-error-const-enemy-kind-pipe2-redeclared-as-different-kind-of-symbol
--- a/enemies.h
+++ b/enemies.h
@@ -72,7 +72,7 @@ extern const enemy_kind bombdeto;
extern const enemy_kind cannon;
extern const enemy_kind pipe1;
extern const enemy_kind core;
-extern const enemy_kind pipe2;
+extern const enemy_kind pipe2_kbdl;
extern const enemy_kind rock;
extern const enemy_kind ring;
extern const enemy_kind enemy_m1;
@@ -430,7 +430,7 @@ inline int _enemy::realize()
inline int _enemy::is_pipe()
{
- return ((_state != notuse) && ((ek == &pipe1) || (ek == &pipe2)));
+ return ((_state != notuse) && ((ek == &pipe1) || (ek == &pipe2_kbdl)));
}
--- a/enemy.cpp
+++ b/enemy.cpp
@@ -755,10 +755,10 @@ void _enemy::move_core()
void _enemy::kill_core()
{
- enemies.make(&pipe2, CS2PIXEL(x), CS2PIXEL(y), 0, 0, 3);
- enemies.make(&pipe2, CS2PIXEL(x), CS2PIXEL(y), 0, 0, 7);
- enemies.make(&pipe2, CS2PIXEL(x), CS2PIXEL(y), 0, 0, 1);
- enemies.make(&pipe2, CS2PIXEL(x), CS2PIXEL(y), 0, 0, 5);
+ enemies.make(&pipe2_kbdl, CS2PIXEL(x), CS2PIXEL(y), 0, 0, 3);
+ enemies.make(&pipe2_kbdl, CS2PIXEL(x), CS2PIXEL(y), 0, 0, 7);
+ enemies.make(&pipe2_kbdl, CS2PIXEL(x), CS2PIXEL(y), 0, 0, 1);
+ enemies.make(&pipe2_kbdl, CS2PIXEL(x), CS2PIXEL(y), 0, 0, 5);
enemies.make(&explosion4, CS2PIXEL(x), CS2PIXEL(y));
sound.g_base_core_explo(x, y);
release();
@@ -978,19 +978,19 @@ void _enemy::move_pipe2()
}
p ^= a;
if(p & U_MASK)
- enemies.make(&pipe2, CS2PIXEL(x), CS2PIXEL(y), 0, 0, 1);
+ enemies.make(&pipe2_kbdl, CS2PIXEL(x), CS2PIXEL(y), 0, 0, 1);
if(p & R_MASK)
- enemies.make(&pipe2, CS2PIXEL(x), CS2PIXEL(y), 0, 0, 3);
+ enemies.make(&pipe2_kbdl, CS2PIXEL(x), CS2PIXEL(y), 0, 0, 3);
if(p & D_MASK)
- enemies.make(&pipe2, CS2PIXEL(x), CS2PIXEL(y), 0, 0, 5);
+ enemies.make(&pipe2_kbdl, CS2PIXEL(x), CS2PIXEL(y), 0, 0, 5);
if(p & L_MASK)
- enemies.make(&pipe2, CS2PIXEL(x), CS2PIXEL(y), 0, 0, 7);
+ enemies.make(&pipe2_kbdl, CS2PIXEL(x), CS2PIXEL(y), 0, 0, 7);
manage.add_score(10);
release();
}
-const enemy_kind pipe2 = {
+const enemy_kind pipe2_kbdl = {
0,
&_enemy::make_pipe2,
&_enemy::move_pipe2,

View file

@ -0,0 +1,38 @@
# This was created in responce to Debian bug #163979
# Thing is, if you want to compant "-1" with a char value,
# you better make that char signed
--- kobodeluxe-0.5.1.orig/graphics/window.cpp
+++ kobodeluxe-0.5.1/graphics/window.cpp
@@ -331,7 +331,7 @@
}
-void window_t::center_token(int _x, int _y, const char *txt, char token)
+void window_t::center_token(int _x, int _y, const char *txt, signed char token)
{
center_token_fxp(PIXEL2CS(_x), PIXEL2CS(_y), txt, token);
}
@@ -374,7 +374,7 @@
}
-void window_t::center_token_fxp(int _x, int _y, const char *txt, char token)
+void window_t::center_token_fxp(int _x, int _y, const char *txt, signed char token)
{
_x = CS2PIXEL((_x * xs + 128) >> 8);
_y = CS2PIXEL((_y * ys + 128) >> 8);
--- kobodeluxe-0.5.1.orig/graphics/window.h
+++ kobodeluxe-0.5.1/graphics/window.h
@@ -265,10 +265,10 @@
void font(int fnt);
void string(int _x, int _y, const char *txt);
void center(int _y, const char *txt);
- void center_token(int _x, int _y, const char *txt, char token = 0);
+ void center_token(int _x, int _y, const char *txt, signed char token = 0);
void string_fxp(int _x, int _y, const char *txt);
void center_fxp(int _y, const char *txt);
- void center_token_fxp(int _x, int _y, const char *txt, char token = 0);
+ void center_token_fxp(int _x, int _y, const char *txt, signed char token = 0);
int textwidth(const char *txt, int min = 0, int max = 255);
int textwidth_fxp(const char *txt, int min = 0, int max = 255);
int fontheight();

View file

@ -0,0 +1,15 @@
# Author: Damyan Ivanov <dmn@debian.org>
# Description: convert a hyphen in kobodl manpage to a minus, which is what is
# inttented here
# Upstream-Report: http://www.freelists.org/post/olofsonprojects/patch-manpage-uses-hyphen-instead-of-a-minus-sign
--- a/kobodl.6
+++ b/kobodl.6
@@ -176,7 +176,7 @@ Video Mode. Default: 17200.
Enable Vertical Sync. Default: On.
.TP
.B \-videopages
-Number of Video Pages. Default: -1.
+Number of Video Pages. Default: \-1.
.TP
.B \-scalemode
Scaling Filter Mode. Default: 1.

View file

@ -0,0 +1,24 @@
From: Emile CARRY <emile.carry@sequanux.org>
Date: Wed, 6 Apr 2016 00:27:17 +0200
Subject: midicon segmentation fault
Debian-Bug: https://bugs.debian.org/819897
Forwarded: no
---
sound/a_midicon.c | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
diff --git a/sound/a_midicon.c b/sound/a_midicon.c
index 57de3cf..ded2988 100644
--- a/sound/a_midicon.c
+++ b/sound/a_midicon.c
@@ -120,8 +120,8 @@ static inline void __press(unsigned ch, unsigned key)
{
m[ch].next[key] = -1;
m[ch].prev[key] = m[ch].last;
- m[ch].next[m[ch].last] = (char)key;
m[ch].last = (char)key;
+ m[ch].next[m[ch].last] = (char)key;
}

View file

@ -0,0 +1,43 @@
# Patch snarfed from
# http://http.debian.net/debian/pool/main/k/kobodeluxe/kobodeluxe_0.5.1-8.debian.tar.xz
#
# Disable reading of configs, graphics, and data from the current directory.
# So it's safe to run kobodeluxe from anywhere w/o worry about an attacker
# feeding it bad data.
--- kobodeluxe-0.5.1.orig/kobo.cpp
+++ kobodeluxe-0.5.1/kobo.cpp
@@ -141,21 +141,21 @@
* Graphics data
*/
/* Current dir; from within the build tree */
- fmap->addpath("GFX", "./data/gfx");
+ //fmap->addpath("GFX", "./data/gfx");
/* Real data dir */
fmap->addpath("GFX", "DATA>>gfx");
/* Current dir */
- fmap->addpath("GFX", "./gfx");
+ //fmap->addpath("GFX", "./gfx");
/*
* Sound data
*/
/* Current dir; from within the build tree */
- fmap->addpath("SFX", "./data/sfx");
+ //fmap->addpath("SFX", "./data/sfx");
/* Real data dir */
fmap->addpath("SFX", "DATA>>sfx");
/* Current dir */
- fmap->addpath("SFX", "./sfx");
+ //fmap->addpath("SFX", "./sfx");
/*
* Score files (user and global)
@@ -173,7 +173,7 @@
/* System local */
fmap->addpath("CONFIG", SYSCONF_DIR);
/* In current dir (last resort) */
- fmap->addpath("CONFIG", "./");
+ //fmap->addpath("CONFIG", "./");
}

View file

@ -1,18 +0,0 @@
Skip DNS tests that rely on the ability to look up arbitary
host names.
--- torsocks/tests/test_dns.c 2015-11-10 18:30:53.955941984 +0100
+++ torsocks/tests/test_dns.c 2015-11-10 18:31:02.199941892 +0100
@@ -134,11 +134,8 @@ static void test_getaddrinfo(const struc
int main(int argc, char **argv)
{
/* Libtap call for the number of tests planned. */
- plan_tests(NUM_TESTS);
+ plan_tests(1);
- test_getaddrinfo(&tor_check);
- test_gethostbyname(&tor_dir_auth1);
- test_gethostbyaddr(&tor_dir_auth2);
test_getaddrinfo(&tor_localhost);
return 0;

View file

@ -980,7 +980,7 @@ (define-public python-dateutil-2
(build-system python-build-system)
(inputs
`(("python-six" ,python-six)))
(home-page "http://labix.org/python-dateutil")
(home-page "https://dateutil.readthedocs.io/en/stable/")
(synopsis "Extensions to the standard datetime module")
(description
"The dateutil module provides powerful extensions to the standard
@ -1010,7 +1010,7 @@ (define-public python-dateutil
(build-system python-build-system)
(inputs
`(("python-setuptools" ,python-setuptools)))
(home-page "http://labix.org/python-dateutil")
(home-page "https://dateutil.readthedocs.io/en/stable/")
(synopsis "Extensions to the standard datetime module")
(description
"The dateutil module provides powerful extensions to the standard

View file

@ -591,160 +591,6 @@ (define-public chibi-scheme
threads.")
(license bsd-3)))
(define nanopass
(let ((version "1.9"))
(origin
(method url-fetch)
(uri (string-append
"https://github.com/nanopass/nanopass-framework-scheme/archive"
"/v" version ".tar.gz"))
(sha256 (base32 "11pwyy4jiwhcl2am3a4ciczacjbjkyvdizqzdglb3l1hj2gj6nv2"))
(file-name (string-append "nanopass-" version ".tar.gz")))))
(define stex
(let ((version "1.2.1"))
(origin
(method url-fetch)
(uri (string-append
"https://github.com/dybvig/stex/archive"
"/v" version ".tar.gz"))
(sha256 (base32 "03pl3f668h24dn51vccr1sj5lsba9zq3j37bnxjvdadcdaj4qy5z"))
(file-name (string-append "stex-" version ".tar.gz")))))
(define-public chez-scheme
(package
(name "chez-scheme")
(version "9.4")
(source
(origin
(method url-fetch)
(uri (string-append "https://github.com/cisco/ChezScheme/archive/"
"v" version ".tar.gz"))
(sha256
(base32 "0lprmpsjg2plc6ykgkz482zyvhkzv6gd0vnar71ph21h6zknyklz"))
(file-name (string-append "chez-scheme-" version ".tar.gz"))))
(build-system gnu-build-system)
(inputs
`(("ncurses" ,ncurses)
("libx11" ,libx11)
("xorg-rgb" ,xorg-rgb)
("nanopass" ,nanopass)
("zlib" ,zlib)
("stex" ,stex)))
(native-inputs
`(("texlive" ,texlive)
("ghostscript" ,ghostscript)
("netpbm" ,netpbm)))
(outputs '("out" "doc"))
(arguments
`(#:modules ((guix build gnu-build-system)
(guix build utils)
(ice-9 match))
#:test-target "test"
#:phases
(modify-phases %standard-phases
;; Adapt the custom 'configure' script.
(replace 'configure
(lambda* (#:key inputs outputs #:allow-other-keys)
(let ((out (assoc-ref outputs "out"))
(nanopass (assoc-ref inputs "nanopass"))
(stex (assoc-ref inputs "stex"))
(zlib (assoc-ref inputs "zlib"))
(unpack (assoc-ref %standard-phases 'unpack))
(patch-source-shebangs
(assoc-ref %standard-phases 'patch-source-shebangs)))
(map (match-lambda
((src orig-name new-name)
(with-directory-excursion "."
(apply unpack (list #:source src))
(apply patch-source-shebangs (list #:source src)))
(delete-file-recursively new-name)
(system* "mv" orig-name new-name)))
`((,nanopass "nanopass-framework-scheme-1.9" "nanopass")
(,stex "stex-1.2.1" "stex")))
;; The Makefile wants to download and compile "zlib". We patch
;; it to use the one from our 'zlib' package.
(substitute* "configure"
(("rmdir zlib .*$") "echo \"using system zlib\"\n"))
(substitute* (find-files "./c" "Mf-[a-zA-Z0-9.]+")
(("\\$\\{Kernel\\}: \\$\\{kernelobj\\} \\.\\./zlib/libz\\.a")
"${Kernel}: ${kernelobj}")
(("ld -melf_x86_64 -r -X -o \\$\\{Kernel\\} \\$\\{kernelobj\\} \\.\\./zlib/libz\\.a")
(string-append "ld -melf_x86_64 -r -X -o ${Kernel} ${kernelobj} "
zlib "/lib/libz.a"))
(("\\(cd \\.\\./zlib; CFLAGS=-m64 \\./configure --64)")
(which "true"))
(("(cd \\.\\./zlib; make)")
(which "true")))
(substitute* (find-files "mats" "Mf-.*")
(("^[[:space:]]+(cc ) *") "\tgcc "))
(substitute*
(find-files "." (string-append
"("
"Mf-[a-zA-Z0-9.]+"
"|Makefile[a-zA-Z0-9.]*"
"|checkin"
"|stex\\.stex"
"|newrelease"
"|workarea"
;;"|[a-zA-Z0-9.]+\\.ms" ; guile can't read
")"))
(("/bin/rm") (which "rm"))
(("/bin/ln") (which "ln"))
(("/bin/cp") (which "cp")))
(substitute* "makefiles/installsh"
(("/bin/true") (which "true")))
(substitute* "stex/Makefile"
(("PREFIX=/usr") (string-append "PREFIX=" out)))
(zero? (system* "./configure" "--threads"
(string-append "--installprefix=" out))))))
;; Installation of the documentation requires a running "chez".
(add-after 'install 'install-doc
(lambda* (#:key inputs outputs #:allow-other-keys)
(let ((bin (string-append (assoc-ref outputs "out") "/bin"))
(doc (string-append (assoc-ref outputs "doc")
"/share/doc/" ,name "-" ,version)))
(setenv "HOME" (getcwd))
(setenv "PATH" (string-append (getenv "PATH") ":" bin))
(with-directory-excursion "stex"
(system* "make" (string-append "BIN=" bin)))
(system* "make" "docs")
(with-directory-excursion "csug"
(substitute* "Makefile"
(("/tmp/csug9") doc)
(("^m = a6le")
"m := $(shell echo '(machine-type)' | scheme -q)"))
(system* "make" "install")
(install-file "csug.pdf" doc))
(with-directory-excursion "release_notes"
(install-file "release_notes.pdf" doc))
#t)))
;; The binary file name is called "scheme" as the one from MIT/GNU
;; Scheme. We add a symlink to use in case both are installed.
(add-after 'install 'install-symlink
(lambda* (#:key outputs #:allow-other-keys)
(let* ((out (assoc-ref outputs "out"))
(bin (string-append out "/bin"))
(lib (string-append out "/lib"))
(name "chez-scheme"))
(symlink (string-append bin "/scheme")
(string-append bin "/" name))
(map (lambda (file)
(symlink file (string-append (dirname file)
"/" name ".boot")))
(find-files lib "scheme.boot"))
#t))))))
;; According to the documentation MIPS and ARM are not supported.
(supported-systems '("x86_64-linux" "i686-linux"))
(home-page "http://www.scheme.com")
(synopsis "R6RS Scheme compiler and run-time")
(description
"Chez Scheme is a compiler and run-time system for the language of the
Revised^6 Report on Scheme (R6RS), with numerous extensions. The compiler
generates native code for each target processor, with support for x86, x86_64,
and 32-bit PowerPC architectures.")
(license asl2.0)))
(define-public scmutils
(let ()
(define (system-suffix)

View file

@ -30,7 +30,6 @@ (define-module (gnu packages tor)
#:use-module (gnu packages libevent)
#:use-module (gnu packages compression)
#:use-module (gnu packages pcre)
#:use-module (gnu packages perl)
#:use-module (gnu packages python)
#:use-module (gnu packages qt)
#:use-module (gnu packages autotools)
@ -40,14 +39,14 @@ (define-module (gnu packages tor)
(define-public tor
(package
(name "tor")
(version "0.2.8.8")
(version "0.2.8.9")
(source (origin
(method url-fetch)
(uri (string-append "https://dist.torproject.org/tor-"
version ".tar.gz"))
(sha256
(base32
"1pp3h0a1cl25fv04b3j6wp8aw1sfpbd2lmag397dpp2k2b305bxi"))))
"05jkvhbgyq81fcmk1xpl3yw97ljj5sg9pngl27zlmgl7p0xjfp1z"))))
(build-system gnu-build-system)
(native-inputs
`(("python" ,python-2))) ; for tests
@ -73,28 +72,16 @@ (define-public tor
(define-public torsocks
(package
(name "torsocks")
(version "2.0.0")
(version "2.2.0")
(source (origin
(method git-fetch)
(uri (git-reference
(url "https://git.torproject.org/torsocks.git")
(commit (string-append "v" version))))
(method url-fetch)
(uri (string-append "https://people.torproject.org/~dgoulet/"
name "/" name "-" version ".tar.xz"))
(sha256
(base32
"0an2q5ail9z414riyjbkjkm29504hy778j914baz2gn5hlv2cfak"))
(file-name (string-append name "-" version "-checkout"))
(patches (search-patches "torsocks-dns-test.patch"))))
"0byr9ga9w79qz4vp0m11sbmspad7fsal9wm67r4znzb7zb7cis19"))))
(build-system gnu-build-system)
(arguments
'(#:phases (modify-phases %standard-phases
(add-before 'configure 'bootstrap
(lambda _
(system* "autoreconf" "-vfi"))))))
(native-inputs `(("autoconf" ,(autoconf-wrapper))
("automake" ,automake)
("libtool" ,libtool)
("perl-test-harness" ,perl-test-harness)))
(home-page "http://www.torproject.org/")
(home-page "https://www.torproject.org/")
(synopsis "Use socks-friendly applications with Tor")
(description
"Torsocks allows you to use most socks-friendly applications in a safe

View file

@ -1253,7 +1253,7 @@ (define-public avidemux
(define-public vapoursynth
(package
(name "vapoursynth")
(version "33.1")
(version "34")
(source (origin
(method url-fetch)
(uri (string-append
@ -1262,7 +1262,7 @@ (define-public vapoursynth
(file-name (string-append name "-" version))
(sha256
(base32
"1504jaw4yqdlyls0bz9f90rvqq7cy1jvmrnhdvwnmdfbpikqwi4c"))))
"0rfldphg4gy3sdfffi5yzklqz93vsj2j6nny8snjbavnf161blyi"))))
(build-system gnu-build-system)
(native-inputs
`(("autoconf" ,autoconf)

View file

@ -1,6 +1,7 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2012, 2013 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2014 Eric Bavier <bavier@member.fsf.org>
;;; Copyright © 2016 Efraim Flashner <efraim@flashner.co.il>
;;;
;;; This file is part of GNU Guix.
;;;
@ -32,25 +33,26 @@ (define-module (gnu packages zile)
(define-public zile
(package
(name "zile")
(version "2.4.11")
(version "2.4.13")
(source (origin
(method url-fetch)
(uri (string-append "mirror://gnu/zile/zile-"
version ".tar.gz"))
(sha256
(base32
"1k593y1xzvlj52q0gyhcx2lllws4sg84b8r9pcginjb1vjypplhz"))))
"03mcg0bxkzprlsx8y6h22w924pzx4a9zr7zm3g11j8j3x9lz75f7"))))
(build-system gnu-build-system)
(arguments
'(#:phases (alist-cons-before
'configure 'patch-/bin/sh
'(#:phases
(modify-phases %standard-phases
(add-before 'configure 'patch-/bin/sh
(lambda* (#:key inputs #:allow-other-keys)
(let ((bash (assoc-ref inputs "bash")))
;; Refer to the actual shell.
(substitute* '("lib/spawni.c" "src/funcs.c")
(("/bin/sh")
(string-append bash "/bin/sh")))))
%standard-phases)))
(string-append bash "/bin/sh")))
#t))))))
(inputs
`(("boehm-gc" ,libgc)
("ncurses" ,ncurses)
@ -59,7 +61,7 @@ (define-public zile
`(("perl" ,perl)
("help2man" ,help2man)
("pkg-config" ,pkg-config)))
(home-page "http://www.gnu.org/software/zile/")
(home-page "https://www.gnu.org/software/zile/")
(synopsis "Lightweight Emacs clone")
(description
"GNU Zile is a lightweight Emacs clone. It usage is similar to the

View file

@ -307,11 +307,6 @@ (define (rewrite-leaf file)
(else
(error "unsupported file type" stat)))))
;; XXX: Work around occasional "suspicious ownership or permission" daemon
;; errors that arise when we create the top-level /gnu/store/… directory as
;; #o777.
(umask #o022)
;; Use 'exit-on-exception' to force an exit upon I/O errors, given that
;; 'n-par-for-each' silently swallows exceptions.
;; See <http://bugs.gnu.org/23581>.

View file

@ -23,7 +23,7 @@ (define-module (guix derivations)
#:use-module (srfi srfi-26)
#:use-module (srfi srfi-34)
#:use-module (srfi srfi-35)
#:use-module (rnrs io ports)
#:use-module (ice-9 binary-ports)
#:use-module (rnrs bytevectors)
#:use-module (ice-9 match)
#:use-module (ice-9 rdelim)
@ -885,7 +885,7 @@ (define (substitute str initial replacements)
(define (substitute-file file initial replacements)
(define contents
(with-fluids ((%default-port-encoding #f))
(call-with-input-file file get-string-all)))
(call-with-input-file file read-string)))
(let ((updated (substitute contents initial replacements)))
(if (string=? updated contents)

View file

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2010, 2011, 2012, 2013, 2014, 2015 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2010, 2011, 2012, 2013, 2014, 2015, 2016 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
@ -22,7 +22,7 @@ (define-module (guix ftp-client)
#:use-module (srfi srfi-11)
#:use-module (srfi srfi-26)
#:use-module (srfi srfi-31)
#:use-module (rnrs io ports)
#:use-module (ice-9 binary-ports)
#:use-module (rnrs bytevectors)
#:use-module (ice-9 match)
#:use-module (ice-9 regex)

View file

@ -280,7 +280,18 @@ (define (return/cache cache value)
(let* ((new (graft-derivation/shallow store drv applicable
#:guile guile
#:system system))
(grafts (cons (graft (origin drv) (replacement new))
;; Replace references to any of the outputs of DRV,
;; even if that's more than needed. This is so that
;; the result refers only to the outputs of NEW and
;; not to those of DRV.
(grafts (append (map (lambda (output)
(graft
(origin drv)
(origin-output output)
(replacement new)
(replacement-output output)))
(derivation-output-names drv))
grafts)))
(return/cache cache grafts))))))))))))

View file

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2012, 2013, 2014, 2015 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2012, 2013, 2014, 2015, 2016 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
@ -19,7 +19,7 @@
(define-module (guix hash)
#:use-module (guix gcrypt)
#:use-module (rnrs bytevectors)
#:use-module (rnrs io ports)
#:use-module (ice-9 binary-ports)
#:use-module (system foreign)
#:use-module ((guix build utils) #:select (dump-port))
#:use-module (srfi srfi-11)

View file

@ -28,7 +28,7 @@ (define-module (guix http-client)
#:use-module (srfi srfi-34)
#:use-module (srfi srfi-35)
#:use-module (ice-9 match)
#:use-module (rnrs io ports)
#:use-module (ice-9 binary-ports)
#:use-module (rnrs bytevectors)
#:use-module (guix ui)
#:use-module (guix utils)

View file

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2013, 2014 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2013, 2014, 2016 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
@ -22,7 +22,8 @@ (define-module (guix pki)
#:use-module ((guix utils) #:select (with-atomic-file-output))
#:use-module ((guix build utils) #:select (mkdir-p))
#:use-module (ice-9 match)
#:use-module (rnrs io ports)
#:use-module (ice-9 rdelim)
#:use-module (ice-9 binary-ports)
#:export (%public-key-file
%private-key-file
%acl-file
@ -80,7 +81,7 @@ (define (ensure-acl)
(when (file-exists? %public-key-file)
(let ((public-key (call-with-input-file %public-key-file
(compose string->canonical-sexp
get-string-all))))
read-string))))
(mkdir-p (dirname %acl-file))
(with-atomic-file-output %acl-file
(lambda (port)
@ -99,7 +100,7 @@ (define (current-acl)
(call-with-input-file %acl-file
(compose canonical-sexp->sexp
string->canonical-sexp
get-string-all))
read-string))
(public-keys->acl '()))) ; the empty ACL
(define (acl->public-keys acl)

View file

@ -40,7 +40,7 @@ (define-module (guix scripts archive)
#:use-module (srfi srfi-11)
#:use-module (srfi srfi-26)
#:use-module (srfi srfi-37)
#:use-module (rnrs io ports)
#:use-module (ice-9 binary-ports)
#:export (guix-archive))
@ -290,7 +290,7 @@ (define (authorize-key)
(define (read-key)
(catch 'gcry-error
(lambda ()
(string->canonical-sexp (get-string-all (current-input-port))))
(string->canonical-sexp (read-string (current-input-port))))
(lambda (key proc err)
(leave (_ "failed to read public key: ~a: ~a~%")
(error-source err) (error-string err)))))

View file

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2013, 2014, 2015 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2013, 2014, 2015, 2016 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
@ -22,7 +22,8 @@ (define-module (guix scripts authenticate)
#:use-module (guix pk-crypto)
#:use-module (guix pki)
#:use-module (guix ui)
#:use-module (rnrs io ports)
#:use-module (ice-9 binary-ports)
#:use-module (ice-9 rdelim)
#:use-module (ice-9 match)
#:export (guix-authenticate))
@ -36,12 +37,12 @@ (define-module (guix scripts authenticate)
(define read-canonical-sexp
;; Read a gcrypt sexp from a port and return it.
(compose string->canonical-sexp get-string-all))
(compose string->canonical-sexp read-string))
(define (read-hash-data port key-type)
"Read sha256 hash data from PORT and return it as a gcrypt sexp. KEY-TYPE
is a symbol representing the type of public key algo being used."
(let* ((hex (get-string-all port))
(let* ((hex (read-string port))
(bv (base16-string->bytevector (string-trim-both hex))))
(bytevector->hash-data bv #:key-type key-type)))

View file

@ -179,27 +179,48 @@ (define new-sources
(_
obj)))))
(define (transform-package-inputs replacement-specs)
"Return a procedure that, when passed a package, replaces its direct
dependencies according to REPLACEMENT-SPECS. REPLACEMENT-SPECS is a list of
strings like \"guile=guile@2.1\" meaning that, any direct dependency on a
package called \"guile\" must be replaced with a dependency on a version 2.1
of \"guile\"."
(define (evaluate-replacement-specs specs proc)
"Parse SPECS, a list of strings like \"guile=guile@2.1\", and invoke PROC on
each package pair specified by SPECS. Return the resulting list. Raise an
error if an element of SPECS uses invalid syntax, or if a package it refers to
could not be found."
(define not-equal
(char-set-complement (char-set #\=)))
(define replacements
;; List of name/package pairs.
(map (lambda (spec)
(match (string-tokenize spec not-equal)
((old new)
(cons (specification->package old)
(proc (specification->package old)
(specification->package new)))
(x
(leave (_ "invalid replacement specification: ~s~%") spec))))
replacement-specs))
specs))
(let ((rewrite (package-input-rewriting replacements)))
(define (transform-package-inputs replacement-specs)
"Return a procedure that, when passed a package, replaces its direct
dependencies according to REPLACEMENT-SPECS. REPLACEMENT-SPECS is a list of
strings like \"guile=guile@2.1\" meaning that, any dependency on a package
called \"guile\" must be replaced with a dependency on a version 2.1 of
\"guile\"."
(let* ((replacements (evaluate-replacement-specs replacement-specs cons))
(rewrite (package-input-rewriting replacements)))
(lambda (store obj)
(if (package? obj)
(rewrite obj)
obj))))
(define (transform-package-inputs/graft replacement-specs)
"Return a procedure that, when passed a package, replaces its direct
dependencies according to REPLACEMENT-SPECS. REPLACEMENT-SPECS is a list of
strings like \"gnutls=gnutls@3.5.4\" meaning that packages are built using the
current 'gnutls' package, after which version 3.5.4 is grafted onto them."
(define (replacement-pair old new)
(cons old
(package (inherit old) (replacement new))))
(let* ((replacements (evaluate-replacement-specs replacement-specs
replacement-pair))
(rewrite (package-input-rewriting replacements)))
(lambda (store obj)
(if (package? obj)
(rewrite obj)
@ -211,20 +232,22 @@ (define %transformations
;; procedure; it is called with two arguments: the store, and a list of
;; things to build.
`((with-source . ,transform-package-source)
(with-input . ,transform-package-inputs)))
(with-input . ,transform-package-inputs)
(with-graft . ,transform-package-inputs/graft)))
(define %transformation-options
;; The command-line interface to the above transformations.
(let ((parser (lambda (symbol)
(lambda (opt name arg result . rest)
(apply values
(alist-cons symbol arg result)
rest)))))
(list (option '("with-source") #t #f
(lambda (opt name arg result . rest)
(apply values
(cons (alist-cons 'with-source arg result)
rest))))
(parser 'with-source))
(option '("with-input") #t #f
(lambda (opt name arg result . rest)
(apply values
(cons (alist-cons 'with-input arg result)
rest))))))
(parser 'with-input))
(option '("with-graft") #t #f
(parser 'with-graft)))))
(define (show-transformation-options-help)
(display (_ "
@ -232,7 +255,10 @@ (define (show-transformation-options-help)
use SOURCE when building the corresponding package"))
(display (_ "
--with-input=PACKAGE=REPLACEMENT
replace dependency PACKAGE by REPLACEMENT")))
replace dependency PACKAGE by REPLACEMENT"))
(display (_ "
--with-graft=PACKAGE=REPLACEMENT
graft REPLACEMENT on packages that refer to PACKAGE")))
(define (options->transformation opts)

View file

@ -31,7 +31,7 @@ (define-module (guix scripts download)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-37)
#:use-module (rnrs bytevectors)
#:use-module (rnrs io ports)
#:use-module (ice-9 binary-ports)
#:export (guix-download))

View file

@ -25,7 +25,7 @@ (define-module (guix scripts hash)
#:use-module (guix ui)
#:use-module (guix scripts)
#:use-module (guix utils)
#:use-module (rnrs io ports)
#:use-module (ice-9 binary-ports)
#:use-module (rnrs files)
#:use-module (ice-9 match)
#:use-module (srfi srfi-1)
@ -137,7 +137,7 @@ (define (file-hash file)
(if (assoc-ref opts 'recursive?)
(let-values (((port get-hash) (open-sha256-port)))
(write-file file port #:select? select?)
(flush-output-port port)
(force-output port)
(get-hash))
(call-with-input-file file port-sha256))))

View file

@ -142,6 +142,10 @@ (define (starts-with-abbreviation? s)
"Return #t if S starts with what looks like an abbreviation or acronym."
(string-match "^[A-Z][A-Z0-9]+\\>" s))
(define %quoted-identifier-rx
;; A quoted identifier, like 'this'.
(make-regexp "['`][[:graph:]]+'"))
(define (check-description-style package)
;; Emit a warning if stylistic issues are found in the description of PACKAGE.
(define (check-not-empty description)
@ -173,6 +177,16 @@ (define (check-trademarks description)
'description))
(else #t)))
(define (check-quotes description)
"Check whether DESCRIPTION contains single quotes and suggest @code."
(when (regexp-exec %quoted-identifier-rx description)
(emit-warning package
;; TRANSLATORS: '@code' is Texinfo markup and must be kept
;; as is.
(_ "use @code or similar ornament instead of quotes")
'description)))
(define (check-proper-start description)
(unless (or (properly-starts-sentence? description)
(string-prefix-ci? (package-name package) description))
@ -203,6 +217,7 @@ (define (check-end-of-sentence-space description)
(if (string? description)
(begin
(check-not-empty description)
(check-quotes description)
(check-trademarks description)
;; Use raw description for this because Texinfo rendering
;; automatically fixes end of sentence space.

View file

@ -21,7 +21,8 @@ (define-module (guix scripts offload)
#:use-module (guix records)
#:use-module (guix store)
#:use-module (guix derivations)
#:use-module (guix serialization)
#:use-module ((guix serialization)
#:select (nar-error? nar-error-file))
#:use-module (guix nar)
#:use-module (guix utils)
#:use-module ((guix build syscalls) #:select (fcntl-flock))
@ -37,7 +38,7 @@ (define-module (guix scripts offload)
#:use-module (ice-9 match)
#:use-module (ice-9 regex)
#:use-module (ice-9 format)
#:use-module (rnrs io ports)
#:use-module (ice-9 binary-ports)
#:export (build-machine
build-requirements
guix-offload))
@ -336,7 +337,7 @@ (define script
(let ((pipe (remote-pipe machine OPEN_READ
`("guile" "-c" ,(object->string script)))))
(get-string-all pipe)
(read-string pipe)
(let ((status (close-pipe pipe)))
(unless (zero? status)
;; Better be safe than sorry: if we ignore the error here, then FILE
@ -368,7 +369,7 @@ (define script
(let ((pipe (remote-pipe machine OPEN_READ
`("guile" "-c" ,(object->string script)))))
(get-string-all pipe)
(read-string pipe)
(close-pipe pipe)))
(define* (offload drv machine
@ -462,7 +463,7 @@ (define (missing-files files)
'("guix" "archive" "--missing")))
(open-input-string files)))
((result)
(get-string-all missing)))
(read-string missing)))
(for-each waitpid pids)
(string-tokenize result)))

View file

@ -23,7 +23,7 @@ (define-module (guix scripts publish)
#:use-module (ice-9 format)
#:use-module (ice-9 match)
#:use-module (ice-9 regex)
#:use-module (rnrs io ports)
#:use-module (ice-9 rdelim)
#:use-module (rnrs bytevectors)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-2)
@ -46,7 +46,7 @@ (define-module (guix scripts publish)
#:use-module (guix pki)
#:use-module (guix pk-crypto)
#:use-module (guix store)
#:use-module (guix serialization)
#:use-module ((guix serialization) #:select (write-file))
#:use-module (guix zlib)
#:use-module (guix ui)
#:use-module (guix scripts)
@ -167,7 +167,7 @@ (define (lazy-read-file-sexp file)
(delay
(call-with-input-file file
(compose string->canonical-sexp
get-string-all))))
read-string))))
(define %private-key
(lazy-read-file-sexp %private-key-file))

View file

@ -50,7 +50,7 @@ (define-module (guix scripts refresh)
#:use-module (srfi srfi-11)
#:use-module (srfi srfi-26)
#:use-module (srfi srfi-37)
#:use-module (rnrs io ports)
#:use-module (ice-9 binary-ports)
#:export (guix-refresh
%updaters))

View file

@ -24,7 +24,7 @@ (define-module (guix scripts substitute)
#:use-module (guix combinators)
#:use-module (guix config)
#:use-module (guix records)
#:use-module (guix serialization)
#:use-module ((guix serialization) #:select (restore-file))
#:use-module (guix hash)
#:use-module (guix base32)
#:use-module (guix base64)
@ -43,7 +43,6 @@ (define-module (guix scripts substitute)
#:use-module (ice-9 format)
#:use-module (ice-9 ftw)
#:use-module (ice-9 binary-ports)
#:use-module (rnrs io ports)
#:use-module (rnrs bytevectors)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-9)
@ -938,7 +937,7 @@ (define (singleton? acl)
(and (file-exists? %public-key-file)
(let ((key (call-with-input-file %public-key-file
(compose string->canonical-sexp
get-string-all))))
read-string))))
(match acl
((thing)
(equal? (canonical-sexp->string thing)

View file

@ -19,11 +19,12 @@
(define-module (guix serialization)
#:use-module (guix combinators)
#:use-module (rnrs bytevectors)
#:use-module (rnrs io ports)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-26)
#:use-module (srfi srfi-34)
#:use-module (srfi srfi-35)
#:use-module (ice-9 binary-ports)
#:use-module ((ice-9 rdelim) #:prefix rdelim:)
#:use-module (ice-9 match)
#:use-module (ice-9 ftw)
#:export (write-int read-int
@ -143,7 +144,7 @@ (define (read-maybe-utf8-string p)
(port (open-bytevector-input-port bv)))
(set-port-encoding! port "UTF-8")
(set-port-conversion-strategy! port 'substitute)
(get-string-all port)))
(rdelim:read-string port)))
(define (write-string-list l p)
(write-int (length l) p)

View file

@ -25,7 +25,7 @@ (define-module (guix store)
#:autoload (guix base32) (bytevector->base32-string)
#:autoload (guix build syscalls) (terminal-columns)
#:use-module (rnrs bytevectors)
#:use-module (rnrs io ports)
#:use-module (ice-9 binary-ports)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-9)
#:use-module (srfi srfi-9 gnu)
@ -481,7 +481,7 @@ (define %stderr-error #x63787470) ; "cxtp", error reporting
(let ((s (read-maybe-utf8-string p)))
(display s (current-build-output-port))
(when (string-any %newlines s)
(flush-output-port (current-build-output-port)))
(force-output (current-build-output-port)))
#f))
((= k %stderr-error)
;; Report an error.

View file

@ -27,7 +27,7 @@ (define-module (guix tests)
#:use-module (gnu packages bootstrap)
#:use-module (srfi srfi-34)
#:use-module (rnrs bytevectors)
#:use-module (rnrs io ports)
#:use-module (ice-9 binary-ports)
#:use-module (web uri)
#:export (open-connection-for-tests
random-text

View file

@ -30,7 +30,8 @@ (define-module (guix utils)
#:use-module (srfi srfi-39)
#:use-module (srfi srfi-60)
#:use-module (rnrs bytevectors)
#:use-module (rnrs io ports)
#:use-module (ice-9 binary-ports)
#:autoload (rnrs io ports) (make-custom-binary-input-port)
#:use-module ((rnrs bytevectors) #:select (bytevector-u8-set!))
#:use-module (guix combinators)
#:use-module ((guix build utils) #:select (dump-port))

View file

@ -162,4 +162,13 @@ (define (namespaces pid)
(waitpid pid)
(zero? result)))))))
(skip-if-unsupported)
(test-equal "container-excursion, same namespaces"
42
;; The parent and child are in the same namespaces. 'container-excursion'
;; should notice that and avoid calling 'setns' since that would fail.
(container-excursion (getpid)
(lambda ()
(primitive-exit 42))))
(test-end)

View file

@ -201,6 +201,54 @@ (define %mkdir
(and (string=? (readlink one) repl)
(string=? (readlink two) one))))))
(test-assert "graft-derivation, replaced derivation has multiple outputs"
;; Here we have a replacement just for output "one" of P1 and not for the
;; other output. Make sure the graft for P1:one correctly applies to the
;; dependents of P1. See <http://bugs.gnu.org/24712>.
(let* ((p1 (build-expression->derivation
%store "p1"
`(let ((one (assoc-ref %outputs "one"))
(two (assoc-ref %outputs "two")))
(mkdir one)
(mkdir two))
#:outputs '("one" "two")))
(p1r (build-expression->derivation
%store "P1"
`(let ((other (assoc-ref %outputs "ONE")))
(mkdir other)
(call-with-output-file (string-append other "/replacement")
(const #t)))
#:outputs '("ONE")))
(p2 (build-expression->derivation
%store "p2"
`(let ((out (assoc-ref %outputs "aaa")))
(mkdir (assoc-ref %outputs "zzz"))
(mkdir out) (chdir out)
(symlink (assoc-ref %build-inputs "p1:one") "one")
(symlink (assoc-ref %build-inputs "p1:two") "two"))
#:outputs '("aaa" "zzz")
#:inputs `(("p1:one" ,p1 "one")
("p1:two" ,p1 "two"))))
(p3 (build-expression->derivation
%store "p3"
`(symlink (assoc-ref %build-inputs "p2:aaa")
(assoc-ref %outputs "out"))
#:inputs `(("p2:aaa" ,p2 "aaa")
("p2:zzz" ,p2 "zzz"))))
(p1g (graft
(origin p1)
(origin-output "one")
(replacement p1r)
(replacement-output "ONE")))
(p3d (graft-derivation %store p3 (list p1g))))
(and (build-derivations %store (list p3d))
(let ((out (derivation->output-path (pk 'p2d p3d))))
(and (not (string=? (readlink out)
(derivation->output-path p2 "aaa")))
(string=? (derivation->output-path p1 "two")
(readlink (string-append out "/two")))
(file-exists? (string-append out "/one/replacement")))))))
(test-assert "graft-derivation, renaming" ;<http://bugs.gnu.org/23132>
(let* ((build `(begin
(use-modules (guix build utils))

View file

@ -218,6 +218,14 @@ (define-syntax-rule (with-warnings body ...)
(check-description-style pkg)))
"should not contain trademark sign"))))
(test-assert "description: suggest ornament instead of quotes"
(->bool
(string-contains (with-warnings
(let ((pkg (dummy-package "x"
(description "This is a 'quoted' thing."))))
(check-description-style pkg)))
"use @code")))
(test-assert "synopsis: not a string"
(->bool
(string-contains (with-warnings

View file

@ -102,4 +102,23 @@ (define-module (test-scripts-build)
((("x" dep))
(eq? dep findutils)))))))))))
(test-assert "options->transformation, with-graft"
(let* ((p (dummy-package "guix.scm"
(inputs `(("foo" ,grep)
("bar" ,(dummy-package "chbouib"
(native-inputs `(("x" ,grep)))))))))
(t (options->transformation '((with-graft . "grep=findutils")))))
(with-store store
(let ((new (t store p)))
(and (not (eq? new p))
(match (package-inputs new)
((("foo" dep1) ("bar" dep2))
(and (string=? (package-full-name dep1)
(package-full-name grep))
(eq? (package-replacement dep1) findutils)
(string=? (package-name dep2) "chbouib")
(match (package-native-inputs dep2)
((("x" dep))
(eq? (package-replacement dep) findutils)))))))))))
(test-end)

View file

@ -148,11 +148,15 @@ (define perform-container-tests?
(unless perform-container-tests?
(test-skip 1))
(test-assert "pivot-root"
(test-equal "pivot-root"
#t
(match (pipe)
((in . out)
(match (clone (logior CLONE_NEWUSER CLONE_NEWNS SIGCHLD))
(0
(dynamic-wind
(const #t)
(lambda ()
(close in)
(call-with-temporary-directory
(lambda (root)
@ -165,8 +169,9 @@ (define perform-container-tests?
(pivot-root root put-old)
;; The test file should now be located inside the root directory.
(write (file-exists? "/test") out)
(close out))))
(primitive-exit 0))
(close out)))))
(lambda ()
(primitive-exit 0))))
(pid
(close out)
(let ((result (read in)))