(eval . (put 'guard 'scheme-indent-function 1))
(eval . (put 'lambda* 'scheme-indent-function 1))
(eval . (put 'substitute* 'scheme-indent-function 1))
+ (eval . (put 'modify-phases 'scheme-indent-function 1))
(eval . (put 'with-directory-excursion 'scheme-indent-function 1))
(eval . (put 'package 'scheme-indent-function 0))
(eval . (put 'origin 'scheme-indent-function 0))
gnu/packages/patches/glib-tests-prlimit.patch \
gnu/packages/patches/glib-tests-timer.patch \
gnu/packages/patches/glib-tests-gapplication.patch \
- gnu/packages/patches/glibc-CVE-2012-3406.patch \
- gnu/packages/patches/glibc-CVE-2014-7817.patch \
gnu/packages/patches/glibc-bootstrap-system.patch \
gnu/packages/patches/glibc-ldd-x86_64.patch \
gnu/packages/patches/glibc-locales.patch \
- gnu/packages/patches/glibc-mips-dangling-vfork-ref.patch \
gnu/packages/patches/gmp-arm-asm-nothumb.patch \
gnu/packages/patches/gnunet-fix-scheduler.patch \
gnu/packages/patches/gnunet-fix-tests.patch \
gnu/packages/patches/gobject-introspection-absolute-shlib-path.patch \
gnu/packages/patches/gobject-introspection-cc.patch \
gnu/packages/patches/gobject-introspection-girepository.patch \
+ gnu/packages/patches/grep-CVE-2015-1345.patch \
gnu/packages/patches/grub-gets-undeclared.patch \
gnu/packages/patches/gstreamer-0.10-bison3.patch \
gnu/packages/patches/gstreamer-0.10-silly-test.patch \
(method url-fetch)
(uri (string-append "https://github.com/aarddict/desktop/archive/"
version ".tar.gz"))
+ (file-name (string-append name "-" version ".tar.gz"))
(sha256
(base32
"12h7m0z7nd7rg8avpi9syd265k0rhh4vbdh464nq0jzdg8m9p28c"))))
(uri (string-append
"https://github.com/fredrik-johansson/arb/archive/"
version ".tar.gz"))
+ (file-name (string-append name "-" version ".tar.gz"))
(sha256 (base32
"0a8cgzznkmr59ngj4di9a37b5h4i00gbnixnxlwd34bcbflvjzyr"))))
(build-system gnu-build-system)
"https://github.com/jackaudio/jack2/archive/v"
version
".tar.gz"))
+ (file-name (string-append name "-" version ".tar.gz"))
(sha256
(base32
"03b0iiyk3ng3vh5s8gaqwn565vik7910p56mlbk512bw3dhbdwc8"))))
(uri (string-append "https://github.com/lvtk/lvtk/archive/"
version
".tar.gz"))
+ (file-name (string-append name "-" version ".tar.gz"))
(sha256
(base32
"03nbj2cqcklqwh50zj2gwm07crh5iwqbpxbpzwbg5hvgl4k4rnjd"))))
("file" ,file)))
(arguments
'(#:phases
- (alist-cons-before
- 'configure 'bootstrap
+ (alist-cons-after
+ 'unpack 'bootstrap
(lambda _
- (unless (zero? (system* "sh" "bootstrap"))
- (error "bootstrap failed"))
- (substitute* '("configure")
- (("/usr/bin/file") "file")))
+ (zero? (system* "sh" "bootstrap")))
%standard-phases)))
(home-page "http://www.surina.net/soundtouch/")
(synopsis
;;; Copyright © 2012 Nikita Karetnikov <nikita@karetnikov.org>
;;; Copyright © 2012, 2013, 2014, 2015 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2014 Manolis Fragkiskos Ragkousis <manolis837@gmail.com>
+;;; Copyright © 2015 Mark H Weaver <mhw@netris.org>
;;;
;;; This file is part of GNU Guix.
;;;
(define-public libtool
(package
(name "libtool")
- (version "2.4.5")
+ (version "2.4.6")
(source (origin
(method url-fetch)
(uri (string-append "mirror://gnu/libtool/libtool-"
version ".tar.xz"))
(sha256
(base32
- "0zhphv4n9bdd6sz66lqfrfqcsnv89mg2bykgi5w9401va4vc3al4"))
+ "0vxj52zm709125gwv9qqlw02silj8bnjnh4y07arrz60r31ai1vw"))
(patches
(list (search-patch "libtool-skip-tests.patch")))))
(build-system gnu-build-system)
;; Libtool's extensive test suite isn't run.
(package
(name "libltdl")
- (version "2.4.4")
+ (version "2.4.6")
(source (origin
(method url-fetch)
(uri (string-append "mirror://gnu/libtool/libtool-"
version ".tar.xz"))
(sha256
(base32
- "0v3zq08qxv7k5067mpqrkjkjl3wphhg06i696mka90mzadc5nad8"))
+ "0vxj52zm709125gwv9qqlw02silj8bnjnh4y07arrz60r31ai1vw"))
(patches
(list (search-patch "libtool-skip-tests.patch")))))
(build-system gnu-build-system)
;;; Copyright © 2012, 2013, 2014, 2015 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2014 Andreas Enge <andreas@enge.fr>
;;; Copyright © 2012 Nikita Karetnikov <nikita@karetnikov.org>
-;;; Copyright © 2014 Mark H Weaver <mhw@netris.org>
+;;; Copyright © 2014, 2015 Mark H Weaver <mhw@netris.org>
;;; Copyright © 2014 Alex Kost <alezost@gmail.com>
;;;
;;; This file is part of GNU Guix.
version ".tar.xz"))
(sha256
(base32
- "1pp5n15qwxrw1pibwjhhgsibyv5cafhamf8lwzjygs6y00fa2i2j"))))
+ "1pp5n15qwxrw1pibwjhhgsibyv5cafhamf8lwzjygs6y00fa2i2j"))
+ (patches (list (search-patch "grep-CVE-2015-1345.patch")))))
(build-system gnu-build-system)
(synopsis "Print lines matching a pattern")
(description
(define-public patch
(package
(name "patch")
- (version "2.7.1")
- (source (origin
- (method url-fetch)
- (uri (string-append "mirror://gnu/patch/patch-"
- version ".tar.xz"))
- (sha256
- (base32
- "1sqckf560pzwgniy00vcpdv2c9c11s4cmhlm14yqgg8avd3bl94i"))))
+ (version "2.7.4")
+ (source (origin
+ (method url-fetch)
+ (uri (string-append "mirror://gnu/patch/patch-"
+ version ".tar.xz"))
+ (sha256
+ (base32
+ "02gikxjvcxysr4l65c8vivgz62xmalp0av5ypzff8vqhrq3vpb0f"))))
(build-system gnu-build-system)
(native-inputs `(("ed", ed)))
- ;; TODO: When cross-compiling, add this:
- ;; '(#:configure-flags '("ac_cv_func_strnlen_working=yes"))
(synopsis "Apply differences to originals, with optional backups")
(description
"Patch is a program that applies changes to files based on differences
different diff formats. It may also be used to revert previously applied
differences.")
(license gpl3+)
- (replacement patch-CVE-2015-1196)
(home-page "http://savannah.gnu.org/projects/patch/")))
-(define-public patch-2.7.4
- (package
- (inherit patch)
- (version "2.7.4")
- (source (origin
- (method url-fetch)
- (uri (string-append "mirror://gnu/patch/patch-"
- version ".tar.xz"))
- (sha256
- (base32
- "02gikxjvcxysr4l65c8vivgz62xmalp0av5ypzff8vqhrq3vpb0f"))))
- (replacement #f)))
-
-(define patch-CVE-2015-1196
- (package (inherit patch-2.7.4)
- ;; Keep the old version number so it can be used as a 'replacement'.
- (version (package-version patch))))
-
(define-public diffutils
(package
(name "diffutils")
(define-public glibc
(package
(name "glibc")
- (version "2.20")
+ (version "2.21")
(source (origin
(method url-fetch)
(uri (string-append "mirror://gnu/glibc/glibc-"
version ".tar.xz"))
(sha256
(base32
- "19bbyfc2gcxr9rihrkkbd3p362i608yhlyrr7icqsa6cmr16sjzq"))
+ "1f135546j34s9bfkydmx2nhh9vwxlx60jldi80zmsnln6wj3dsxf"))
(snippet
;; Disable 'ldconfig' and /etc/ld.so.cache. The latter is
;; required on LFS distros to avoid loading the distro's libc.so
(("use_ldconfig=yes")
"use_ldconfig=no")))
(modules '((guix build utils)))
- (patches (list (search-patch "glibc-CVE-2014-7817.patch")
- (search-patch "glibc-CVE-2012-3406.patch")
- (search-patch "glibc-mips-dangling-vfork-ref.patch")
- (search-patch "glibc-ldd-x86_64.patch")))))
+ (patches (list (search-patch "glibc-ldd-x86_64.patch")))))
(build-system gnu-build-system)
;; Glibc's <limits.h> refers to <linux/limit.h>, for instance, so glibc
(arguments
`(#:out-of-source? #t
+ #:parallel-build? #f ; There's at least one race in the build.
#:configure-flags
(list "--enable-add-ons"
"--sysconfdir=/etc"
(assoc-ref %build-inputs "linux-headers")
"/include")
- ;; This is the default for most architectures as of GNU libc 2.20,
+ ;; This is the default for most architectures as of GNU libc 2.21,
;; but we specify it explicitly for clarity and consistency. See
;; "kernel-features.h" in the GNU libc for details.
"--enable-kernel=2.6.32"
(native-inputs `(("texinfo" ,texinfo)
("perl" ,perl)))
+ (native-search-paths
+ ;; Search path for packages that provide locale data. This is useful
+ ;; primarily in build environments.
+ (list (search-path-specification
+ (variable "LOCPATH")
+ (files '("lib/locale")))))
+
(synopsis "The GNU C Library")
(description
"Any Unix-like operating system needs a C library: the library which
more than 400 in total. To use them set the 'LOCPATH' environment variable to
the 'share/locale' sub-directory of this package.")
(outputs '("out")) ;110+ MiB
+ (native-search-paths '())
(arguments
(let ((args `(#:tests? #f #:strip-binaries? #f
,@(package-arguments glibc))))
(method url-fetch)
(uri (string-append "https://github.com/bedops/bedops/archive/v"
version ".tar.gz"))
+ (file-name (string-append name "-" version ".tar.gz"))
(sha256
(base32
"0wmg6j0icimlrnsidaxrzf3hfgjvlkkcwvpdg7n4gg7hdv2m9ni5"))))
(method url-fetch)
(uri (string-append "https://github.com/arq5x/bedtools2/archive/v"
version ".tar.gz"))
+ (file-name (string-append name "-" version ".tar.gz"))
(sha256
(base32
"16aq0w3dmbd0853j32xk9jin4vb6v6fgakfyvrsmsjizzbn3fpfl"))))
(method url-fetch)
(uri (string-append "https://github.com/BenLangmead/bowtie2/archive/v"
version ".tar.gz"))
+ (file-name (string-append name "-" version ".tar.gz"))
(sha256
(base32
"15dnbqippwvhyh9zqjhaxkabk7lm1xbh1nvar1x4b5kwm117zijn"))
'()
'("POPCNT_CAPABILITY=0")))
#:phases
- (alist-replace
- 'unpack
- (lambda* (#:key source #:allow-other-keys)
- (and (zero? (system* "unzip" source))
- (chdir "hisat-0.1.4-beta")))
- (alist-cons-after
- 'unpack 'patch-sources
- (lambda _
- ;; XXX Cannot use snippet because zip files are not supported
- (substitute* "Makefile"
- (("^CC = .*$") "CC = gcc")
- (("^CPP = .*$") "CPP = g++")
- ;; replace BUILD_HOST and BUILD_TIME for deterministic build
- (("-DBUILD_HOST=.*") "-DBUILD_HOST=\"\\\"guix\\\"\"")
- (("-DBUILD_TIME=.*") "-DBUILD_TIME=\"\\\"0\\\"\""))
- (substitute* '("hisat-build" "hisat-inspect")
- (("/usr/bin/env") (which "env"))))
- (alist-replace
- 'install
- (lambda* (#:key outputs #:allow-other-keys)
- (let ((bin (string-append (assoc-ref outputs "out") "/bin/")))
- (mkdir-p bin)
- (for-each
- (lambda (file)
- (copy-file file (string-append bin file)))
- (find-files
- "."
- "hisat(-(build|align|inspect)(-(s|l)(-debug)*)*)*$"))))
- (alist-delete 'configure %standard-phases))))))
+ (alist-cons-after
+ 'unpack 'patch-sources
+ (lambda _
+ ;; XXX Cannot use snippet because zip files are not supported
+ (substitute* "Makefile"
+ (("^CC = .*$") "CC = gcc")
+ (("^CPP = .*$") "CPP = g++")
+ ;; replace BUILD_HOST and BUILD_TIME for deterministic build
+ (("-DBUILD_HOST=.*") "-DBUILD_HOST=\"\\\"guix\\\"\"")
+ (("-DBUILD_TIME=.*") "-DBUILD_TIME=\"\\\"0\\\"\""))
+ (substitute* '("hisat-build" "hisat-inspect")
+ (("/usr/bin/env") (which "env"))))
+ (alist-replace
+ 'install
+ (lambda* (#:key outputs #:allow-other-keys)
+ (let ((bin (string-append (assoc-ref outputs "out") "/bin/")))
+ (mkdir-p bin)
+ (for-each
+ (lambda (file)
+ (copy-file file (string-append bin file)))
+ (find-files
+ "."
+ "hisat(-(build|align|inspect)(-(s|l)(-debug)*)*)*$"))))
+ (alist-delete 'configure %standard-phases)))))
(native-inputs
`(("unzip" ,unzip)))
(inputs
;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2012, 2013 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2012, 2013, 2015 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
(define bison
(package
(name "bison")
- (version "3.0.2")
+ (version "3.0.4")
(source
(origin
(method url-fetch)
version ".tar.xz"))
(sha256
(base32
- "0g4gjan477lac18m51kv4xzcsp6wjfsfwvd2dxymcl6vid9fihx2"))))
+ "1qbgf6q1n2z17k8g33444m0q68kf3fbiq65q7jlrzpvvj73jh957"))))
(build-system gnu-build-system)
(native-inputs `(("perl" ,perl)))
(inputs `(("flex" ,flex)))
(define-public cmake
(package
(name "cmake")
- (version "2.8.12")
+ (version "3.1.3")
(source (origin
(method url-fetch)
(uri (string-append
(version-major+minor version)
"/cmake-" version ".tar.gz"))
(sha256
- (base32 "11q21vyrr6c6smyjy81k2k07zmn96ggjia9im9cxwvj0n88bm1fq"))
+ (base32 "1l662p9lscbzx9s85y86cynb9fn1rb2alqg4584wqq9gibxd7x25"))
(patches (list (search-patch "cmake-fix-tests.patch")))))
(build-system gnu-build-system)
(arguments
"Source/cmGlobalXCodeGenerator.cxx"
"Source/CTest/cmCTestBatchTestHandler.cxx"
"Source/cmLocalUnixMakefileGenerator3.cxx"
+ "Source/cmExecProgramCommand.cxx"
"Utilities/cmbzip2/Makefile-libbz2_so"
"Utilities/Release/release_cmake.cmake"
"Utilities/cmlibarchive/libarchive/archive_write_set_format_shar.c"
;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2012, 2013, 2014 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2012, 2013, 2014, 2015 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2014 Andreas Enge <andreas@enge.fr>
;;; Copyright © 2012 Nikita Karetnikov <nikita@karetnikov.org>
;;; Copyright © 2014 Mark H Weaver <mhw@netris.org>
(current-source-location)
#:guile %bootstrap-guile)))
+(define glibc-utf8-locales-final
+ ;; Now that we have GUILE-FINAL, build the UTF-8 locales. They are needed
+ ;; by the build processes afterwards so their 'scm_to_locale_string' works
+ ;; with the full range of Unicode codepoints (remember
+ ;; 'scm_to_locale_string' is called every time a string is passed to a C
+ ;; function.)
+ (package
+ (inherit glibc-utf8-locales)
+ (inputs `(("glibc" ,glibc-final)
+ ("gzip"
+ ,(package-with-explicit-inputs gzip %boot4-inputs
+ (current-source-location)
+ #:guile %bootstrap-guile))))))
+
+(define %boot5-inputs
+ ;; Now with UTF-8 locale.
+ `(("locales" ,glibc-utf8-locales-final)
+ ,@%boot4-inputs))
+
(define gnu-make-final
;; The final GNU Make, which uses the final Guile.
(package-with-bootstrap-guile
(package-with-explicit-inputs gnu-make
`(("guile" ,guile-final)
- ,@%boot4-inputs)
+ ,@%boot5-inputs)
(current-source-location))))
(define-public ld-wrapper
;; Findutils, keep a reference to the Coreutils they were built with.
(package-with-bootstrap-guile
(package-with-explicit-inputs coreutils
- %boot4-inputs
+ %boot5-inputs
(current-source-location)
;; Use the final Guile, linked against the
;; built before gzip.
(package-with-bootstrap-guile
(package-with-explicit-inputs grep
- %boot4-inputs
+ %boot5-inputs
(current-source-location)
#:guile guile-final)))
-(define %boot5-inputs
+(define %boot6-inputs
;; Now use the final Coreutils.
`(("coreutils" ,coreutils-final)
("grep" ,grep-final)
- ,@%boot4-inputs))
+ ,@%boot5-inputs))
(define-public %final-inputs
;; Final derivations used as implicit inputs by 'gnu-build-system'. We
;; used for origins that have patches, thereby avoiding circular
;; dependencies.
(let ((finalize (compose package-with-bootstrap-guile
- (cut package-with-explicit-inputs <> %boot5-inputs
+ (cut package-with-explicit-inputs <> %boot6-inputs
(current-source-location)))))
`(,@(map (match-lambda
((name package)
("ld-wrapper" ,ld-wrapper)
("binutils" ,binutils-final)
("gcc" ,gcc-final)
- ("libc" ,glibc-final))))
+ ("libc" ,glibc-final)
+ ("locales" ,glibc-utf8-locales-final))))
(define-public canonical-package
(let ((name->package (fold (lambda (input result)
(define-public sqlite
(package
(name "sqlite")
- (version "3.8.7.4")
+ (version "3.8.8.3")
(source (origin
(method url-fetch)
;; TODO: Download from sqlite.org once this bug :
"/sqlite-autoconf-" numeric-version ".tar.gz")))
(sha256
(base32
- "1v2rhgsx27in6dcvxk0pkxc0zrbl38biimjg6c1zxz85jh9hydw6"))))
+ "04dl53iv5q0srv4jcgjfzsrdzkq6dg1sgmlmpw9lrd4xrmj6jmvl"))))
(build-system gnu-build-system)
- (inputs
- `(("readline" ,readline)))
+ (inputs `(("readline" ,readline)))
+ ;; Add -DSQLITE_SECURE_DELETE. GNU Icecat will refuse to use the system
+ ;; SQLite unless this option is enabled.
+ (arguments `(#:configure-flags '("CFLAGS=-O2 -DSQLITE_SECURE_DELETE")))
(home-page "http://www.sqlite.org/")
(synopsis "The SQLite database management system")
(description
out "/share/images/emacs-w3m")))
#:tests? #f ; no check target
#:phases
- (alist-cons-before
- 'configure 'pre-configure
+ (alist-cons-after
+ 'unpack 'autoconf
(lambda _
(zero? (system* "autoconf")))
(alist-cons-before
(define-public freetype
(package
(name "freetype")
- (version "2.4.11")
+ (version "2.5.5")
(source (origin
(method url-fetch)
(uri (string-append "mirror://savannah/freetype/freetype-"
- version ".tar.gz"))
+ version ".tar.bz2"))
(sha256 (base32
- "0gpcz6swir64kp0dk3rwgqqkmf48b90dqgczdmznjjryhrahx9r9"))))
+ "1fdgl7js99xv1yy5zx1ravmqd0jxlnqpv7zcl954h4hbg15wqyrq"))))
(build-system gnu-build-system)
(arguments
`(#:phases
- (alist-replace
- 'install
- (lambda* (#:key outputs #:allow-other-keys #:rest args)
- (let ((install (assoc-ref %standard-phases 'install))
- (include (string-append (assoc-ref outputs "out") "/include")))
- (apply install args)
- ;; Unravel one directory, since ft2build.h includes directly from
- ;; freetype/, not freetype2/freetype; this is announced in the file
- ;; to be changed in a future release.
- (symlink (string-append include "/freetype2/freetype")
- (string-append include "/freetype"))))
- %standard-phases)))
+ ;; This should not be necessary; reported upstream as
+ ;; https://savannah.nongnu.org/bugs/index.php?44261
+ (alist-cons-before
+ 'configure 'set-paths
+ (lambda _
+ (setenv "CONFIG_SHELL" (which "bash")))
+ %standard-phases)))
(synopsis "Font rendering library")
(description
"Freetype is a library that can be used by applications to access the
("automake" ,automake)
("libtool" ,libtool)))
(arguments
- `(#:phases (alist-cons-before
- 'configure 'bootstrap
+ `(#:phases (alist-cons-after
+ 'unpack 'bootstrap
(lambda _
(zero? (system* "autoreconf" "-vi")))
%standard-phases)))
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2014 Tomáš Čech <sleep_walker@suse.cz>
+;;; Copyright © 2015 Mark H Weaver <mhw@netris.org>
;;;
;;; This file is part of GNU Guix.
;;;
(method url-fetch)
(uri (string-append "https://github.com/bjorn/tiled/archive/v"
version ".tar.gz"))
+ (file-name (string-append name "-" version ".tar.gz"))
(sha256
(base32
"03a15vbzjfwc8dpifbjvd0gnr208mzmdkgs2nlc8zq6z0a4h4jqd"))))
(uri (string-append
"https://github.com/minetest/minetest_game/archive/"
version ".tar.gz"))
+ (file-name (string-append name "-" version ".tar.gz"))
(sha256
(base32
"0hzb27srv6f2j84dpxx2p0p0aaq9vdp5jvbrfpklb5q5ssdjxvc6"))))
(uri (string-append
"https://github.com/minetest/minetest/archive/"
version ".tar.gz"))
+ (file-name (string-append name "-" version ".tar.gz"))
(sha256
(base32
"0h223svzkvp63b77nqfxy7k8whw4543gahs3kxd3x4myi5ax5z5f"))))
(method url-fetch)
(uri (string-append "https://github.com/libretro/RetroArch/archive/"
version ".tar.gz"))
+ (file-name (string-append name "-" version ".tar.gz"))
(sha256
(base32 "1iqcrb076xiih20sk8n1w79xsp4fb8pj4vkmdc1xn562h56y4nxx"))))
(build-system gnu-build-system)
'check 'install-locales
(lambda _
;; A bunch of tests require the availability of a UTF-8
- ;; locale and otherwise fail. Give them what they want.
+ ;; locale and otherwise fail. Since UTF-8 locales are not
+ ;; available during bootstrap, create one here.
(setenv "LOCPATH" (getcwd))
(zero? (system* "localedef" "--no-archive"
"--prefix" (getcwd) "-i" "en_US"
'check 'patch-tests
(lambda* (#:key inputs #:allow-other-keys)
(let* ((bash (which "sh")))
- (substitute*
- (find-files "gettext-tools/tests"
- "^(lang-sh|msg(exec|filter)-[0-9])")
- (("#![[:blank:]]/bin/sh")
- (format #f "#!~a" bash)))
+ ;; Some of the files we're patching are
+ ;; ISO-8859-1-encoded, so choose it as the default
+ ;; encoding so the byte encoding is preserved.
+ (with-fluids ((%default-port-encoding #f))
+ (substitute*
+ (find-files "gettext-tools/tests"
+ "^(lang-sh|msg(exec|filter)-[0-9])")
+ (("#![[:blank:]]/bin/sh")
+ (format #f "#!~a" bash)))
- (substitute* (cons "gettext-tools/src/msginit.c"
- (find-files "gettext-tools/gnulib-tests"
- "posix_spawn"))
- (("/bin/sh")
- bash))
+ (substitute* (cons "gettext-tools/src/msginit.c"
+ (find-files "gettext-tools/gnulib-tests"
+ "posix_spawn"))
+ (("/bin/sh")
+ bash))
- (substitute* "gettext-tools/src/project-id"
- (("/bin/pwd")
- "pwd"))))
+ (substitute* "gettext-tools/src/project-id"
+ (("/bin/pwd")
+ "pwd")))))
%standard-phases)
;; When tests fail, we want to know the details.
;;; Copyright © 2014 Ian Denhardt <ian@zenhack.net>
;;; Copyright © 2014 Eric Bavier <bavier@member.fsf.org>
;;; Copyright © 2014, 2015 Federico Beffa <beffa@fbengineering.ch>
+;;; Copyright © 2015 Sou Bunnbu <iyzsong@gmail.com>
;;;
;;; This file is part of GNU Guix.
;;;
GObject classes and various wrappers for the complex data types employed by
JSON, such as arrays and objects.")
(license license:lgpl2.1+)))
+
+(define-public libxklavier
+ (package
+ (name "libxklavier")
+ (version "5.3")
+ (source (origin
+ (method url-fetch)
+ (uri (string-append "mirror://gnome/sources/" name "/"
+ version "/" name "-" version ".tar.xz"))
+ (sha256
+ (base32
+ "016lpdv35z0qsw1cprdc2k5qzkdi5waj6qmr0a2q6ljn9g2kpv7b"))))
+ (build-system gnu-build-system)
+ (arguments
+ '(#:configure-flags
+ (list (string-append "--with-xkb-base="
+ (assoc-ref %build-inputs "xkeyboard-config")
+ "/share/X11/xkb"))
+ #:phases
+ (alist-cons-before
+ 'build 'set-cc
+ (lambda _
+ (setenv "CC" "gcc")) ; for g-ir-scanner.
+ %standard-phases)))
+ (native-inputs
+ `(("glib:bin" ,glib "bin") ; for glib-mkenums, etc.
+ ("gobject-introspection" ,gobject-introspection)
+ ("pkg-config" ,pkg-config)))
+ (propagated-inputs
+ ;; Required by libxklavier.pc.
+ `(("glib" ,glib)
+ ("libxml2" ,libxml2)))
+ (inputs
+ `(("iso-codes" ,iso-codes)
+ ("libxi" ,libxi)
+ ("libxkbfile" ,libxkbfile)
+ ("xkbcomp" ,xkbcomp)
+ ("xkeyboard-config" ,xkeyboard-config)))
+ (home-page "http://www.freedesktop.org/wiki/Software/LibXklavier/")
+ (synopsis "High-level API for X Keyboard Extension")
+ (description
+ "LibXklavier is a library providing high-level API for X Keyboard
+Extension known as XKB. This library is indended to support XFree86 and other
+commercial X servers. It is useful for creating XKB-related software (layout
+indicators etc).")
+ (license license:lgpl2.0+)))
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2012, 2013, 2014, 2015 Ludovic Courtès <ludo@gnu.org>
-;;; Copyright © 2013 Andreas Enge <andreas@enge.fr>
+;;; Copyright © 2013
, 2015 Andreas Enge <andreas@enge.fr>
;;; Copyright © 2014 Eric Bavier <bavier@member.fsf.org>
;;; Copyright © 2014, 2015 Mark H Weaver <mhw@netris.org>
;;;
(define-public libgpg-error
(package
(name "libgpg-error")
- (version "1.17")
+ (version "1.18")
(source
(origin
(method url-fetch)
version ".tar.bz2"))
(sha256
(base32
- "1dapxzxl1naghf342fwfc2w2f2c5hb9gr1a1s4n8dsqn26kybx1z"))))
+ "0408v19h3h0q6w61g51hgbdg6cyw81nyzkh70qfprvsc3pkddwcz"))))
(build-system gnu-build-system)
(home-page "http://gnupg.org")
(synopsis "Library of error values for GnuPG components")
(define-public libgcrypt
(package
(name "libgcrypt")
- (version "1.6.2")
+ (version "1.6.3")
(source (origin
(method url-fetch)
(uri (string-append "mirror://gnupg/libgcrypt/libgcrypt-"
version ".tar.bz2"))
(sha256
(base32
- "0k2wi34qhp5hq71w1ab3kw1gfsx7xff79bvynqkxp35kls94826y"))))
+ "0pq2nwfqgggrsh8rk84659d80vfnlkbphwqjwahccd5fjdxr3d21"))))
(build-system gnu-build-system)
(propagated-inputs
`(("libgpg-error-host" ,libgpg-error)))
specifications are building blocks of S/MIME and TLS.")
(license gpl3+)))
+(define-public npth
+ (package
+ (name "npth")
+ (version "1.1")
+ (source
+ (origin
+ (method url-fetch)
+ (uri (string-append
+ "mirror://gnupg/npth/npth-"
+ version ".tar.bz2"))
+ (sha256
+ (base32
+ "0zyzwmk4mp6pas87jz35zx0jvwdz7x5b13w225gs73gcn8g5cv49"))))
+ (build-system gnu-build-system)
+ (home-page "http://www.gnupg.org")
+ (synopsis "Non-preemptive thread library")
+ (description
+ "Npth is a library to provide the GNU Pth API and thus a non-preemptive
+threads implementation.
+
+In contrast to GNU Pth is is based on the system's standard threads
+implementation. This allows the use of libraries which are not
+compatible to GNU Pth.")
+ (license (list lgpl3+ gpl2+)))) ; dual license
+
(define-public gnupg
(package
(name "gnupg")
- (version "2.0.27")
+ (version "2.1.2")
(source (origin
(method url-fetch)
(uri (string-append "mirror://gnupg/gnupg/gnupg-" version
".tar.bz2"))
(sha256
(base32
- "1wihx7dphacg9fy5wfj93h236lr1w5gwzh7ir3js37wi9cz6sr2p"))))
+ "14k7c5spai3yppz6izf1ggbnffskl54ln87v1wgy9pwism1mlks0"))))
(build-system gnu-build-system)
(inputs
`(("bzip2" ,guix:bzip2)
("libgcrypt" ,libgcrypt)
("libgpg-error" ,libgpg-error)
("libksba" ,libksba)
- ("pth" ,pth)
+ ("npth" ,npth)
("openldap" ,openldap)
("zlib" ,guix:zlib)
("readline" ,readline)))
(alist-cons-before
'configure 'patch-config-files
(lambda _
- (substitute* "tests/openpgp/Makefile.in"
- (("/bin/sh") (which "bash"))))
+ (substitute* "tests/openpgp/defs.inc"
+ (("/bin/pwd") (which "pwd"))))
%standard-phases)))
(home-page "http://gnupg.org/")
(synopsis "GNU Privacy Guard")
libskba (working with X.509 certificates and CMS data).")
(license gpl3+)))
+(define-public gnupg-2.0
+ (package (inherit gnupg)
+ (version "2.0.27")
+ (source (origin
+ (method url-fetch)
+ (uri (string-append "mirror://gnupg/gnupg/gnupg-" version
+ ".tar.bz2"))
+ (sha256
+ (base32
+ "1wihx7dphacg9fy5wfj93h236lr1w5gwzh7ir3js37wi9cz6sr2p"))))
+ (inputs
+ `(("bzip2" ,guix:bzip2)
+ ("curl" ,curl)
+ ("libassuan" ,libassuan)
+ ("libgcrypt" ,libgcrypt)
+ ("libgpg-error" ,libgpg-error)
+ ("libksba" ,libksba)
+ ("pth" ,pth)
+ ("openldap" ,openldap)
+ ("zlib" ,guix:zlib)
+ ("readline" ,readline)))
+ (arguments
+ `(#:phases
+ (alist-cons-before
+ 'configure 'patch-config-files
+ (lambda _
+ (substitute* "tests/openpgp/Makefile.in"
+ (("/bin/sh") (which "bash"))))
+ %standard-phases)))))
+
(define-public gnupg-1
(package (inherit gnupg)
(version "1.4.19")
(define-public gpgme
(package
(name "gpgme")
- (version "1.5.1")
+ (version "1.5.3")
(source
(origin
(method url-fetch)
".tar.bz2"))
(sha256
(base32
- "1qqi9bxwxxsc4r15j7drclgp0w8jk9nj3h2fsivk4c7brvw3lbvc"))))
+ "1jgwmra6cf0i5x2prj92w77vl7hmj276qmmll3lwysbyn32l1c0d"))))
(build-system gnu-build-system)
(propagated-inputs
;; Needs to be propagated because gpgme.h includes gpg-error.h.
(define-public pius
(package
(name "pius")
- (version "2.0.9")
+ (version "2.0.11")
(source (origin
(method url-fetch)
(uri (string-append "mirror://sourceforge/pgpius/pius/"
version "/pius-"
version ".tar.bz2"))
(sha256 (base32
- "1g1jly3wl4ks6h8ydkygyl2c4i7v3z91rg42005m6vm70y1d8b3d"))))
+ "0pdbyqz6k0bm182cz81ss7yckmpms5qhrrw0wcr4a1srzcjyzf5f"))))
(build-system gnu-build-system)
(inputs `(("perl" ,perl)
("python" ,python-2) ; uses the Python 2 'print' syntax
(define-public pinentry
(package
(name "pinentry")
- (version "0.8.3")
+ (version "0.9.0")
(source (origin
(method url-fetch)
(uri (string-append "mirror://gnupg/pinentry/pinentry-"
version ".tar.bz2"))
(sha256
(base32
- "1bd047crf7xb8g61mval8v6qww98rddlsw2dz6j8h8qbnl4hp2sn"))))
+ "1awhajq21hcjgqfxg9czaxg555gij4bba6axrwg8w6lfmc3ml14h"))))
(build-system gnu-build-system)
(inputs
`(("ncurses" ,ncurses)
;; independently. This seems suboptimal.
"--with-default-trust-store-dir=/etc/ssl/certs")))
(native-inputs
- `(("pkg-config" ,pkg-config)))
+ `(("pkg-config" ,pkg-config)
+ ("which" ,which)))
(inputs
`(("guile" ,guile-2.0)
("perl" ,perl)))
(propagated-inputs
+ ;; These are all in the 'Requires.private' field of gnutls.pc.
`(("libtasn1" ,libtasn1)
("nettle" ,nettle)
- ("which" ,which)
("zlib" ,guix:zlib)))
(home-page "http://www.gnu.org/software/gnutls/")
(synopsis "Transport layer security library")
`(("pkg-config" ,pkg-config)
("python" ,python-wrapper)))
(arguments
- `(#:tests? #f)) ; see http://lists.gnu.org/archive/html/bug-guix/2013-06/msg00085.html
+ `(#:tests? #f ; see http://lists.gnu.org/archive/html/bug-guix/2013-06/msg00085.html
+ #:configure-flags '("--enable-tee"))) ; needed for GNU Icecat
(synopsis "2D graphics library")
(description
"Cairo is a 2D graphics library with support for multiple output devices.
(("\"libguile-ncurses\"")
(format #f "\"~a/lib/libguile-ncurses\""
out)))))
- (alist-cons-before
- 'check 'install-locales
- (lambda _
- ;; One of the tests requires the availability of a UTF-8
- ;; locale and otherwise fails.
- (setenv "LOCPATH" (getcwd))
- (zero? (system* "localedef" "--no-archive"
- "--prefix" (getcwd) "-i" "en_US"
- "-f" "UTF-8" "./en_US.utf8")))
- %standard-phases))))
+ %standard-phases)))
(home-page "http://www.gnu.org/software/guile-ncurses/")
(synopsis "Guile bindings to ncurses")
(description
"0q1gnjnxgphsh4l8i9rfly4bi8xsczsb9ryzbm8hf38lc3fk5bq3"))))
(build-system gnu-build-system)
(arguments
- '(#:phases (alist-replace
- 'unpack
- (lambda* (#:key source #:allow-other-keys)
- (and (zero? (system* "unzip" source))
- (chdir "FreeImage")))
- (alist-delete
- 'configure
- (alist-cons-before
- 'build 'patch-makefile
- (lambda* (#:key outputs #:allow-other-keys)
- (substitute* "Makefile.gnu"
- (("/usr") (assoc-ref outputs "out"))
- (("-o root -g root") "")))
- %standard-phases)))
+ '(#:phases (alist-delete
+ 'configure
+ (alist-cons-before
+ 'build 'patch-makefile
+ (lambda* (#:key outputs #:allow-other-keys)
+ (substitute* "Makefile.gnu"
+ (("/usr") (assoc-ref outputs "out"))
+ (("-o root -g root") "")))
+ %standard-phases))
#:make-flags '("CC=gcc")
#:tests? #f)) ; no check target
(native-inputs
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2014 Eric Bavier <address@hidden>
+;;; Copyright © 2015 Mark H Weaver <mhw@netris.org>
;;;
;;; This file is part of GNU Guix.
;;;
(method url-fetch)
(uri (string-append "https://github.com/maebert/jrnl/archive/"
version ".tar.gz"))
+ (file-name (string-append name "-" version ".tar.gz"))
(sha256
(base32
"019ky09sj5i7frmca0imv4jm46mn3f4lzah2wmiwxh22cisj7ksn"))))
(method url-fetch)
(uri (string-append "https://github.com/flavio/qjson/archive/"
version ".tar.gz"))
+ (file-name (string-append name "-" version ".tar.gz"))
(sha256
(base32
"163fspi0xc705irv79qw861fmh68pjyla9vx3kqiq6xrdhb9834j"))))
(< depth %max-symlink-depth)
(loop (readlink file) (+ 1 depth))))))))
+(define (shared-library? file)
+ ;; Return #t when FILE denotes a shared library.
+ (or (string-suffix? ".so" file)
+ (let ((index (string-contains file ".so.")))
+ ;; Since we cannot use regexps during bootstrap, roll our own.
+ (and index
+ (string-every (char-set-union (char-set #\.) char-set:digit)
+ (string-drop file (+ index 3)))))))
+
(define (library-files-linked args)
;; Return the file names of shared libraries explicitly linked against via
;; `-l' or with an absolute file name in ARGS.
(cons full library-files))
result)))
((and (string-prefix? %store-directory argument)
- (string-suffix? ".so" argument)) ;add library
+ (shared-library? argument)) ;add library
(cons library-path
(cons argument library-files)))
(else
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2012, 2013, 2014 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2015 Mark H Weaver <mhw@netris.org>
;;;
;;; This file is part of GNU Guix.
;;;
(define-public libunistring
(package
(name "libunistring")
- (version "0.9.4")
+ (version "0.9.5")
(source (origin
(method url-fetch)
(uri (string-append
version ".tar.gz"))
(sha256
(base32
- "19nqvn19hz25ig9dbmh2di5j1r7v852x9mlnq0nr0hka51ins97m"))))
+ "05va4x47ik006nd13grwm276gfxb8igsj63k37vvwl3q8rr0g30s"))))
(propagated-inputs '()) ; FIXME: add libiconv when !glibc
(build-system gnu-build-system)
(arguments
(native-inputs `(("autoconf" ,autoconf)
("automake" ,automake)))
(arguments
- '(#:phases (alist-cons-before
- 'configure 'bootstrap
+ '(#:phases (alist-cons-after
+ 'unpack 'bootstrap
(lambda _
(zero? (system* "autoreconf" "-vf")))
%standard-phases)
(method url-fetch)
(uri (string-append "https://github.com/ghedo/pflask/archive/v"
version ".tar.gz"))
+ (file-name (string-append name "-" version ".tar.gz"))
(sha256
(base32
"1g8fjj67dfkc2s0852l9vqi1pm61gp4rxbpzbzg780f5s5hd1fys"))))
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2013, 2014, 2015 Ludovic Courtès <ludo@gnu.org>
-;;; Copyright © 2014 Mark H Weaver <mhw@netris.org>
+;;; Copyright © 2014, 2015 Mark H Weaver <mhw@netris.org>
;;; Copyright © 2014 Ian Denhardt <ian@zenhack.net>
;;; Copyright © 2014 Sou Bunnbu <iyzsong@gmail.com>
;;; Copyright © 2014 Julien Lepiller <julien@lepiller.eu>
(method url-fetch)
(uri (string-append "https://github.com/OfflineIMAP/offlineimap/"
"archive/v" version ".tar.gz"))
+ (file-name (string-append name "-" version ".tar.gz"))
(sha256
(base32
"00k84qagph3xnxss6rkxm61x07ngz8fvffx4z9jyw5baf3cdd32p"))))
(method url-fetch)
(uri (string-append "https://github.com/dinhviethoa/" name
"/archive/" version ".tar.gz"))
+ (file-name (string-append name "-" version ".tar.gz"))
(sha256
(base32 "05qyqx2c1ppb1jnrs3m52i60f9xlxfxdmb9dnwg4vqjv8kwv2qkr"))))
(build-system gnu-build-system)
`(("curl" ,curl)
("expat" ,expat)))
(arguments
- '(#:phases (alist-cons-before
- 'configure 'autogen
+ '(#:phases (alist-cons-after
+ 'unpack 'autogen
(lambda _
- (system* "./autogen.sh")) ;; Note: this fails because the
- ;; generated configure script uses /bin/sh. It is
- ;; replaced in the configure phase by the correct
- ;; value. TODO: replace the configure phase by the
- ;; autogen phase and have the SHELL variable be replaced
+ (setenv "NOCONFIGURE" "true")
+ (zero? (system* "sh" "autogen.sh")))
%standard-phases)
#:configure-flags
'("--disable-static" "--disable-db")))
(method url-fetch)
(uri (string-append "https://github.com/opencollab/arpack-ng/archive/"
version ".tar.gz"))
+ (file-name (string-append name "-" version ".tar.gz"))
(sha256
(base32
"1fwch6vipms1ispzg2djvbzv5wag36f1dmmr3xs3mbp6imfyhvff"))))
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2012, 2013 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2014 Mark H Weaver <mhw@netris.org>
+;;; Copyright © 2015 Andreas Enge <andreas@enge.fr>
;;;
;;; This file is part of GNU Guix.
;;;
(define-public mpc
(package
(name "mpc")
- (version "1.0.2")
+ (version "1.0.3")
(source (origin
(method url-fetch)
(uri (string-append
"mirror://gnu/mpc/mpc-" version ".tar.gz"))
- (sha256 (base32
- "1264h3ivldw5idph63x35dqqdzqqbxrm5vlir0xyx727i96zaqdm"))))
+ (sha256
+ (base32
+ "1hzci2zrrd7v3g1jk35qindq05hbl0bhjcyyisq9z209xb3fqzb1"))))
(build-system gnu-build-system)
(outputs '("out" "debug"))
(propagated-inputs `(("gmp" ,gmp) ; <mpc.h> refers to both
(method url-fetch)
(uri (string-append "https://github.com/martine/ninja/"
"archive/v" version ".tar.gz"))
+ (file-name (string-append name "-" version ".tar.gz"))
(sha256
(base32
"1h3yfwcfl61v493vna6jia2fizh8rpig7qw2504cvkr6gid3p5bw"))
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2014 Eric Bavier <bavier@member.fsf.org>
+;;; Copyright © 2015 Mark H Weaver <mhw@netris.org>
;;;
;;; This file is part of GNU Guix.
;;;
(method url-fetch)
(uri (string-append "https://github.com/thinkle/gourmet/archive/"
version ".tar.gz"))
+ (file-name (string-append name "-" version ".tar.gz"))
(sha256
(base32
"1qvz175arzqm10lpfx8ffadrgirs3240zzqcp0h7sl53qfwx7v8k"))))
"rm"))))
%standard-phases))))
(native-search-paths
- (list (search-path-specification
+ ;; FIXME: These two variables must designate a single file or directory
+ ;; and are not actually "search paths." In practice it works OK in user
+ ;; profiles because there's always just one item that matches the
+ ;; specification.
+ (list (search-path-specification
(variable "SSL_CERT_DIR")
- (files '("etc/ssl/certs")))))
+ (files '("etc/ssl/certs")))
+ (search-path-specification
+ (variable "SSL_CERT_FILE")
+ (files '("etc/ssl/certs/ca-certificates.crt")))))
(synopsis "SSL/TLS implementation")
(description
"OpenSSL is an implementation of SSL/TLS")
(arguments
(substitute-keyword-arguments (package-arguments guix-0.8.1)
((#:phases phases)
- `(alist-cons-before
- 'configure 'bootstrap
+ `(alist-cons-after
+ 'unpack 'bootstrap
(lambda _
;; Make sure 'msgmerge' can modify the PO files.
(for-each (lambda (po)
(chmod po #o666))
(find-files "." "\\.po$"))
- (zero? (system* "./bootstrap")))
+ (zero? (system* "sh" "bootstrap")))
,phases))))
(native-inputs
`(("autoconf" ,(autoconf-wrapper))
+++ /dev/null
-Fix CVE-2012-3406: Stack overflow in vfprintf [BZ #16617]
-
-Note: Here the ChangeLog and NEWS updates are removed from Jeff's
- patch, since they depend on other earlier commits.
-
-From: Jeff Law <law@redhat.com>
-Date: Mon, 15 Dec 2014 09:09:32 +0000 (+0100)
-Subject: CVE-2012-3406: Stack overflow in vfprintf [BZ #16617]
-X-Git-Url: https://sourceware.org/git/gitweb.cgi?p=glibc.git;a=commitdiff_plain;h=a3a1f4163c4d0f9a36056c8640661a88674ae8a2
-
-CVE-2012-3406: Stack overflow in vfprintf [BZ #16617]
-
-A larger number of format specifiers coudld cause a stack overflow,
-potentially allowing to bypass _FORTIFY_SOURCE format string
-protection.
-
-(cherry picked from commit a5357b7ce2a2982c5778435704bcdb55ce3667a0)
-(cherry picked from commit ae61fc7b33d9d99d2763c16de8275227dc9748ba)
-
-Conflicts:
- NEWS
----
-
-diff --git a/stdio-common/Makefile b/stdio-common/Makefile
-index 5f8e534..e5e45b6 100644
---- a/stdio-common/Makefile
-+++ b/stdio-common/Makefile
-@@ -57,7 +57,7 @@ tests := tstscanf test_rdwr test-popen tstgetln test-fseek \
- bug19 bug19a tst-popen2 scanf13 scanf14 scanf15 bug20 bug21 bug22 \
- scanf16 scanf17 tst-setvbuf1 tst-grouping bug23 bug24 \
- bug-vfprintf-nargs tst-long-dbl-fphex tst-fphex-wide tst-sprintf3 \
-- bug25 tst-printf-round bug26
-+ bug25 tst-printf-round bug23-2 bug23-3 bug23-4 bug26
-
- test-srcs = tst-unbputc tst-printf
-
-diff --git a/stdio-common/bug23-2.c b/stdio-common/bug23-2.c
-new file mode 100644
-index 0000000..9e0cfe6
---- /dev/null
-+++ b/stdio-common/bug23-2.c
-@@ -0,0 +1,70 @@
-+#include <stdio.h>
-+#include <string.h>
-+#include <stdlib.h>
-+
-+static const char expected[] = "\
-+\n\
-+a\n\
-+abbcd55\
-+\n\
-+a\n\
-+abbcd55\
-+\n\
-+a\n\
-+abbcd55\
-+\n\
-+a\n\
-+abbcd55\
-+\n\
-+a\n\
-+abbcd55\
-+\n\
-+a\n\
-+abbcd55\
-+\n\
-+a\n\
-+abbcd55\
-+\n\
-+a\n\
-+abbcd55\
-+\n\
-+a\n\
-+abbcd55\
-+\n\
-+a\n\
-+abbcd55\
-+\n\
-+a\n\
-+abbcd55\
-+\n\
-+a\n\
-+abbcd55\
-+\n\
-+a\n\
-+abbcd55%%%%%%%%%%%%%%%%%%%%%%%%%%\n";
-+
-+static int
-+do_test (void)
-+{
-+ char *buf = malloc (strlen (expected) + 1);
-+ snprintf (buf, strlen (expected) + 1,
-+ "\n%1$s\n" "%1$s" "%2$s" "%2$s" "%3$s" "%4$s" "%5$d" "%5$d"
-+ "\n%1$s\n" "%1$s" "%2$s" "%2$s" "%3$s" "%4$s" "%5$d" "%5$d"
-+ "\n%1$s\n" "%1$s" "%2$s" "%2$s" "%3$s" "%4$s" "%5$d" "%5$d"
-+ "\n%1$s\n" "%1$s" "%2$s" "%2$s" "%3$s" "%4$s" "%5$d" "%5$d"
-+ "\n%1$s\n" "%1$s" "%2$s" "%2$s" "%3$s" "%4$s" "%5$d" "%5$d"
-+ "\n%1$s\n" "%1$s" "%2$s" "%2$s" "%3$s" "%4$s" "%5$d" "%5$d"
-+ "\n%1$s\n" "%1$s" "%2$s" "%2$s" "%3$s" "%4$s" "%5$d" "%5$d"
-+ "\n%1$s\n" "%1$s" "%2$s" "%2$s" "%3$s" "%4$s" "%5$d" "%5$d"
-+ "\n%1$s\n" "%1$s" "%2$s" "%2$s" "%3$s" "%4$s" "%5$d" "%5$d"
-+ "\n%1$s\n" "%1$s" "%2$s" "%2$s" "%3$s" "%4$s" "%5$d" "%5$d"
-+ "\n%1$s\n" "%1$s" "%2$s" "%2$s" "%3$s" "%4$s" "%5$d" "%5$d"
-+ "\n%1$s\n" "%1$s" "%2$s" "%2$s" "%3$s" "%4$s" "%5$d" "%5$d"
-+ "\n%1$s\n" "%1$s" "%2$s" "%2$s" "%3$s" "%4$s" "%5$d" "%5$d"
-+ "%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%\n",
-+ "a", "b", "c", "d", 5);
-+ return strcmp (buf, expected) != 0;
-+}
-+
-+#define TEST_FUNCTION do_test ()
-+#include "../test-skeleton.c"
-diff --git a/stdio-common/bug23-3.c b/stdio-common/bug23-3.c
-new file mode 100644
-index 0000000..57c8cef
---- /dev/null
-+++ b/stdio-common/bug23-3.c
-@@ -0,0 +1,50 @@
-+#include <stdio.h>
-+#include <string.h>
-+#include <stdlib.h>
-+
-+int
-+do_test (void)
-+{
-+ size_t instances = 16384;
-+#define X0 "\n%1$s\n" "%1$s" "%2$s" "%2$s" "%3$s" "%4$s" "%5$d" "%5$d"
-+ const char *item = "\na\nabbcd55";
-+#define X3 X0 X0 X0 X0 X0 X0 X0 X0
-+#define X6 X3 X3 X3 X3 X3 X3 X3 X3
-+#define X9 X6 X6 X6 X6 X6 X6 X6 X6
-+#define X12 X9 X9 X9 X9 X9 X9 X9 X9
-+#define X14 X12 X12 X12 X12
-+#define TRAILER "%%%%%%%%%%%%%%%%%%%%%%%%%%"
-+#define TRAILER2 TRAILER TRAILER
-+ size_t length = instances * strlen (item) + strlen (TRAILER) + 1;
-+
-+ char *buf = malloc (length + 1);
-+ snprintf (buf, length + 1,
-+ X14 TRAILER2 "\n",
-+ "a", "b", "c", "d", 5);
-+
-+ const char *p = buf;
-+ size_t i;
-+ for (i = 0; i < instances; ++i)
-+ {
-+ const char *expected;
-+ for (expected = item; *expected; ++expected)
-+ {
-+ if (*p != *expected)
-+ {
-+ printf ("mismatch at offset %zu (%zu): expected %d, got %d\n",
-+ (size_t) (p - buf), i, *expected & 0xFF, *p & 0xFF);
-+ return 1;
-+ }
-+ ++p;
-+ }
-+ }
-+ if (strcmp (p, TRAILER "\n") != 0)
-+ {
-+ printf ("mismatch at trailer: [%s]\n", p);
-+ return 1;
-+ }
-+ free (buf);
-+ return 0;
-+}
-+#define TEST_FUNCTION do_test ()
-+#include "../test-skeleton.c"
-diff --git a/stdio-common/bug23-4.c b/stdio-common/bug23-4.c
-new file mode 100644
-index 0000000..a478564
---- /dev/null
-+++ b/stdio-common/bug23-4.c
-@@ -0,0 +1,31 @@
-+#include <stdio.h>
-+#include <stdlib.h>
-+#include <string.h>
-+#include <sys/resource.h>
-+
-+#define LIMIT 1000000
-+
-+int
-+main (void)
-+{
-+ struct rlimit lim;
-+ getrlimit (RLIMIT_STACK, &lim);
-+ lim.rlim_cur = 1048576;
-+ setrlimit (RLIMIT_STACK, &lim);
-+ char *fmtstr = malloc (4 * LIMIT + 1);
-+ if (fmtstr == NULL)
-+ abort ();
-+ char *output = malloc (LIMIT + 1);
-+ if (output == NULL)
-+ abort ();
-+ for (size_t i = 0; i < LIMIT; i++)
-+ memcpy (fmtstr + 4 * i, "%1$d", 4);
-+ fmtstr[4 * LIMIT] = '\0';
-+ int ret = snprintf (output, LIMIT + 1, fmtstr, 0);
-+ if (ret != LIMIT)
-+ abort ();
-+ for (size_t i = 0; i < LIMIT; i++)
-+ if (output[i] != '0')
-+ abort ();
-+ return 0;
-+}
-diff --git a/stdio-common/vfprintf.c b/stdio-common/vfprintf.c
-index c4ff833..429a3d1 100644
---- a/stdio-common/vfprintf.c
-+++ b/stdio-common/vfprintf.c
-@@ -263,6 +263,12 @@ vfprintf (FILE *s, const CHAR_T *format, va_list ap)
- /* For the argument descriptions, which may be allocated on the heap. */
- void *args_malloced = NULL;
-
-+ /* For positional argument handling. */
-+ struct printf_spec *specs;
-+
-+ /* Track if we malloced the SPECS array and thus must free it. */
-+ bool specs_malloced = false;
-+
- /* This table maps a character into a number representing a
- class. In each step there is a destination label for each
- class. */
-@@ -1679,8 +1685,8 @@ do_positional:
- size_t nspecs = 0;
- /* A more or less arbitrary start value. */
- size_t nspecs_size = 32 * sizeof (struct printf_spec);
-- struct printf_spec *specs = alloca (nspecs_size);
-
-+ specs = alloca (nspecs_size);
- /* The number of arguments the format string requests. This will
- determine the size of the array needed to store the argument
- attributes. */
-@@ -1721,11 +1727,39 @@ do_positional:
- if (nspecs * sizeof (*specs) >= nspecs_size)
- {
- /* Extend the array of format specifiers. */
-+ if (nspecs_size * 2 < nspecs_size)
-+ {
-+ __set_errno (ENOMEM);
-+ done = -1;
-+ goto all_done;
-+ }
- struct printf_spec *old = specs;
-- specs = extend_alloca (specs, nspecs_size, 2 * nspecs_size);
-+ if (__libc_use_alloca (2 * nspecs_size))
-+ specs = extend_alloca (specs, nspecs_size, 2 * nspecs_size);
-+ else
-+ {
-+ nspecs_size *= 2;
-+ specs = malloc (nspecs_size);
-+ if (specs == NULL)
-+ {
-+ __set_errno (ENOMEM);
-+ specs = old;
-+ done = -1;
-+ goto all_done;
-+ }
-+ }
-
- /* Copy the old array's elements to the new space. */
- memmove (specs, old, nspecs * sizeof (*specs));
-+
-+ /* If we had previously malloc'd space for SPECS, then
-+ release it after the copy is complete. */
-+ if (specs_malloced)
-+ free (old);
-+
-+ /* Now set SPECS_MALLOCED if needed. */
-+ if (!__libc_use_alloca (nspecs_size))
-+ specs_malloced = true;
- }
-
- /* Parse the format specifier. */
-@@ -2046,6 +2080,8 @@ do_positional:
- }
-
- all_done:
-+ if (specs_malloced)
-+ free (specs);
- if (__glibc_unlikely (args_malloced != NULL))
- free (args_malloced);
- if (__glibc_unlikely (workstart != NULL))
+++ /dev/null
-Fix CVE-2014-7817: wordexp fails to honour WRDE_NOCMD.
-
-Note: Here the ChangeLog and NEWS updates are removed from Carlos's
- patch, since they depend on other earlier commits.
-
-From: Carlos O'Donell <carlos@redhat.com>
-Date: Wed, 19 Nov 2014 16:44:12 +0000 (-0500)
-Subject: CVE-2014-7817: wordexp fails to honour WRDE_NOCMD.
-X-Git-Url: https://sourceware.org/git/gitweb.cgi?p=glibc.git;a=commitdiff_plain;h=33ceaf6187b31ea15284ac65131749e1cb68d2ae
-
-CVE-2014-7817: wordexp fails to honour WRDE_NOCMD.
-
-The function wordexp() fails to properly handle the WRDE_NOCMD
-flag when processing arithmetic inputs in the form of "$((... ``))"
-where "..." can be anything valid. The backticks in the arithmetic
-epxression are evaluated by in a shell even if WRDE_NOCMD forbade
-command substitution. This allows an attacker to attempt to pass
-dangerous commands via constructs of the above form, and bypass
-the WRDE_NOCMD flag. This patch fixes this by checking for WRDE_NOCMD
-in exec_comm(), the only place that can execute a shell. All other
-checks for WRDE_NOCMD are superfluous and removed.
-
-We expand the testsuite and add 3 new regression tests of roughly
-the same form but with a couple of nested levels.
-
-On top of the 3 new tests we add fork validation to the WRDE_NOCMD
-testing. If any forks are detected during the execution of a wordexp()
-call with WRDE_NOCMD, the test is marked as failed. This is slightly
-heuristic since vfork might be used in the future, but it provides a
-higher level of assurance that no shells were executed as part of
-command substitution with WRDE_NOCMD in effect. In addition it doesn't
-require libpthread or libdl, instead we use the public implementation
-namespace function __register_atfork (already part of the public ABI
-for libpthread).
-
-Tested on x86_64 with no regressions.
-
-(cherry picked from commit a39208bd7fb76c1b01c127b4c61f9bfd915bfe7c)
----
-
-diff --git a/posix/wordexp-test.c b/posix/wordexp-test.c
-index 4957006..bdd65e4 100644
---- a/posix/wordexp-test.c
-+++ b/posix/wordexp-test.c
-@@ -27,6 +27,25 @@
-
- #define IFS " \n\t"
-
-+extern void *__dso_handle __attribute__ ((__weak__, __visibility__ ("hidden")));
-+extern int __register_atfork (void (*) (void), void (*) (void), void (*) (void), void *);
-+
-+static int __app_register_atfork (void (*prepare) (void), void (*parent) (void), void (*child) (void))
-+{
-+ return __register_atfork (prepare, parent, child,
-+ &__dso_handle == NULL ? NULL : __dso_handle);
-+}
-+
-+/* Number of forks seen. */
-+static int registered_forks;
-+
-+/* For each fork increment the fork count. */
-+static void
-+register_fork (void)
-+{
-+ registered_forks++;
-+}
-+
- struct test_case_struct
- {
- int retval;
-@@ -206,6 +225,12 @@ struct test_case_struct
- { WRDE_SYNTAX, NULL, "$((2+))", 0, 0, { NULL, }, IFS },
- { WRDE_SYNTAX, NULL, "`", 0, 0, { NULL, }, IFS },
- { WRDE_SYNTAX, NULL, "$((010+4+))", 0, 0, { NULL }, IFS },
-+ /* Test for CVE-2014-7817. We test 3 combinations of command
-+ substitution inside an arithmetic expression to make sure that
-+ no commands are executed and error is returned. */
-+ { WRDE_CMDSUB, NULL, "$((`echo 1`))", WRDE_NOCMD, 0, { NULL, }, IFS },
-+ { WRDE_CMDSUB, NULL, "$((1+`echo 1`))", WRDE_NOCMD, 0, { NULL, }, IFS },
-+ { WRDE_CMDSUB, NULL, "$((1+$((`echo 1`))))", WRDE_NOCMD, 0, { NULL, }, IFS },
-
- { -1, NULL, NULL, 0, 0, { NULL, }, IFS },
- };
-@@ -258,6 +283,15 @@ main (int argc, char *argv[])
- return -1;
- }
-
-+ /* If we are not allowed to do command substitution, we install
-+ fork handlers to verify that no forks happened. No forks should
-+ happen at all if command substitution is disabled. */
-+ if (__app_register_atfork (register_fork, NULL, NULL) != 0)
-+ {
-+ printf ("Failed to register fork handler.\n");
-+ return -1;
-+ }
-+
- for (test = 0; test_case[test].retval != -1; test++)
- if (testit (&test_case[test]))
- ++fail;
-@@ -367,6 +401,9 @@ testit (struct test_case_struct *tc)
-
- printf ("Test %d (%s): ", ++tests, tc->words);
-
-+ if (tc->flags & WRDE_NOCMD)
-+ registered_forks = 0;
-+
- if (tc->flags & WRDE_APPEND)
- {
- /* initial wordexp() call, to be appended to */
-@@ -378,6 +415,13 @@ testit (struct test_case_struct *tc)
- }
- retval = wordexp (tc->words, &we, tc->flags);
-
-+ if ((tc->flags & WRDE_NOCMD)
-+ && (registered_forks > 0))
-+ {
-+ printf ("FAILED fork called for WRDE_NOCMD\n");
-+ return 1;
-+ }
-+
- if (tc->flags & WRDE_DOOFFS)
- start_offs = sav_we.we_offs;
-
-diff --git a/posix/wordexp.c b/posix/wordexp.c
-index b6b65dd..26f3a26 100644
---- a/posix/wordexp.c
-+++ b/posix/wordexp.c
-@@ -893,6 +893,10 @@ exec_comm (char *comm, char **word, size_t *word_length, size_t *max_length,
- pid_t pid;
- int noexec = 0;
-
-+ /* Do nothing if command substitution should not succeed. */
-+ if (flags & WRDE_NOCMD)
-+ return WRDE_CMDSUB;
-+
- /* Don't fork() unless necessary */
- if (!comm || !*comm)
- return 0;
-@@ -2082,9 +2086,6 @@ parse_dollars (char **word, size_t *word_length, size_t *max_length,
- }
- }
-
-- if (flags & WRDE_NOCMD)
-- return WRDE_CMDSUB;
--
- (*offset) += 2;
- return parse_comm (word, word_length, max_length, words, offset, flags,
- quoted? NULL : pwordexp, ifs, ifs_white);
-@@ -2196,9 +2197,6 @@ parse_dquote (char **word, size_t *word_length, size_t *max_length,
- break;
-
- case '`':
-- if (flags & WRDE_NOCMD)
-- return WRDE_CMDSUB;
--
- ++(*offset);
- error = parse_backtick (word, word_length, max_length, words,
- offset, flags, NULL, NULL, NULL);
-@@ -2357,12 +2355,6 @@ wordexp (const char *words, wordexp_t *pwordexp, int flags)
- break;
-
- case '`':
-- if (flags & WRDE_NOCMD)
-- {
-- error = WRDE_CMDSUB;
-- goto do_error;
-- }
--
- ++words_offset;
- error = parse_backtick (&word, &word_length, &max_length, words,
- &words_offset, flags, pwordexp, ifs,
+++ /dev/null
-Avoid a dangling `vfork@GLIBC_2.0' reference on MIPS.
-
-Note: Here the ChangeLog and NEWS updates are removed from Maciej's
- patch, since they depend on other earlier commits.
-
-From: Maciej W. Rozycki <macro@codesourcery.com>
-Date: Wed, 22 Oct 2014 14:20:37 +0000 (+0100)
-Subject: MIPS: Avoid a dangling `vfork@GLIBC_2.0' reference
-X-Git-Url: https://sourceware.org/git/?p=glibc.git;a=commitdiff_plain;h=c14e752fc73d34c75d4f84f37fea8e0b1734cf98
-
-MIPS: Avoid a dangling `vfork@GLIBC_2.0' reference
-
-This satisfies a symbol reference created with:
-
- .symver __libc_vfork, vfork@GLIBC_2.0
-
-where `__libc_vfork' has not been defined or referenced. In this case
-the `vfork@GLIBC_2.0' reference is supposed to be discarded, however a
-bug present in GAS since forever causes an undefined symbol table entry
-to be created. This in turn triggers a problem in the linker that can
-manifest itself by link errors such as:
-
-ld: libpthread.so: invalid string offset 2765592330 >= 5154 for section `.dynstr'
-
-The GAS and linker bugs need to be resolved, but we can avoid them too
-by providing a `__libc_vfork' definition just like our other platforms.
-
- [BZ #17485]
- * sysdeps/unix/sysv/linux/mips/vfork.S (__libc_vfork): Define.
-
-(cherry picked from commit b5af9297d51a43f96c5be1bafab032184690dd6f)
-
-Conflicts:
- NEWS
----
-
-diff --git a/sysdeps/unix/sysv/linux/mips/vfork.S b/sysdeps/unix/sysv/linux/mips/vfork.S
-index 80c362d..2c1a747 100644
---- a/sysdeps/unix/sysv/linux/mips/vfork.S
-+++ b/sysdeps/unix/sysv/linux/mips/vfork.S
-@@ -108,3 +108,4 @@ L(error):
-
- libc_hidden_def(__vfork)
- weak_alias (__vfork, vfork)
-+strong_alias (__vfork, __libc_vfork)
--- /dev/null
+Fix CVE-2015-1345. From upstream commit
+83a95bd8c8561875b948cadd417c653dbe7ef2e2
+by Yuliy Pisetsky <ypisetsky@fb.com>.
+
+diff --git a/src/kwset.c b/src/kwset.c
+index 4003c8d..376f7c3 100644
+--- a/src/kwset.c
++++ b/src/kwset.c
+@@ -643,6 +643,8 @@ bmexec_trans (kwset_t kwset, char const *text, size_t size)
+ if (! tp)
+ return -1;
+ tp++;
++ if (ep <= tp)
++ break;
+ }
+ }
+ }
Also skip the nopic test on ARM and MIPS systems.
---- libtool-2.4.4/tests/demo.at.orig 2014-11-19 07:28:51.000000000 -0500
-+++ libtool-2.4.4/tests/demo.at 2015-01-07 17:30:46.482247718 -0500
+--- libtool-2.4.6/tests/demo.at.orig 2015-01-16 13:52:04.000000000 -0500
++++ libtool-2.4.6/tests/demo.at 2015-02-16 10:48:51.435851966 -0500
@@ -510,7 +510,7 @@
AT_SETUP([force non-PIC objects])
# These hosts cannot use non-PIC shared libs
exit 77 ;;
*-solaris*|*-sunos*)
---- libtool-2.4.4/tests/testsuite.orig 2014-11-29 11:43:11.000000000 -0500
-+++ libtool-2.4.4/tests/testsuite 2015-01-07 17:24:51.424672582 -0500
-@@ -8633,7 +8633,7 @@
+--- libtool-2.4.6/tests/testsuite.orig 2015-02-15 11:15:25.000000000 -0500
++++ libtool-2.4.6/tests/testsuite 2015-02-16 10:50:58.736483216 -0500
+@@ -8741,7 +8741,7 @@
{ set +x
$as_echo "$at_srcdir/demo.at:535: case \$host in
# These hosts cannot use non-PIC shared libs
exit 77 ;;
*-solaris*|*-sunos*)
-@@ -8658,7 +8658,7 @@
+@@ -8766,7 +8766,7 @@
"
at_fn_check_prepare_notrace 'a `...` command substitution' "demo.at:535"
( $at_check_trace; case $host in
# These hosts cannot use non-PIC shared libs
exit 77 ;;
*-solaris*|*-sunos*)
-@@ -9185,7 +9185,7 @@ read at_status <"$at_status_file"
- #AT_START_33
- at_fn_group_banner 33 'demo.at:548' \
- "hardcoding library path" " " 3
+@@ -9298,7 +9298,7 @@
+ #AT_START_34
+ at_fn_group_banner 34 'demo.at:548' \
+ "hardcoding library path" " " 4
-at_xfail=no
+at_xfail=yes
test no = "$ACLOCAL" && at_xfail=yes
test no = "$AUTOHEADER" && at_xfail=yes
test no = "$AUTOMAKE" && at_xfail=yes
-@@ -27052,7 +27052,7 @@ read at_status <"$at_status_file"
- #AT_START_97
- at_fn_group_banner 97 'destdir.at:75' \
- "DESTDIR with in-package deplibs" " " 7
+@@ -27243,7 +27243,7 @@
+ #AT_START_98
+ at_fn_group_banner 98 'destdir.at:75' \
+ "DESTDIR with in-package deplibs" " " 8
-at_xfail=no
+at_xfail=yes
eval `$LIBTOOL --config | $GREP '^fast_install='`
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2013 Nikita Karetnikov <nikita@karetnikov.org>
-;;; Copyright © 2013, 2014 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2013, 2014, 2015 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2013, 2014, 2015 Andreas Enge <andreas@enge.fr>
;;; Copyright © 2014, 2015 Mark H Weaver <mhw@netris.org>
;;; Copyright © 2014 Eric Bavier <bavier@member.fsf.org>
(info (string-append data "/info"))
(html (string-append doc "/html")))
(with-directory-excursion "doc"
- ;; Install and set UTF-8 locale to avoid an encoding error.
- (setenv "LOCPATH" (getcwd))
- (system* "localedef" "--no-archive"
- "--prefix" (getcwd) "-i" "en_US"
- "-f" "UTF-8" "./en_US.UTF-8")
- (setenv "LANG" "en_US.UTF-8")
;; Produce pdf in 'A4' format.
(substitute* (find-files "." "conf\\.py")
(("latex_paper_size = 'letter'")
(html (string-append doc "/html"))
(pyver ,(string-append "PYVER=")))
(with-directory-excursion "doc"
- ;; Install and set UTF-8 locale to avoid an encoding error.
- (setenv "LOCPATH" (getcwd))
- (system* "localedef" "--no-archive"
- "--prefix" (getcwd) "-i" "en_US"
- "-f" "UTF-8" "./en_US.UTF-8")
- (setenv "LANG" "en_US.UTF-8")
;; Fix generation of images for mathematical expressions.
(substitute* (find-files "source" "conf\\.py")
(("pngmath_use_preview = True")
;; The archive on pypi is missing the 'utils' directory!
(uri (string-append "https://github.com/SimonSapin/cairocffi/archive/v"
version ".tar.gz"))
+ (file-name (string-append name "-" version ".tar.gz"))
(sha256
(base32
"03w5p62sp3nqiccx864sbq0jvh7946277jqx3rcc3dch5xwfvv51"))))
(arguments
`(#:python ,python-2 ; Otherwise tests fail with a syntax error.
#:tests? #f ; The tests apparently download an external URL.
- #:phases
- (alist-replace
- 'unpack
- (lambda* (#:key source #:allow-other-keys)
- (and (zero? (system* "unzip" source))
- (chdir "cssutils-1.0")))
- %standard-phases)))
+ ))
(home-page "http://cthedot.de/cssutils/")
(synopsis
"CSS Cascading Style Sheets library for Python")
(method url-fetch)
(uri (string-append "https://github.com/swh/LRDF/archive/"
version ".tar.gz"))
+ (file-name (string-append name "-" version ".tar.gz"))
(sha256
(base32
"18p2flb2sv2hq6w2qkd29z9c7knnwqr3f12i2srshlzx6vwkm05s"))))
(substitute* "examples/Makefile.am"
(("instances_test remove_test") "instances_test")
(("\\$\\(TESTS\\) remove_test") "$(TESTS)")))
- (alist-cons-before
- 'configure 'autoreconf
- (lambda* (#:key inputs #:allow-other-keys)
+ (alist-cons-after
+ 'remove-out-of-tree-references 'autoreconf
+ (lambda _
(zero? (system* "autoreconf" "-vfi")))
%standard-phases))))
(inputs
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2014 Pjotr Prins <pjotr.guix@thebird.nl>
;;; Copyright © 2014 Ludovic Courtès <ludo@gnu.org>
-;;; Copyright © 2014 Mark H Weaver <mhw@netris.org>
+;;; Copyright © 2014, 2015 Mark H Weaver <mhw@netris.org>
;;; Copyright © 2014 David Thompson <davet@gnu.org>
;;;
;;; This file is part of GNU Guix.
(method url-fetch)
(uri (string-append "https://github.com/svenfuchs/i18n/archive/v"
version ".tar.gz"))
+ (file-name (string-append name "-" version ".tar.gz"))
(sha256
(base32
"1fdhnhh1p5g8vibv44d770z8nq208zrms3m2nswdvr54072y1m6k"))))
;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2013 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2013, 2015 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2015 Mark H Weaver <mhw@netris.org>
;;;
;;; This file is part of GNU Guix.
;; The python part probably never worked and does not seem to
;; be needed for currently dependent packages.
;; ("python" ,python-wrapper)))
- (arguments
- `(#:phases
- (alist-cons-before
- 'check 'install-locales
- (lambda _
- ;; One of the tests requires the availability of a UTF-8
- ;; locale and otherwise fails.
- (setenv "LOCPATH" (getcwd))
- (zero? (system* "localedef" "--no-archive"
- "--prefix" (getcwd) "-i" "en_US"
- "-f" "UTF-8" "./en_US.utf8")))
- %standard-phases)))
(home-page "http://swig.org/")
(synopsis
"Interface compiler that connects C/C++ code to higher-level languages")
(uri (string-append
"https://github.com/muennich/sxiv/archive/v"
version ".tar.gz"))
+ (file-name (string-append name "-" version ".tar.gz"))
(sha256
(base32
"03hxy5ff7xbs15rhlbpgx8xmvmpjlffp0m4528975hg16sqa2c4s"))))
(("; other_script.csh") "; /bin/sh other_script.csh"))
;; Now, let's generate the test suite and patch it
(system* "make" "tests/testsuite")
- (substitute* "tests/testsuite" (("/bin/sh") (which "sh"))))
+
+ ;; This file is ISO-8859-1 encoded.
+ (with-fluids ((%default-port-encoding #f))
+ (substitute* "tests/testsuite"
+ (("/bin/sh") (which "sh")))))
(alist-cons-after
'install 'post-install
(lambda* (#:key inputs outputs #:allow-other-keys)
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2013, 2014 Ludovic Courtès <ludo@gnu.org>
-;;; Copyright © 2014 Mark H Weaver <mhw@netris.org>
+;;; Copyright © 2014, 2015 Mark H Weaver <mhw@netris.org>
;;;
;;; This file is part of GNU Guix.
;;;
#:configure-flags (list (string-append "--sysconfdir="
(assoc-ref %outputs "out")
"/etc/privoxy"))
- #:phases (alist-cons-before
- 'configure 'autoconf
+ #:phases (alist-cons-after
+ 'unpack 'autoconf
(lambda _
;; Unfortunately, this is not a tarball produced by
;; "make dist".
`("PATH" ":" prefix
("$HOME/.guix-profile/libexec/git-core")))))
%standard-phases)))))
+
+ (native-search-paths
+ ;; For HTTPS access, Git needs a single-file certificate bundle, specified
+ ;; with $GIT_SSL_CAINFO.
+ ;; FIXME: This variable designates a single file; it is not a search path.
+ (list (search-path-specification
+ (variable "GIT_SSL_CAINFO")
+ (files '("etc/ssl/certs/ca-certificates.crt")))))
+
(synopsis "Distributed version control system")
(description
"Git is a free distributed version control system designed to handle
;;; Copyright © 2013, 2015 Andreas Enge <andreas@enge.fr>
;;; Copyright © 2013 Aljosha Papsch <misc@rpapsch.de>
;;; Copyright © 2014, 2015 Ludovic Courtès <ludo@gnu.org>
-;;; Copyright © 2014 Mark H Weaver <mhw@netris.org>
+;;; Copyright © 2014, 2015 Mark H Weaver <mhw@netris.org>
;;; Copyright © 2015 Ricardo Wurmus <rekado@elephly.net>
;;; Copyright © 2015 Taylan Ulrich Bayırlı/Kammer <taylanbayirli@gmail.com>
;;;
("which" ,which)
("libtool" ,libtool)))
(arguments
- `(#:phases (alist-cons-before
- 'bootstrap 'fix-autogen-shebang
+ `(#:phases (alist-cons-after
+ 'unpack 'bootstrap
(lambda _
- (substitute* "autogen.sh"
- ;; Removing -e as it causes the whole script to fail when
- ;; `which gtkdocize` fails.
- (("# !/bin/sh -e") (string-append "#!" (which "sh")))))
- (alist-cons-before
- 'patch-usr-bin-file 'bootstrap
- (lambda _
- (zero? (system* "./autogen.sh")))
- %standard-phases))))
+ (zero? (system* "sh" "autogen.sh")))
+ %standard-phases)))
(home-page "https://github.com/rockdaboot/libpsl")
(synopsis "C library for the Publix Suffix List")
(description
(build-system gnu-build-system)
(home-page "http://www.xmlsoft.org/")
(synopsis "C parser for XML")
- (inputs `(("zlib" ,zlib)))
+ (propagated-inputs `(("zlib" ,zlib))) ; libxml2.la says '-lz'.
(native-inputs `(("perl" ,perl)
("python" ,python-2))) ; incompatible with Python 3 (print syntax)
;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2012, 2013, 2014 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2012, 2013, 2014, 2015 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
(strip-directories ''("lib" "lib64" "libexec"
"bin" "sbin"))
(phases '%standard-phases)
+ (locale "en_US.UTF-8")
(system (%current-system))
(imported-modules %default-modules)
(modules %default-modules)
#:search-paths ',(map search-path-specification->sexp
search-paths)
#:phases ,phases
+ #:locale ,locale
#:configure-flags ,configure-flags
#:make-flags ,make-flags
#:out-of-source? ,out-of-source?
(strip-directories ''("lib" "lib64" "libexec"
"bin" "sbin"))
(phases '%standard-phases)
+ (locale "en_US.UTF-8")
(system (%current-system))
(imported-modules '((guix build gnu-build-system)
(guix build utils)))
search-path-specification->sexp
native-search-paths)
#:phases ,phases
+ #:locale ,locale
#:configure-flags ,configure-flags
#:make-flags ,make-flags
#:out-of-source? ,out-of-source?
;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2013, 2014 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2013, 2014, 2015 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2013 Cyril Roelandt <tipecaml@gmail.com>
;;; Copyright © 2014 Andreas Enge <andreas@enge.fr>
;;;
"-DCMAKE_INSTALL_RPATH_USE_LINK_PATH=TRUE"
;; add (other) libraries of the project itself to rpath
,(string-append "-DCMAKE_INSTALL_RPATH=" out "/lib")
+ ;; enable verbose output from builds
+ "-DCMAKE_VERBOSE_MAKEFILE=ON"
,@configure-flags)))
(setenv "CMAKE_LIBRARY_PATH" (getenv "LIBRARY_PATH"))
(setenv "CMAKE_INCLUDE_PATH" (getenv "CPATH"))
(define %standard-phases
;; Everything is as with the GNU Build System except for the `configure'
;; and 'check' phases.
- (alist-replace 'configure configure
- (alist-replace 'check check
- gnu:%standard-phases)))
+ (modify-phases gnu:%standard-phases
+ (replace check check)
+ (replace configure configure)))
(define* (cmake-build #:key inputs (phases %standard-phases)
#:allow-other-keys #:rest args)
;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2012, 2013, 2014 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2012, 2013, 2014, 2015 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2015 Mark H Weaver <mhw@netris.org>
;;;
;;; This file is part of GNU Guix.
#:use-module (rnrs io ports)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-11)
+ #:use-module (srfi srfi-19)
#:use-module (srfi srfi-26)
#:use-module (ice-9 match)
#:use-module (ice-9 format)
;;;
;;; Code:
+(define %http-receive-buffer-size
+ ;; Size of the HTTP receive buffer.
+ 65536)
+
+(define (duration->seconds duration)
+ "Return the number of seconds represented by DURATION, a 'time-duration'
+object, as an inexact number."
+ (+ (time-second duration)
+ (/ (time-nanosecond duration) 1e9)))
+
+(define (throughput->string throughput)
+ "Given THROUGHPUT, measured in bytes per second, return a string
+representing it in a human-readable way."
+ (if (> throughput 3e6)
+ (format #f "~,2f MiB/s" (/ throughput (expt 2. 20)))
+ (format #f "~,0f KiB/s" (/ throughput 1024.0))))
+
(define* (progress-proc file size #:optional (log-port (current-output-port)))
"Return a procedure to show the progress of FILE's download, which is
SIZE byte long. The returned procedure is suitable for use as an
argument to `dump-port'. The progress report is written to LOG-PORT."
- (if (number? size)
- (lambda (transferred cont)
- (let ((% (* 100.0 (/ transferred size))))
- (display #\cr log-port)
- (format log-port "~a\t~5,1f% of ~,1f KiB"
- file % (/ size 1024.0))
- (flush-output-port log-port)
- (cont)))
- (lambda (transferred cont)
- (display #\cr log-port)
- (format log-port "~a\t~6,1f KiB transferred"
- file (/ transferred 1024.0))
- (flush-output-port log-port)
- (cont))))
+ ;; XXX: Because of <http://bugs.gnu.org/19939> this procedure is often not
+ ;; called as frequently as we'd like too; this is especially bad with Nginx
+ ;; on hydra.gnu.org, which returns whole nars as a single chunk.
+ (let ((start-time #f))
+ (let-syntax ((with-elapsed-time
+ (syntax-rules ()
+ ((_ elapsed body ...)
+ (let* ((now (current-time time-monotonic))
+ (elapsed (and start-time
+ (duration->seconds
+ (time-difference now
+ start-time)))))
+ (unless start-time
+ (set! start-time now))
+ body ...)))))
+ (if (number? size)
+ (lambda (transferred cont)
+ (with-elapsed-time elapsed
+ (let ((% (* 100.0 (/ transferred size)))
+ (throughput (if elapsed
+ (/ transferred elapsed)
+ 0)))
+ (display #\cr log-port)
+ (format log-port "~a\t~5,1f% of ~,1f KiB (~a)"
+ file % (/ size 1024.0)
+ (throughput->string throughput))
+ (flush-output-port log-port)
+ (cont))))
+ (lambda (transferred cont)
+ (with-elapsed-time elapsed
+ (let ((throughput (if elapsed
+ (/ transferred elapsed)
+ 0)))
+ (display #\cr log-port)
+ (format log-port "~a\t~6,1f KiB transferred (~a)"
+ file (/ transferred 1024.0)
+ (throughput->string throughput))
+ (flush-output-port log-port)
+ (cont))))))))
(define* (uri-abbreviation uri #:optional (max-length 42))
"If URI's string representation is larger than MAX-LENGTH, return an
(call-with-output-file file
(lambda (out)
(dump-port in out
- #:buffer-size 65536 ; don't flood the log
+ #:buffer-size %http-receive-buffer-size
#:progress (progress-proc (uri-abbreviation uri) size))))
(ftp-close conn))
(connect s (addrinfo:addr ai))
;; Buffer input and output on this port.
- (setvbuf s _IOFBF)
+ (setvbuf s _IOFBF %http-receive-buffer-size)
(if (eq? 'https (uri-scheme uri))
(tls-wrap s (uri-host uri))
(if (port? bv-or-port)
(begin
(dump-port bv-or-port p
- #:buffer-size 65536 ; don't flood the log
+ #:buffer-size %http-receive-buffer-size
#:progress (progress-proc (uri-abbreviation uri)
size))
(newline))
file url)
#f))))
+;;; Local Variables:
+;;; eval: (put 'with-elapsed-time 'scheme-indent-function 1)
+;;; End:
+
;;; download.scm ends here
outputs))
(define %standard-phases
- (alist-cons-after
- 'install 'glib-or-gtk-wrap wrap-all-programs
- (alist-cons-after
- 'install 'glib-or-gtk-icon-cache generate-icon-cache
- (alist-cons-after
- 'install 'glib-or-gtk-compile-schemas compile-glib-schemas
- gnu:%standard-phases))))
+ (modify-phases gnu:%standard-phases
+ (add-after install glib-or-gtk-compile-schemas compile-glib-schemas)
+ (add-after install glib-or-gtk-icon-cache generate-icon-cache)
+ (add-after install glib-or-gtk-wrap wrap-all-programs)))
(define* (glib-or-gtk-build #:key inputs (phases %standard-phases)
#:allow-other-keys #:rest args)
#t)
+(define* (install-locale #:key
+ (locale "en_US.UTF-8")
+ (locale-category LC_ALL)
+ #:allow-other-keys)
+ "Try to install LOCALE; emit a warning if that fails. The main goal is to
+use a UTF-8 locale so that Guile correctly interprets UTF-8 file names.
+
+This phase must typically happen after 'set-paths' so that $LOCPATH has a
+chance to be set."
+ (catch 'system-error
+ (lambda ()
+ (setlocale locale-category locale)
+
+ ;; While we're at it, pass it to sub-processes.
+ (setenv (locale-category->string locale-category) locale)
+
+ (format (current-error-port) "using '~a' locale for category ~s~%"
+ locale (locale-category->string locale-category))
+ #t)
+ (lambda args
+ ;; This is known to fail for instance in early bootstrap where locales
+ ;; are not available.
+ (format (current-error-port)
+ "warning: failed to install '~a' locale: ~a~%"
+ locale (strerror (system-error-errno args)))
+ #t)))
+
(define* (unpack #:key source #:allow-other-keys)
"Unpack SOURCE in the working directory, and change directory within the
source. When SOURCE is a directory, copy it in a sub-directory of the current
(copy-recursively source "."
#:keep-mtime? #t)
#t)
- (and (zero? (system* "tar" "xvf" source))
+ (and (if (string-suffix? ".zip" source)
+ (zero? (system* "unzip" source))
+ (zero? (system* "tar" "xvf" source)))
(chdir (first-subdirectory ".")))))
;; See <http://bugs.gnu.org/17840>.
;; Standard build phases, as a list of symbol/procedure pairs.
(let-syntax ((phases (syntax-rules ()
((_ p ...) `((p . ,p) ...)))))
- (phases set-paths unpack
+ (phases set-paths install-locale unpack
patch-usr-bin-file
patch-source-shebangs configure patch-generated-file-shebangs
build check install
(setvbuf (current-output-port) _IOLBF)
(setvbuf (current-error-port) _IOLBF)
+ ;; Encoding/decoding errors shouldn't be silent.
+ (fluid-set! %default-port-conversion-strategy 'error)
+
;; The trick is to #:allow-other-keys everywhere, so that each procedure in
;; PHASES can pick the keyword arguments it's interested in.
(every (match-lambda
;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2013 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2013, 2015 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
(define %dist-phases
;; Phases for building a source tarball.
- (alist-replace
- 'unpack copy-source
- (alist-cons-before
- 'configure 'autoreconf autoreconf
- (alist-replace
- 'build build
- (alist-replace
- 'install install-dist
- (alist-delete 'strip %standard-phases))))))
+ (modify-phases %standard-phases
+ (delete strip)
+ (replace install install-dist)
+ (replace build build)
+ (add-before configure autoreconf autoreconf)
+ (replace unpack copy-source)))
;;; gnu-dist.scm ends here
;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2013 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2013, 2015 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
(define %standard-phases
;; Everything is as with the GNU Build System except for the `configure',
;; `build', `check', and `install' phases.
- (alist-replace
- 'configure configure
- (alist-replace
- 'build build
- (alist-replace
- 'check check
- (alist-replace
- 'install install
- gnu:%standard-phases)))))
+ (modify-phases gnu:%standard-phases
+ (replace install install)
+ (replace check check)
+ (replace build build)
+ (replace configure configure)))
(define* (perl-build #:key inputs (phases %standard-phases)
#:allow-other-keys #:rest args)
;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2013 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2013, 2015 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2013 Andreas Enge <andreas@enge.fr>
;;; Copyright © 2013 Nikita Karetnikov <nikita@karetnikov.org>
;;;
(define %standard-phases
;; 'configure' and 'build' phases are not needed. Everything is done during
;; 'install'.
- (alist-cons-before
- 'strip 'rename-pth-file
- rename-pth-file
- (alist-cons-after
- 'install 'wrap
- wrap
- (alist-replace
- 'build build
- (alist-replace
- 'check check
- (alist-replace 'install install
- (alist-delete 'configure
- gnu:%standard-phases)))))))
+ (modify-phases gnu:%standard-phases
+ (delete configure)
+ (replace install install)
+ (replace check check)
+ (replace build build)
+ (add-after install wrap wrap)
+ (add-before strip rename-pth-file rename-pth-file)))
(define* (python-build #:key inputs (phases %standard-phases)
#:allow-other-keys #:rest args)
"--bindir" (string-append out "/bin")))))
(define %standard-phases
- (alist-cons-after
- 'unpack 'gitify gitify
- (alist-replace
- 'build build
- (alist-replace
- 'install install
- (alist-replace
- 'check check
- (alist-delete
- 'configure gnu:%standard-phases))))))
+ (modify-phases gnu:%standard-phases
+ (delete configure)
+ (add-after unpack gitify gitify)
+ (replace build build)
+ (replace install install)
+ (replace check check)))
(define* (ruby-build #:key inputs (phases %standard-phases)
#:allow-other-keys #:rest args)
(define-module (guix build utils)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-11)
+ #:use-module (srfi srfi-60)
#:use-module (ice-9 ftw)
#:use-module (ice-9 match)
#:use-module (ice-9 regex)
alist-cons-before
alist-cons-after
alist-replace
+ modify-phases
with-atomic-file-replacement
substitute
substitute*
patch-/usr/bin/file
fold-port-matches
remove-store-references
- wrap-program))
+ wrap-program
+
+ locale-category->string))
;;;
(list file)
'())))))
files))
- input-dirs))
+ (delete-duplicates input-dirs)))
(define (list->search-path-as-string lst separator)
(string-join lst separator))
((_ after ...)
(append before (alist-cons key value after))))))
+(define-syntax-rule (modify-phases phases mod-spec ...)
+ "Modify PHASES sequentially as per each MOD-SPEC, which may have one of the
+following forms:
+
+ (delete <old-phase-name>)
+ (replace <old-phase-name> <new-phase>)
+ (add-before <old-phase-name> <new-phase-name> <new-phase>)
+ (add-after <old-phase-name> <new-phase-name> <new-phase>)
+
+Where every <*-phase-name> is an automatically quoted symbol, and <new-phase>
+an expression evaluating to a procedure."
+ (let* ((phases* phases)
+ (phases* (%modify-phases phases* mod-spec))
+ ...)
+ phases*))
+
+(define-syntax %modify-phases
+ (syntax-rules (delete replace add-before add-after)
+ ((_ phases (delete old-phase-name))
+ (alist-delete 'old-phase-name phases))
+ ((_ phases (replace old-phase-name new-phase))
+ (alist-replace 'old-phase-name new-phase phases))
+ ((_ phases (add-before old-phase-name new-phase-name new-phase))
+ (alist-cons-before 'old-phase-name 'new-phase-name new-phase phases))
+ ((_ phases (add-after old-phase-name new-phase-name new-phase))
+ (alist-cons-after 'old-phase-name 'new-phase-name new-phase phases))))
+
\f
;;;
;;; Text substitution (aka. sed).
(define* (dump-port in out
#:key (buffer-size 16384)
(progress (lambda (t k) (k))))
- "Read as much data as possible from IN and write it to OUT, using
-chunks of BUFFER-SIZE bytes. Call PROGRESS after each successful
-transfer of BUFFER-SIZE bytes or less, passing it the total number of
-bytes transferred and the continuation of the transfer as a thunk."
+ "Read as much data as possible from IN and write it to OUT, using chunks of
+BUFFER-SIZE bytes. Call PROGRESS at the beginning and after each successful
+transfer of BUFFER-SIZE bytes or less, passing it the total number of bytes
+transferred and the continuation of the transfer as a thunk."
(define buffer
(make-bytevector buffer-size))
- (let loop ((total 0)
- (bytes (get-bytevector-n! in buffer 0 buffer-size)))
+ (define (loop total bytes)
(or (eof-object? bytes)
(let ((total (+ total bytes)))
(put-bytevector out buffer 0 bytes)
(progress total
(lambda ()
(loop total
- (get-bytevector-n! in buffer 0 buffer-size))))))))
+ (get-bytevector-n! in buffer 0 buffer-size)))))))
+
+ ;; Make sure PROGRESS is called when we start so that it can measure
+ ;; throughput.
+ (progress 0
+ (lambda ()
+ (loop 0 (get-bytevector-n! in buffer 0 buffer-size)))))
(define (set-file-time file stat)
"Set the atime/mtime of FILE to that specified by STAT."
(stat:atimensec stat)
(stat:mtimensec stat)))
+(define (get-char* p)
+ ;; We call it `get-char', but that's really a binary version
+ ;; thereof. (The real `get-char' cannot be used here because our
+ ;; bootstrap Guile is hacked to always use UTF-8.)
+ (match (get-u8 p)
+ ((? integer? x) (integer->char x))
+ (x x)))
+
(define patch-shebang
(let ((shebang-rx (make-regexp "^[[:blank:]]*([[:graph:]]+)[[:blank:]]*([[:graph:]]*)(.*)$")))
(lambda* (file
(call-with-ascii-input-file file
(lambda (p)
- (and (eq? #\# (read-char p))
- (eq? #\! (read-char p))
+ (and (eq? #\# (get-char* p))
+ (eq? #\! (get-char* p))
(let ((line (false-if-exception (read-line p))))
(and=> (and line (regexp-exec shebang-rx line))
(lambda (m)
shell))
(let ((st (stat file)))
- (substitute* file
- (("^ *SHELL[[:blank:]]*:?=[[:blank:]]*([[:graph:]]*/)([[:graph:]]+)(.*)$"
- _ dir shell args)
- (let* ((old (string-append dir shell))
- (new (or (find-shell shell) old)))
- (unless (string=? new old)
- (format (current-error-port)
- "patch-makefile-SHELL: ~a: changing `SHELL' from `~a' to `~a'~%"
- file old new))
- (string-append "SHELL = " new args))))
+ ;; Consider FILE is using an 8-bit encoding to avoid errors.
+ (with-fluids ((%default-port-encoding #f))
+ (substitute* file
+ (("^ *SHELL[[:blank:]]*:?=[[:blank:]]*([[:graph:]]*/)([[:graph:]]+)(.*)$"
+ _ dir shell args)
+ (let* ((old (string-append dir shell))
+ (new (or (find-shell shell) old)))
+ (unless (string=? new old)
+ (format (current-error-port)
+ "patch-makefile-SHELL: ~a: changing `SHELL' from `~a' to `~a'~%"
+ file old new))
+ (string-append "SHELL = " new args)))))
(when keep-mtime?
(set-file-time file st))))
"patch-/usr/bin/file: warning: \
no replacement 'file' command, doing nothing~%")
(let ((st (stat file)))
- (substitute* file
- (("/usr/bin/file")
- (begin
- (format (current-error-port)
- "patch-/usr/bin/file: ~a: changing `~a' to `~a'~%"
- file "/usr/bin/file" file-command)
- file-command)))
+ ;; Consider FILE is using an 8-bit encoding to avoid errors.
+ (with-fluids ((%default-port-encoding #f))
+ (substitute* file
+ (("/usr/bin/file")
+ (begin
+ (format (current-error-port)
+ "patch-/usr/bin/file: ~a: changing `~a' to `~a'~%"
+ file "/usr/bin/file" file-command)
+ file-command))))
(when keep-mtime?
(set-file-time file st)))))
(map char-set (string->list pattern))
pattern))
- (define (get-char p)
- ;; We call it `get-char', but that's really a binary version
- ;; thereof. (The real `get-char' cannot be used here because our
- ;; bootstrap Guile is hacked to always use UTF-8.)
- (match (get-u8 p)
- ((? integer? x) (integer->char x))
- (x x)))
-
;; Note: we're not really striving for performance here...
(let loop ((chars '())
(pattern initial-pattern)
(matched '())
(result init))
(cond ((null? chars)
- (loop (list (get-char port))
+ (loop (list (get-char* port))
pattern
matched
result))
#!location/of/bin/bash
export PATH=\"/gnu/.../bar/bin\"
export CERT_PATH=\"$CERT_PATH${CERT_PATH:+:}/gnu/.../baz/certs:/qux/certs\"
- exec -a location/of/foo location/of/.foo-real \"$@\"
+ exec -a $0 location/of/.foo-real \"$@\"
This is useful for scripts that expect particular programs to be in $PATH, for
programs that expect particular shared libraries to be in $LD_LIBRARY_PATH, or
(if (zero? number)
(let ((prog-real (string-append (dirname prog) "/."
(basename prog) "-real")))
- (copy-file prog prog-real)
+ (rename-file prog prog-real)
prog-real)
(wrapper-file-name number)))
(with-output-to-file prog-tmp
(lambda ()
(format #t
- "#!~a~%~a~%exec -a \"~a\" \"~a\" \"$@\"~%"
+ "#!~a~%~a~%exec -a \"$0\" \"~a\" \"$@\"~%"
(which "bash")
(string-join (map export-variable vars)
"\n")
- (canonicalize-path prog)
(canonicalize-path target))))
(chmod prog-tmp #o755)
(symlink wrapper prog-tmp)
(rename-file prog-tmp prog)))
+\f
+;;;
+;;; Locales.
+;;;
+
+(define (locale-category->string category)
+ "Return the name of locale category CATEGORY, one of the 'LC_' constants.
+If CATEGORY is a bitwise or of several 'LC_' constants, an approximation is
+returned."
+ (letrec-syntax ((convert (syntax-rules ()
+ ((_)
+ (number->string category))
+ ((_ first rest ...)
+ (if (= first category)
+ (symbol->string 'first)
+ (convert rest ...))))))
+ (convert LC_ADDRESS LC_ALL LC_COLLATE LC_CTYPE
+ LC_IDENTIFICATION LC_MEASUREMENT LC_MESSAGES LC_MONETARY
+ LC_NAME LC_NUMERIC LC_PAPER LC_TELEPHONE
+ LC_TIME)))
+
;;; Local Variables:
;;; eval: (put 'call-with-output-file/atomic 'scheme-indent-function 1)
;;; eval: (put 'call-with-ascii-input-file 'scheme-indent-function 1)
(call-waf "install" params)))
(define %standard-phases
- (alist-replace
- 'configure configure
- (alist-replace
- 'build build
- (alist-replace
- 'check check
- (alist-replace 'install install
- gnu:%standard-phases)))))
+ (modify-phases gnu:%standard-phases
+ (replace configure configure)
+ (replace build build)
+ (replace check check)
+ (replace install install)))
(define* (waf-build #:key inputs (phases %standard-phases)
#:allow-other-keys #:rest args)
(cons name result))
((? gexp? exp)
(append (gexp-outputs exp) result))
+ ((lst ...)
+ (fold-right add-reference-output result lst))
(_
result)))
- (fold-right add-reference-output
- '()
- (gexp-references exp)))
+ (delete-duplicates
+ (add-reference-output (gexp-references exp) '())))
(define* (gexp->sexp exp #:key
(system (%current-system))
("bzip2" ,(ref '(gnu packages compression) 'bzip2))
("gzip" ,(ref '(gnu packages compression) 'gzip))
("lzip" ,(ref '(gnu packages compression) 'lzip))
- ("patch" ,(ref '(gnu packages base) 'patch)))))
+ ("patch" ,(ref '(gnu packages base) 'patch))
+ ("locales" ,(ref '(gnu packages base) 'glibc-utf8-locales)))))
(define (default-guile)
"Return the default Guile package used to run the build code of
(srfi srfi-1)
(guix build utils))
- (let ((out (assoc-ref %outputs "out"))
+ ;; Encoding/decoding errors shouldn't be silent.
+ (fluid-set! %default-port-conversion-strategy 'error)
+
+ (let ((locales (assoc-ref %build-inputs "locales"))
+ (out (assoc-ref %outputs "out"))
(xz (assoc-ref %build-inputs "xz"))
(decomp (assoc-ref %build-inputs ,decompression-type))
(source (assoc-ref %build-inputs "source"))
(lambda (name)
(not (member name '("." "..")))))))
+ (when locales
+ ;; First of all, install a UTF-8 locale so that UTF-8 file names
+ ;; are correctly interpreted. During bootstrap, LOCALES is #f.
+ (setenv "LOCPATH" (string-append locales "/lib/locale"))
+ (setlocale LC_ALL "en_US.UTF-8"))
+
(setenv "PATH" (string-append xz "/bin" ":"
decomp "/bin"))
;; For white-box testing.
(define gexp-inputs (@@ (guix gexp) gexp-inputs))
(define gexp-native-inputs (@@ (guix gexp) gexp-native-inputs))
+(define gexp-outputs (@@ (guix gexp) gexp-outputs))
(define gexp->sexp (@@ (guix gexp) gexp->sexp))
(define* (gexp->sexp* exp #:optional target)
(equal? (gexp->sexp* exp) ;native
(gexp->sexp* exp "mips64el-linux")))))
+(test-equal "output list"
+ 2
+ (let ((exp (gexp (begin (mkdir (ungexp output))
+ (mkdir (ungexp output "bar"))))))
+ (length (gexp-outputs exp)))) ;XXX: <output-ref> is private
+
+(test-assert "output list, combined gexps"
+ (let* ((exp0 (gexp (mkdir (ungexp output))))
+ (exp1 (gexp (mkdir (ungexp output "foo"))))
+ (exp2 (gexp (begin (display "hi!") (ungexp exp0) (ungexp exp1)))))
+ (and (lset= equal?
+ (append (gexp-outputs exp0) (gexp-outputs exp1))
+ (gexp-outputs exp2))
+ (= 2 (length (gexp-outputs exp2))))))
+
+(test-equal "output list, combined gexps, duplicate output"
+ 1
+ (let* ((exp0 (gexp (mkdir (ungexp output))))
+ (exp1 (gexp (begin (mkdir (ungexp output)) (ungexp exp0))))
+ (exp2 (gexp (begin (mkdir (ungexp output)) (ungexp exp1)))))
+ (length (gexp-outputs exp2))))
+
+(test-assert "output list + ungexp-splicing list, combined gexps"
+ (let* ((exp0 (gexp (mkdir (ungexp output))))
+ (exp1 (gexp (mkdir (ungexp output "foo"))))
+ (exp2 (gexp (begin (display "hi!")
+ (ungexp-splicing (list exp0 exp1))))))
+ (and (lset= equal?
+ (append (gexp-outputs exp0) (gexp-outputs exp1))
+ (gexp-outputs exp2))
+ (= 2 (length (gexp-outputs exp2))))))
+
(test-assertm "gexp->file"
(mlet* %store-monad ((exp -> (gexp (display (ungexp %bootstrap-guile))))
(guile (package-file %bootstrap-guile))
HCoop / jackhill / guix / guix.git / commitdiff