Merge branch 'core-updates'.

master
Ludovic Courtès 2015-03-04 14:07:23 +01:00
commit 1289062522
65 changed files with 695 additions and 900 deletions

View File

@ -20,6 +20,7 @@
(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))

View File

@ -401,18 +401,16 @@ dist_patch_DATA = \
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 \

View File

@ -33,6 +33,7 @@
(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"))))

View File

@ -215,6 +215,7 @@ fast arithmetic.")
(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)

View File

@ -363,6 +363,7 @@ synchronous execution of all clients, and low latency operation.")
"https://github.com/jackaudio/jack2/archive/v"
version
".tar.gz"))
(file-name (string-append name "-" version ".tar.gz"))
(sha256
(base32
"03b0iiyk3ng3vh5s8gaqwn565vik7910p56mlbk512bw3dhbdwc8"))))
@ -632,6 +633,7 @@ software.")
(uri (string-append "https://github.com/lvtk/lvtk/archive/"
version
".tar.gz"))
(file-name (string-append name "-" version ".tar.gz"))
(sha256
(base32
"03nbj2cqcklqwh50zj2gwm07crh5iwqbpxbpzwbg5hvgl4k4rnjd"))))
@ -929,13 +931,10 @@ stretching and pitch scaling of audio. This package contains the library.")
("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

View File

@ -2,6 +2,7 @@
;;; 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.
;;;
@ -238,14 +239,14 @@ Makefile, simplifying the entire process for the developer.")
(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)
@ -295,14 +296,14 @@ complexity of working with shared libraries across platforms.")
;; 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)

View File

@ -2,7 +2,7 @@
;;; 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.
@ -75,7 +75,8 @@ command-line arguments, multiple languages, and so on.")
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
@ -150,32 +151,6 @@ standard utility.")
(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"))))
(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
laid out as by the program \"diff\". The changes may be applied to one or more
files depending on the contents of the diff file. It accepts several
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)
@ -184,12 +159,17 @@ differences.")
(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))))
(build-system gnu-build-system)
(native-inputs `(("ed", ed)))
(synopsis "Apply differences to originals, with optional backups")
(description
"Patch is a program that applies changes to files based on differences
laid out as by the program \"diff\". The changes may be applied to one or more
files depending on the contents of the diff file. It accepts several
different diff formats. It may also be used to revert previously applied
differences.")
(license gpl3+)
(home-page "http://savannah.gnu.org/projects/patch/")))
(define-public diffutils
(package
@ -381,14 +361,14 @@ included.")
(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
@ -397,10 +377,7 @@ included.")
(("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
@ -411,6 +388,7 @@ included.")
(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"
@ -433,7 +411,7 @@ included.")
(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"
@ -512,6 +490,13 @@ included.")
(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
@ -536,6 +521,7 @@ with the Linux kernel.")
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))))

View File

@ -43,6 +43,7 @@
(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"))))
@ -100,6 +101,7 @@ computational cluster.")
(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"))))
@ -182,6 +184,7 @@ Python.")
(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"))
@ -378,35 +381,30 @@ Illumina, Roche 454, and the SOLiD platform.")
'()
'("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

View File

@ -1,5 +1,5 @@
;;; 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.
;;;
@ -30,7 +30,7 @@
(define bison
(package
(name "bison")
(version "3.0.2")
(version "3.0.4")
(source
(origin
(method url-fetch)
@ -38,7 +38,7 @@
version ".tar.xz"))
(sha256
(base32
"0g4gjan477lac18m51kv4xzcsp6wjfsfwvd2dxymcl6vid9fihx2"))))
"1qbgf6q1n2z17k8g33444m0q68kf3fbiq65q7jlrzpvvj73jh957"))))
(build-system gnu-build-system)
(native-inputs `(("perl" ,perl)))
(inputs `(("flex" ,flex)))

View File

@ -35,7 +35,7 @@
(define-public cmake
(package
(name "cmake")
(version "2.8.12")
(version "3.1.3")
(source (origin
(method url-fetch)
(uri (string-append
@ -43,7 +43,7 @@
(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
@ -62,6 +62,7 @@
"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"

View File

@ -1,5 +1,5 @@
;;; 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>
@ -616,12 +616,31 @@ store.")
(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
@ -638,7 +657,7 @@ store.")
;; 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
@ -652,15 +671,15 @@ store.")
;; 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
@ -668,7 +687,7 @@ store.")
;; 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)
@ -690,7 +709,8 @@ store.")
("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)

View File

@ -213,7 +213,7 @@ types are supported, as is encryption.")
(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 :
@ -233,10 +233,12 @@ types are supported, as is encryption.")
"/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

View File

@ -309,8 +309,8 @@ operations.")
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

View File

@ -40,28 +40,23 @@
(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
@ -283,8 +278,8 @@ smooth contours with constant curvature at the spline joins.")
("automake" ,automake)
("libtool" ,libtool)))
(arguments
`(#:phases (alist-cons-before
'configure 'bootstrap
`(#:phases (alist-cons-after
'unpack 'bootstrap
(lambda _
(zero? (system* "autoreconf" "-vi")))
%standard-phases)))

View File

@ -1,5 +1,6 @@
;;; 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.
;;;
@ -58,6 +59,7 @@ is used in some video games and movies.")
(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"))))

View File

@ -606,6 +606,7 @@ for common mesh file formats, and collision detection.")
(uri (string-append
"https://github.com/minetest/minetest_game/archive/"
version ".tar.gz"))
(file-name (string-append name "-" version ".tar.gz"))
(sha256
(base32
"0hzb27srv6f2j84dpxx2p0p0aaq9vdp5jvbrfpklb5q5ssdjxvc6"))))
@ -646,6 +647,7 @@ for common mesh file formats, and collision detection.")
(uri (string-append
"https://github.com/minetest/minetest/archive/"
version ".tar.gz"))
(file-name (string-append name "-" version ".tar.gz"))
(sha256
(base32
"0h223svzkvp63b77nqfxy7k8whw4543gahs3kxd3x4myi5ax5z5f"))))
@ -792,6 +794,7 @@ reference interpreter, using Glk API.")
(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)

View File

@ -61,7 +61,8 @@
'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"

View File

@ -51,21 +51,25 @@
'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.

View File

@ -4,6 +4,7 @@
;;; 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.
;;;
@ -1536,3 +1537,49 @@ serialization and deserialization support for the JavaScript Object Notation
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+)))

View File

@ -1,6 +1,6 @@
;;; 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>
;;;
@ -39,7 +39,7 @@
(define-public libgpg-error
(package
(name "libgpg-error")
(version "1.17")
(version "1.18")
(source
(origin
(method url-fetch)
@ -47,7 +47,7 @@
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")
@ -61,14 +61,14 @@ Daemon and possibly more in the future.")
(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)))
@ -162,9 +162,75 @@ as well as the CMS easily accessible by other applications. Both
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.1.2")
(source (origin
(method url-fetch)
(uri (string-append "mirror://gnupg/gnupg/gnupg-" version
".tar.bz2"))
(sha256
(base32
"14k7c5spai3yppz6izf1ggbnffskl54ln87v1wgy9pwism1mlks0"))))
(build-system gnu-build-system)
(inputs
`(("bzip2" ,guix:bzip2)
("curl" ,curl)
("libassuan" ,libassuan)
("libgcrypt" ,libgcrypt)
("libgpg-error" ,libgpg-error)
("libksba" ,libksba)
("npth" ,npth)
("openldap" ,openldap)
("zlib" ,guix:zlib)
("readline" ,readline)))
(arguments
`(#:phases
(alist-cons-before
'configure 'patch-config-files
(lambda _
(substitute* "tests/openpgp/defs.inc"
(("/bin/pwd") (which "pwd"))))
%standard-phases)))
(home-page "http://gnupg.org/")
(synopsis "GNU Privacy Guard")
(description
"The GNU Privacy Guard is a complete implementation of the OpenPGP
standard. It is used to encrypt and sign data and communication. It
features powerful key management and the ability to access public key
servers. It includes several libraries: libassuan (IPC between GnuPG
components), libgpg-error (centralized GnuPG error values), and
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)
@ -173,7 +239,6 @@ specifications are building blocks of S/MIME and TLS.")
(sha256
(base32
"1wihx7dphacg9fy5wfj93h236lr1w5gwzh7ir3js37wi9cz6sr2p"))))
(build-system gnu-build-system)
(inputs
`(("bzip2" ,guix:bzip2)
("curl" ,curl)
@ -192,17 +257,7 @@ specifications are building blocks of S/MIME and TLS.")
(lambda _
(substitute* "tests/openpgp/Makefile.in"
(("/bin/sh") (which "bash"))))
%standard-phases)))
(home-page "http://gnupg.org/")
(synopsis "GNU Privacy Guard")
(description
"The GNU Privacy Guard is a complete implementation of the OpenPGP
standard. It is used to encrypt and sign data and communication. It
features powerful key management and the ability to access public key
servers. It includes several libraries: libassuan (IPC between GnuPG
components), libgpg-error (centralized GnuPG error values), and
libskba (working with X.509 certificates and CMS data).")
(license gpl3+)))
%standard-phases)))))
(define-public gnupg-1
(package (inherit gnupg)
@ -231,7 +286,7 @@ libskba (working with X.509 certificates and CMS data).")
(define-public gpgme
(package
(name "gpgme")
(version "1.5.1")
(version "1.5.3")
(source
(origin
(method url-fetch)
@ -239,7 +294,7 @@ libskba (working with X.509 certificates and CMS data).")
".tar.bz2"))
(sha256
(base32
"1qqi9bxwxxsc4r15j7drclgp0w8jk9nj3h2fsivk4c7brvw3lbvc"))))
"1jgwmra6cf0i5x2prj92w77vl7hmj276qmmll3lwysbyn32l1c0d"))))
(build-system gnu-build-system)
(propagated-inputs
;; Needs to be propagated because gpgme.h includes gpg-error.h.
@ -265,14 +320,14 @@ and every application benefits from this.")
(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
@ -414,14 +469,14 @@ including tools for signing keys, keyring analysis, and party preparation.
(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)

View File

@ -132,14 +132,15 @@ living in the same process.")
;; 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")

View File

@ -105,7 +105,8 @@ tools have full access to view and control running applications.")
`(("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.

View File

@ -247,16 +247,7 @@ many readers as needed).")
(("\"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

View File

@ -385,20 +385,15 @@ supplies a generic doubly-linked list and some string functions.")
"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

View File

@ -1,5 +1,6 @@
;;; 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.
;;;
@ -32,6 +33,7 @@
(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"))))

View File

@ -96,6 +96,7 @@
(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"))))

View File

@ -104,6 +104,15 @@ exec @GUILE@ -c "(load-compiled \"$0.go\") (apply $main (cdr (command-line)))" "
(< 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.
@ -125,7 +134,7 @@ exec @GUILE@ -c "(load-compiled \"$0.go\") (apply $main (cdr (command-line)))" "
(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

View File

@ -1,5 +1,6 @@
;;; 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.
;;;
@ -25,7 +26,7 @@
(define-public libunistring
(package
(name "libunistring")
(version "0.9.4")
(version "0.9.5")
(source (origin
(method url-fetch)
(uri (string-append
@ -33,7 +34,7 @@
version ".tar.gz"))
(sha256
(base32
"19nqvn19hz25ig9dbmh2di5j1r7v852x9mlnq0nr0hka51ins97m"))))
"05va4x47ik006nd13grwm276gfxb8igsj63k37vvwl3q8rr0g30s"))))
(propagated-inputs '()) ; FIXME: add libiconv when !glibc
(build-system gnu-build-system)
(arguments

View File

@ -1005,8 +1005,8 @@ Linux-based operating systems.")
(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)
@ -1851,6 +1851,7 @@ particular the 'perf' command.")
(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"))))

View File

@ -1,6 +1,6 @@
;;; 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>
@ -284,6 +284,7 @@ and corrections. It is based on a Bayesian filter.")
(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"))))
@ -425,6 +426,7 @@ useful features.")
(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)
@ -441,14 +443,11 @@ useful features.")
`(("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")))

View File

@ -223,6 +223,7 @@ be output in text, PostScript, PDF or HTML.")
(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"))))

View File

@ -1,6 +1,7 @@
;;; 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.
;;;
@ -88,13 +89,14 @@ floating-point computations with correct rounding.")
(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

View File

@ -32,6 +32,7 @@
(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"))

View File

@ -1,5 +1,6 @@
;;; 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.
;;;
@ -36,6 +37,7 @@
(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"))))

View File

@ -64,9 +64,16 @@
"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")

View File

@ -156,15 +156,15 @@ the Nix package manager.")
(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))

View File

@ -1,282 +0,0 @@
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))

View File

@ -1,171 +0,0 @@
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,

View File

@ -1,45 +0,0 @@
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)

View File

@ -0,0 +1,17 @@
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;
}
}
}

View File

@ -4,8 +4,8 @@ one in demo.test, and one in destdir.at. Disable these.
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])
@ -15,9 +15,9 @@ Also skip the nopic test on ARM and MIPS systems.
# 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
@ -26,7 +26,7 @@ Also skip the nopic test on ARM and MIPS systems.
# 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
@ -35,19 +35,19 @@ Also skip the nopic test on ARM and MIPS systems.
# 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='`

View File

@ -1,6 +1,6 @@
;;; 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>
@ -2350,12 +2350,6 @@ backend = GTK3Agg~%")))))
(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'")
@ -2444,12 +2438,6 @@ toolkits.")
(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")
@ -2785,6 +2773,7 @@ support for Python 3 and PyPy. It is based on cffi.")
;; 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"))))
@ -3222,13 +3211,7 @@ capabilities to the Python interpreter.")
(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")

View File

@ -120,6 +120,7 @@ Java Lucene text search engine API to C++.")
(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"))))
@ -140,9 +141,9 @@ Java Lucene text search engine API to C++.")
(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

View File

@ -1,7 +1,7 @@
;;; 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.
@ -151,6 +151,7 @@ announcement.")
(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"))))

View File

@ -1,5 +1,5 @@
;;; 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.
@ -54,18 +54,6 @@
;; 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")

View File

@ -34,6 +34,7 @@
(uri (string-append
"https://github.com/muennich/sxiv/archive/v"
version ".tar.gz"))
(file-name (string-append name "-" version ".tar.gz"))
(sha256
(base32
"03hxy5ff7xbs15rhlbpgx8xmvmpjlffp0m4528975hg16sqa2c4s"))))

View File

@ -58,7 +58,11 @@
(("; 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)

View File

@ -1,6 +1,6 @@
;;; 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.
;;;
@ -99,8 +99,8 @@ rejects UDP traffic from the application you're using.")
#: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".

View File

@ -214,6 +214,15 @@ as well as the classic centralized workflow.")
`("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

View File

@ -2,7 +2,7 @@
;;; 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>
;;;
@ -263,18 +263,11 @@ for efficient socket-like bidirectional reliable communication channels.")
("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

View File

@ -65,7 +65,7 @@ things the parser might find in the XML document (like start tags).")
(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)

View File

@ -1,5 +1,5 @@
;;; 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.
;;;
@ -278,6 +278,7 @@ standard packages used as implicit inputs of the GNU build system."
(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)
@ -328,6 +329,7 @@ are allowed to refer to."
#: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?
@ -410,6 +412,7 @@ is one of `host' or `target'."
(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)))
@ -473,6 +476,7 @@ platform."
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?

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, 2015 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2013 Cyril Roelandt <tipecaml@gmail.com>
;;; Copyright © 2014 Andreas Enge <andreas@enge.fr>
;;;
@ -57,6 +57,8 @@
"-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"))
@ -72,9 +74,9 @@
(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)

View File

@ -1,5 +1,5 @@
;;; 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.
@ -26,6 +26,7 @@
#: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)
@ -42,24 +43,66 @@
;;;
;;; 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
@ -92,7 +135,7 @@ abbreviation of URI showing the scheme, host, and basename of the file."
(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))
@ -182,7 +225,7 @@ which is not available during bootstrap."
(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))
@ -334,7 +377,7 @@ Return the resulting target 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))
@ -423,4 +466,8 @@ on success."
file url)
#f))))
;;; Local Variables:
;;; eval: (put 'with-elapsed-time 'scheme-indent-function 1)
;;; End:
;;; download.scm ends here

View File

@ -239,13 +239,10 @@ needed."
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)

View File

@ -94,6 +94,33 @@
#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
@ -108,7 +135,9 @@ working directory."
(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>.
@ -452,7 +481,7 @@ DOCUMENTATION-COMPRESSOR-FLAGS."
;; 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
@ -470,6 +499,9 @@ in order. Return #t if all the PHASES succeeded, #f otherwise."
(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

View File

@ -1,5 +1,5 @@
;;; 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.
;;;
@ -82,14 +82,11 @@
(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

View File

@ -1,5 +1,5 @@
;;; 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.
;;;
@ -71,15 +71,11 @@
(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)

View File

@ -1,5 +1,5 @@
;;; 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>
;;;
@ -122,19 +122,13 @@ installed with setuptools."
(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)

View File

@ -71,16 +71,12 @@ directory."
"--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)

View File

@ -21,6 +21,7 @@
(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)
@ -54,6 +55,7 @@
alist-cons-before
alist-cons-after
alist-replace
modify-phases
with-atomic-file-replacement
substitute
substitute*
@ -64,7 +66,9 @@
patch-/usr/bin/file
fold-port-matches
remove-store-references
wrap-program))
wrap-program
locale-category->string))
;;;
@ -323,7 +327,7 @@ for under the directories designated by FILES. For example:
(list file)
'())))))
files))
input-dirs))
(delete-duplicates input-dirs)))
(define (list->search-path-as-string lst separator)
(string-join lst separator))
@ -423,6 +427,33 @@ An error is raised when no such pair exists."
((_ 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))))
;;;
;;; Text substitution (aka. sed).
@ -557,22 +588,27 @@ match the terminating newline of a line."
(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."
@ -582,6 +618,14 @@ bytes transferred and the continuation of the transfer as a thunk."
(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
@ -617,8 +661,8 @@ FILE are kept unchanged."
(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)
@ -668,16 +712,18 @@ When KEEP-MTIME? is true, the atime/mtime of FILE are kept unchanged."
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))))
@ -694,13 +740,15 @@ unchanged."
"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)))))
@ -717,21 +765,13 @@ for each unmatched character."
(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))
@ -816,7 +856,7 @@ contents:
#!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
@ -837,7 +877,7 @@ the previous wrapper."
(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)))
@ -870,11 +910,10 @@ the previous wrapper."
(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)
@ -882,6 +921,27 @@ the previous wrapper."
(symlink wrapper prog-tmp)
(rename-file prog-tmp prog)))
;;;
;;; 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)

View File

@ -69,14 +69,11 @@
(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)

View File

@ -314,12 +314,13 @@ references."
(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))

View File

@ -335,7 +335,8 @@ corresponds to the arguments expected by `set-path-environment-variable'."
("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
@ -411,7 +412,11 @@ IMPORTED-MODULES specify modules to use/import for use by SNIPPET."
(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"))
@ -433,6 +438,12 @@ IMPORTED-MODULES specify modules to use/import for use by SNIPPET."
(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"))

View File

@ -42,6 +42,7 @@
;; 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)
@ -214,6 +215,38 @@
(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))