me
/
guix
Archived
1
0
Fork 0
Code

Merge branch 'master' into core-updates

master
Mark H Weaver 2015-01-11 09:38:49 -05:00
parent 62c155c0bc 0009ed71ad
commit 7744885731
30 changed files with 2222 additions and 316 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
Makefile.am
View File

@ -174,10 +174,15 @@ SCM_TESTS = \
if HAVE_GUILE_JSON
MODULES += \
guix/import/json.scm \
guix/import/pypi.scm \
guix/scripts/import/pypi.scm
guix/scripts/import/pypi.scm \
guix/import/cpan.scm \
guix/scripts/import/cpan.scm
SCM_TESTS += tests/pypi.scm
SCM_TESTS += \
tests/pypi.scm \
tests/cpan.scm
endif

24
doc/guix.texi
View File

@ -258,10 +258,10 @@ interest primarily for developers and not for casual users.
@item
Installing @uref{http://gnutls.org/, GnuTLS-Guile} will
allow you to access @code{https} URLs with the @command{guix download}
command (@pxref{Invoking guix download}) and the @command{guix import
pypi} command. This is primarily of interest to developers.
@xref{Guile Preparations, how to install the GnuTLS bindings for Guile,,
gnutls-guile, GnuTLS-Guile}.
command (@pxref{Invoking guix download}), the @command{guix import pypi}
command, and the @command{guix import cpan} command. This is primarily
of interest to developers. @xref{Guile Preparations, how to install the
GnuTLS bindings for Guile,, gnutls-guile, GnuTLS-Guile}.
@end itemize
Unless @code{--disable-daemon} was passed to @command{configure}, the
@ -2957,6 +2957,22 @@ package:
guix import pypi itsdangerous
@end example
@item cpan
@cindex CPAN
Import meta-data from @uref{https://www.metacpan.org/, MetaCPAN}.
Information is taken from the JSON-formatted meta-data provided through
@uref{https://api.metacpan.org/, MetaCPAN's API} and includes most
relevant information. License information should be checked closely.
Package dependencies are included but may in some cases needlessly
include core Perl modules.
The command command below imports meta-data for the @code{Acme::Boolean}
Perl module:
@example
guix import cpan Acme::Boolean
@end example
@item nix
Import meta-data from a local copy of the source of the
@uref{http://nixos.org/nixpkgs/, Nixpkgs distribution}@footnote{This

2
gnu-system.am
View File

@ -191,6 +191,7 @@ GNU_SYSTEM_MODULES = \
gnu/packages/ncurses.scm \
gnu/packages/netpbm.scm \
gnu/packages/nettle.scm \
gnu/packages/ninja.scm \
gnu/packages/node.scm \
gnu/packages/noweb.scm \
gnu/packages/ntp.scm \
@ -422,6 +423,7 @@ dist_patch_DATA = \
gnu/packages/patches/mupdf-buildsystem-fix.patch \
gnu/packages/patches/mutt-CVE-2014-9116.patch \
gnu/packages/patches/net-tools-bitrot.patch \
gnu/packages/patches/nss-pkgconfig.patch \
gnu/packages/patches/nvi-assume-preserve-path.patch \
gnu/packages/patches/orpheus-cast-errors-and-includes.patch \
gnu/packages/patches/ots-no-include-missing-file.patch \

168
gnu/packages/gnuzilla.scm
View File

@ -2,6 +2,7 @@
;;; Copyright © 2013 Andreas Enge <andreas@enge.fr>
;;; Copyright © 2013, 2014 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2014 Mark H Weaver <mhw@netris.org>
;;; Copyright © 2015 Sou Bunnbu <iyzsong@gmail.com>
;;;
;;; This file is part of GNU Guix.
;;;
@ -24,6 +25,7 @@
#:use-module (guix packages)
#:use-module (guix download)
#:use-module (guix build-system gnu)
#:use-module (gnu packages databases)
#:use-module (gnu packages glib)
#:use-module (gnu packages gstreamer)
#:use-module (gnu packages gtk)
@ -42,6 +44,172 @@
#:use-module (gnu packages yasm)
#:use-module (gnu packages zip))
(define-public mozjs
(package
(name "mozjs")
(version "17.0.0")
(source (origin
(method url-fetch)
(uri (string-append
"https://ftp.mozilla.org/pub/mozilla.org/js/"
name version ".tar.gz"))
(sha256
(base32
"1fig2wf4f10v43mqx67y68z6h77sy900d1w0pz9qarrqx57rc7ij"))))
(build-system gnu-build-system)
(native-inputs
`(("perl", perl)
("python" ,python-2)))
(arguments
`(#:phases
(alist-cons-before
'configure 'chdir
(lambda _
(chdir "js/src"))
(alist-replace
'configure
;; configure fails if it is followed by SHELL and CONFIG_SHELL
(lambda* (#:key outputs #:allow-other-keys)
(let ((out (assoc-ref outputs "out")))
(setenv "SHELL" (which "sh"))
(setenv "CONFIG_SHELL" (which "sh"))
(zero? (system*
"./configure" (string-append "--prefix=" out)))))
%standard-phases))))
(home-page
"https://developer.mozilla.org/en-US/docs/Mozilla/Projects/SpiderMonkey")
(synopsis "Mozilla javascript engine")
(description "SpiderMonkey is Mozilla's JavaScript engine written
in C/C++.")
(license license:mpl2.0))) ; and others for some files
(define-public nspr
(package
(name "nspr")
(version "4.10.7")
(source (origin
(method url-fetch)
(uri (string-append
"https://ftp.mozilla.org/pub/mozilla.org/nspr/releases/v"
version "/src/nspr-" version ".tar.gz"))
(sha256
(base32
"0f1ri51yzjikigf6z31g03cdv6sgi9gw2c3vvv39psk3m37zb6iq"))))
(build-system gnu-build-system)
(native-inputs
`(("perl", perl)))
(arguments
`(#:tests? #f ; no check target
#:configure-flags
`("--enable-64bit")
#:phases
(alist-cons-before
'configure 'chdir
(lambda _
(chdir "nspr"))
%standard-phases)))
(home-page
"https://developer.mozilla.org/en-US/docs/Mozilla/Projects/NSPR")
(synopsis "Netscape API for system level and libc-like functions")
(description "Netscape Portable Runtime (NSPR) provides a
platform-neutral API for system level and libc-like functions. It is used
in the Mozilla clients.")
(license license:mpl2.0)))
(define-public nss
(package
(name "nss")
(version "3.17.3")
(source (origin
(method url-fetch)
(uri (string-append
"ftp://ftp.mozilla.org/pub/mozilla.org/security/nss/"
"releases/NSS_3_17_3_RTM/src/nss-3.17.3.tar.gz"))
(sha256
(base32
"1m91z80x4zh1mxgf53bl33lp43gn1wxxx0y26mgz511gb81ykmgl"))
;; Create nss.pc and nss-config.
(patches (list (search-patch "nss-pkgconfig.patch")))))
(build-system gnu-build-system)
(outputs '("out" "bin"))
(arguments
'(#:parallel-build? #f ; failed
#:make-flags
(let* ((out (assoc-ref %outputs "out"))
(nspr (string-append (assoc-ref %build-inputs "nspr")))
(rpath (string-append "-Wl,-rpath=" out "/lib/nss")))
(list "-C" "nss" (string-append "PREFIX=" out)
"NSDISTMODE=copy"
"NSS_USE_SYSTEM_SQLITE=1"
(string-append "NSPR_INCLUDE_DIR=" nspr "/include/nspr")
;; Add $out/lib/nss to RPATH.
(string-append "RPATH=" rpath)
(string-append "LDFLAGS=" rpath)))
#:modules ((guix build gnu-build-system)
(guix build utils)
(ice-9 ftw)
(ice-9 match)
(srfi srfi-26))
#:imported-modules ((guix build gnu-build-system)
(guix build utils))
#:phases
(alist-replace
'configure
(lambda* (#:key system inputs #:allow-other-keys)
;; Tells NSS to build for the 64-bit ABI if we are 64-bit system.
(when (string-prefix? "x86_64" system)
(setenv "USE_64" "1"))
#t)
(alist-replace
'check
(lambda _
;; Use 127.0.0.1 instead of $HOST.$DOMSUF as HOSTADDR for testing.
;; The later requires a working DNS or /etc/hosts.
(setenv "DOMSUF" "(none)")
(setenv "USE_IP" "TRUE")
(setenv "IP_ADDRESS" "127.0.0.1")
(zero? (system* "./nss/tests/all.sh")))
(alist-replace
'install
(lambda* (#:key outputs #:allow-other-keys)
(let* ((out (assoc-ref outputs "out"))
(bin (string-append (assoc-ref outputs "bin") "/bin"))
(inc (string-append out "/include/nss"))
(lib (string-append out "/lib/nss"))
(obj (match (scandir "dist" (cut string-suffix? "OBJ" <>))
((obj) (string-append "dist/" obj)))))
;; Install nss-config to $out/bin.
(mkdir-p (string-append out "/bin"))
(copy-file (string-append obj "/bin/nss-config")
(string-append out "/bin/nss-config"))
(delete-file (string-append obj "/bin/nss-config"))
;; Install nss.pc to $out/lib/pkgconfig.
(mkdir-p (string-append out "/lib/pkgconfig"))
(copy-file (string-append obj "/lib/pkgconfig/nss.pc")
(string-append out "/lib/pkgconfig/nss.pc"))
(delete-file (string-append obj "/lib/pkgconfig/nss.pc"))
(rmdir (string-append obj "/lib/pkgconfig"))
;; Install other files.
(copy-recursively "dist/public/nss" inc)
(copy-recursively (string-append obj "/bin") bin)
(copy-recursively (string-append obj "/lib") lib)))
%standard-phases)))))
(inputs
`(("sqlite" ,sqlite)
("zlib" ,zlib)))
(propagated-inputs `(("nspr" ,nspr))) ; required by nss.pc.
(native-inputs `(("perl" ,perl)))
(home-page
"https://developer.mozilla.org/en-US/docs/Mozilla/Projects/NSS")
(synopsis "Network Security Services")
(description
"Network Security Services (NSS) is a set of libraries designed to support
cross-platform development of security-enabled client and server applications.
Applications built with NSS can support SSL v2 and v3, TLS, PKCS #5, PKCS #7,
PKCS #11, PKCS #12, S/MIME, X.509 v3 certificates, and other security
standards.")
(license license:mpl2.0)))
(define-public icecat
(package
(name "icecat")

25
gnu/packages/image.scm
View File

@ -2,6 +2,7 @@
;;; Copyright © 2013 Andreas Enge <andreas@enge.fr>
;;; Copyright © 2014 Mark H Weaver <mhw@netris.org>
;;; Copyright © 2014 Alex Kost <alezost@gmail.com>
;;; Copyright © 2014 Ricardo Wurmus <rekado@elephly.net>
;;;
;;; This file is part of GNU Guix.
;;;
@ -187,16 +188,15 @@ work.")
(define-public openjpeg
(package
(name "openjpeg")
(version "2.0.0")
(version "2.0.1")
(source
(origin
(method url-fetch)
(uri
(string-append "http://openjpeg.googlecode.com/files/" name "-"
version ".tar.gz"))
(string-append "mirror://sourceforge/openjpeg.mirror/" name "-"
version ".tar.gz"))
(sha256
(base32 "1n05yrmscpgksrh2kfh12h18l0lw9j03mgmvwcg3hm8m0lwgak9k"))))
(base32 "1c2xc3nl2mg511b63rk7hrckmy14681p1m44mzw3n1fyqnjm0b0z"))))
(build-system cmake-build-system)
(arguments
;; Trying to run `$ make check' results in a no rule fault.
@ -217,9 +217,22 @@ In addition to the basic codec, various other features are under
development, among them the JP2 and MJ2 (Motion JPEG 2000) file formats,
an indexing tool useful for the JPIP protocol, JPWL-tools for
error-resilience, a Java-viewer for j2k-images, ...")
(home-page "http://jbig2dec.sourceforge.net/")
(home-page "https://code.google.com/p/openjpeg/")
(license license:bsd-2)))
(define-public openjpeg-1
(package (inherit openjpeg)
(name "openjpeg")
(version "1.5.2")
(source
(origin
(method url-fetch)
(uri
(string-append "mirror://sourceforge/openjpeg.mirror/" name "-"
version ".tar.gz"))
(sha256
(base32 "11waq9w215zvzxrpv40afyd18qf79mxc28fda80bm3ax98cpppqm"))))))
(define-public giflib
(package
(name "giflib")

4
gnu/packages/linux.scm
View File

@ -192,7 +192,7 @@ for SYSTEM, or #f if there is no configuration for SYSTEM."
#f)))
(define-public linux-libre
(let* ((version "3.18.1")
(let* ((version "3.18.2")
(build-phase
'(lambda* (#:key system inputs #:allow-other-keys #:rest args)
;; Apply the neat patch.
@ -265,7 +265,7 @@ for SYSTEM, or #f if there is no configuration for SYSTEM."
(uri (linux-libre-urls version))
(sha256
(base32
"0yj6sz9cvsbhrc9jksr4wgg63crzmqh65903l7bq9k0gz1f3x1s8"))))
"0wji58x0zci13a499v6kbz3pyhs2gk6wsbv3fia8valxgbcppyhp"))))
(build-system gnu-build-system)
(native-inputs `(("perl" ,perl)
("bc" ,bc)

87
gnu/packages/ninja.scm 100644
View File

@ -0,0 +1,87 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2015 Sou Bunnbu <iyzsong@gmail.com>
;;;
;;; This file is part of GNU Guix.
;;;
;;; GNU Guix is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version.
;;;
;;; GNU Guix is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (gnu packages ninja)
#:use-module ((guix licenses) #:select (asl2.0))
#:use-module (guix packages)
#:use-module (guix download)
#:use-module (guix build-system gnu)
#:use-module (gnu packages)
#:use-module (gnu packages python))
(define-public ninja
(package
(name "ninja")
(version "1.5.3")
(source (origin
(method url-fetch)
(uri (string-append "https://github.com/martine/ninja/"
"archive/v" version ".tar.gz"))
(sha256
(base32
"1h3yfwcfl61v493vna6jia2fizh8rpig7qw2504cvkr6gid3p5bw"))))
(build-system gnu-build-system)
(arguments
'(#:phases
(alist-replace
'configure
(lambda _
(substitute* "src/subprocess-posix.cc"
(("/bin/sh") (which "sh"))))
(alist-replace
'build
(lambda _
(zero? (system* "./configure.py" "--bootstrap")))
(alist-replace
'check
(lambda _
(and (zero? (system* "./configure.py"))
(zero? (system* "./ninja" "ninja_test"))
;; SubprocessTest.SetWithLots fails with:
;; Raise [ulimit -n] well above 1025 to make this test go.
;; Skip it.
;;
;; SubprocessTest.InterruptChild fails when using 'system*':
;; *** Failure in src/subprocess_test.cc:83
;; ExitInterrupted == subproc->Finish()
;; Pass it by using 'system' instead of 'system*'.
(zero? (system (string-append
"./ninja_test "
"--gtest_filter="
"-SubprocessTest.SetWithLots")))))
(alist-replace
'install
(lambda* (#:key outputs #:allow-other-keys)
(let* ((out (assoc-ref outputs "out"))
(bin (string-append out "/bin"))
(doc (string-append out "/share/doc/ninja")))
(mkdir-p bin)
(copy-file "ninja" (string-append bin "/ninja"))
(mkdir-p doc)
(copy-file "doc/manual.asciidoc"
(string-append doc "/manual.asciidoc"))))
%standard-phases))))))
(native-inputs `(("python" ,python-2)))
(home-page "http://martine.github.io/ninja/")
(synopsis "Small build system")
(description
"Ninja is a small build system with a focus on speed. It differs from
other build systems in two major respects: it is designed to have its input
files generated by a higher-level build system, and it is designed to run
builds as fast as possible.")
(license asl2.0)))

225
gnu/packages/patches/nss-pkgconfig.patch 100644
View File

@ -0,0 +1,225 @@
Description: Create nss.pc and nss-config
Author: Lars Wendler <polynomial-c@gentoo.org>
Source: http://sources.gentoo.org/cgi-bin/viewvc.cgi/gentoo-x86/dev-libs/nss/files/nss-3.17.1-gentoo-fixups.patch
Modifications:
Change libdir from ${prefix}/lib64 to ${prefix}/lib/nss.
Remove optional patching in nss/Makefile.
--- nss-3.17.1/nss/config/Makefile
+++ nss-3.17.1/nss/config/Makefile
@@ -0,0 +1,40 @@
+CORE_DEPTH = ..
+DEPTH = ..
+
+include $(CORE_DEPTH)/coreconf/config.mk
+
+NSS_MAJOR_VERSION = `grep "NSS_VMAJOR" ../lib/nss/nss.h | awk '{print $$3}'`
+NSS_MINOR_VERSION = `grep "NSS_VMINOR" ../lib/nss/nss.h | awk '{print $$3}'`
+NSS_PATCH_VERSION = `grep "NSS_VPATCH" ../lib/nss/nss.h | awk '{print $$3}'`
+PREFIX = /usr
+
+all: export libs
+
+export:
+ # Create the nss.pc file
+ mkdir -p $(DIST)/lib/pkgconfig
+ sed -e "s,@prefix@,$(PREFIX)," \
+ -e "s,@exec_prefix@,\$${prefix}," \
+ -e "s,@libdir@,\$${prefix}/lib/nss," \
+ -e "s,@includedir@,\$${prefix}/include/nss," \
+ -e "s,@NSS_MAJOR_VERSION@,$(NSS_MAJOR_VERSION),g" \
+ -e "s,@NSS_MINOR_VERSION@,$(NSS_MINOR_VERSION)," \
+ -e "s,@NSS_PATCH_VERSION@,$(NSS_PATCH_VERSION)," \
+ nss.pc.in > nss.pc
+ chmod 0644 nss.pc
+ cp nss.pc $(DIST)/lib/pkgconfig
+
+ # Create the nss-config script
+ mkdir -p $(DIST)/bin
+ sed -e "s,@prefix@,$(PREFIX)," \
+ -e "s,@NSS_MAJOR_VERSION@,$(NSS_MAJOR_VERSION)," \
+ -e "s,@NSS_MINOR_VERSION@,$(NSS_MINOR_VERSION)," \
+ -e "s,@NSS_PATCH_VERSION@,$(NSS_PATCH_VERSION)," \
+ nss-config.in > nss-config
+ chmod 0755 nss-config
+ cp nss-config $(DIST)/bin
+
+libs:
+
+dummy: all export libs
+
--- nss-3.17.1/nss/config/nss-config.in
+++ nss-3.17.1/nss/config/nss-config.in
@@ -0,0 +1,145 @@
+#!/bin/sh
+
+prefix=@prefix@
+
+major_version=@NSS_MAJOR_VERSION@
+minor_version=@NSS_MINOR_VERSION@
+patch_version=@NSS_PATCH_VERSION@
+
+usage()
+{
+ cat <<EOF
+Usage: nss-config [OPTIONS] [LIBRARIES]
+Options:
+ [--prefix[=DIR]]
+ [--exec-prefix[=DIR]]
+ [--includedir[=DIR]]
+ [--libdir[=DIR]]
+ [--version]
+ [--libs]
+ [--cflags]
+Dynamic Libraries:
+ nss
+ ssl
+ smime
+ nssutil
+EOF
+ exit $1
+}
+
+if test $# -eq 0; then
+ usage 1 1>&2
+fi
+
+lib_ssl=yes
+lib_smime=yes
+lib_nss=yes
+lib_nssutil=yes
+
+while test $# -gt 0; do
+ case "$1" in
+ -*=*) optarg=`echo "$1" | sed 's/[-_a-zA-Z0-9]*=//'` ;;
+ *) optarg= ;;
+ esac
+
+ case $1 in
+ --prefix=*)
+ prefix=$optarg
+ ;;
+ --prefix)
+ echo_prefix=yes
+ ;;
+ --exec-prefix=*)
+ exec_prefix=$optarg
+ ;;
+ --exec-prefix)
+ echo_exec_prefix=yes
+ ;;
+ --includedir=*)
+ includedir=$optarg
+ ;;
+ --includedir)
+ echo_includedir=yes
+ ;;
+ --libdir=*)
+ libdir=$optarg
+ ;;
+ --libdir)
+ echo_libdir=yes
+ ;;
+ --version)
+ echo ${major_version}.${minor_version}.${patch_version}
+ ;;
+ --cflags)
+ echo_cflags=yes
+ ;;
+ --libs)
+ echo_libs=yes
+ ;;
+ ssl)
+ lib_ssl=yes
+ ;;
+ smime)
+ lib_smime=yes
+ ;;
+ nss)
+ lib_nss=yes
+ ;;
+ nssutil)
+ lib_nssutil=yes
+ ;;
+ *)
+ usage 1 1>&2
+ ;;
+ esac
+ shift
+done
+
+# Set variables that may be dependent upon other variables
+if test -z "$exec_prefix"; then
+ exec_prefix=`pkg-config --variable=exec_prefix nss`
+fi
+if test -z "$includedir"; then
+ includedir=`pkg-config --variable=includedir nss`
+fi
+if test -z "$libdir"; then
+ libdir=`pkg-config --variable=libdir nss`
+fi
+
+if test "$echo_prefix" = "yes"; then
+ echo $prefix
+fi
+
+if test "$echo_exec_prefix" = "yes"; then
+ echo $exec_prefix
+fi
+
+if test "$echo_includedir" = "yes"; then
+ echo $includedir
+fi
+
+if test "$echo_libdir" = "yes"; then
+ echo $libdir
+fi
+
+if test "$echo_cflags" = "yes"; then
+ echo -I$includedir
+fi
+
+if test "$echo_libs" = "yes"; then
+ libdirs=""
+ if test -n "$lib_ssl"; then
+ libdirs="$libdirs -lssl${major_version}"
+ fi
+ if test -n "$lib_smime"; then
+ libdirs="$libdirs -lsmime${major_version}"
+ fi
+ if test -n "$lib_nss"; then
+ libdirs="$libdirs -lnss${major_version}"
+ fi
+ if test -n "$lib_nssutil"; then
+ libdirs="$libdirs -lnssutil${major_version}"
+ fi
+ echo $libdirs
+fi
+
--- nss-3.17.1/nss/config/nss.pc.in
+++ nss-3.17.1/nss/config/nss.pc.in
@@ -0,0 +1,12 @@
+prefix=@prefix@
+exec_prefix=@exec_prefix@
+libdir=@libdir@
+includedir=@includedir@
+
+Name: NSS
+Description: Network Security Services
+Version: @NSS_MAJOR_VERSION@.@NSS_MINOR_VERSION@.@NSS_PATCH_VERSION@
+Requires: nspr >= 4.8
+Libs: -L${libdir} -lssl3 -lsmime3 -lnss3 -lnssutil3
+Cflags: -I${includedir}
+
--- nss-3.17.1/nss/manifest.mn
+++ nss-3.17.1/nss/manifest.mn
@@ -10,7 +10,7 @@
RELEASE = nss
-DIRS = coreconf lib cmd
+DIRS = coreconf lib cmd config
ifdef NSS_BUILD_GTESTS
DIRS += external_tests

18
gnu/packages/pdf.scm
View File

@ -1,6 +1,7 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2013 Andreas Enge <andreas@enge.fr>
;;; Copyright © 2014 Mark H Weaver <mhw@netris.org>
;;; Copyright © 2014 Ricardo Wurmus <rekado@elephly.net>
;;;
;;; This file is part of GNU Guix.
;;;
@ -55,12 +56,13 @@
;; introspection: no
;; use gtk-doc: no
;; use libcurl: no
;; use libopenjpeg: no
(inputs `(("fontconfig" ,fontconfig)
("freetype" ,freetype)
("libjpeg-8" ,libjpeg-8)
("libpng" ,libpng)
("libtiff" ,libtiff)
("lcms" ,lcms)
("openjpeg-1" ,openjpeg-1)
("zlib" ,zlib)
;; To build poppler-glib (as needed by Evince), we need Cairo and
@ -75,8 +77,18 @@
(arguments
`(#:tests? #f ; no test data provided with the tarball
#:configure-flags
'("--enable-xpdf-headers" ; to install header files
"--enable-zlib")))
'("--enable-libopenjpeg"
"--enable-xpdf-headers" ; to install header files
"--enable-zlib")
#:phases
(alist-cons-before
'configure 'setenv
(lambda _
(setenv "CPATH"
(string-append (assoc-ref %build-inputs "openjpeg-1")
"/include/openjpeg-1.5"
":" (or (getenv "CPATH") ""))))
%standard-phases)))
(synopsis "PDF rendering library")
(description
"Poppler is a PDF rendering library based on the xpdf-3.0 code base.")

75
gnu/packages/polkit.scm
View File

@ -17,13 +17,14 @@
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (gnu packages polkit)
#:use-module ((guix licenses) #:select (lgpl2.0+ mpl2.0))
#:use-module ((guix licenses) #:select (lgpl2.0+))
#:use-module (guix packages)
#:use-module (guix download)
#:use-module (guix build-system cmake)
#:use-module (guix build-system gnu)
#:use-module (gnu packages)
#:use-module (gnu packages glib)
#:use-module (gnu packages gnuzilla)
#:use-module (gnu packages linux)
#:use-module (gnu packages perl)
#:use-module (gnu packages pkg-config)
@ -31,78 +32,6 @@
#:use-module (gnu packages qt)
#:use-module (gnu packages xml))
(define-public mozjs
(package
(name "mozjs")
(version "17.0.0")
(source (origin
(method url-fetch)
(uri (string-append
"https://ftp.mozilla.org/pub/mozilla.org/js/"
name version ".tar.gz"))
(sha256
(base32
"1fig2wf4f10v43mqx67y68z6h77sy900d1w0pz9qarrqx57rc7ij"))))
(build-system gnu-build-system)
(native-inputs
`(("perl", perl)
("python" ,python-2)))
(arguments
`(#:phases
(alist-cons-before
'configure 'chdir
(lambda _
(chdir "js/src"))
(alist-replace
'configure
;; configure fails if it is followed by SHELL and CONFIG_SHELL
(lambda* (#:key outputs #:allow-other-keys)
(let ((out (assoc-ref outputs "out")))
(setenv "SHELL" (which "sh"))
(setenv "CONFIG_SHELL" (which "sh"))
(zero? (system*
"./configure" (string-append "--prefix=" out)))))
%standard-phases))))
(home-page
"https://developer.mozilla.org/en-US/docs/Mozilla/Projects/SpiderMonkey")
(synopsis "Mozilla javascript engine")
(description "SpiderMonkey is Mozilla's JavaScript engine written
in C/C++.")
(license mpl2.0))) ; and others for some files
(define-public nspr
(package
(name "nspr")
(version "4.10.7")
(source (origin
(method url-fetch)
(uri (string-append
"https://ftp.mozilla.org/pub/mozilla.org/nspr/releases/v"
version "/src/nspr-" version ".tar.gz"))
(sha256
(base32
"0f1ri51yzjikigf6z31g03cdv6sgi9gw2c3vvv39psk3m37zb6iq"))))
(build-system gnu-build-system)
(native-inputs
`(("perl", perl)))
(arguments
`(#:tests? #f ; no check target
#:configure-flags
`("--enable-64bit")
#:phases
(alist-cons-before
'configure 'chdir
(lambda _
(chdir "nspr"))
%standard-phases)))
(home-page
"https://developer.mozilla.org/en-US/docs/Mozilla/Projects/NSPR")
(synopsis "Netscape API for system level and libc-like functions")
(description "Netscape Portable Runtime (NSPR) provides a
platform-neutral API for system level and libc-like functions. It is used
in the Mozilla clients.")
(license mpl2.0)))
(define-public polkit
(package
(name "polkit")

63
gnu/packages/qt.scm
View File

@ -1,5 +1,6 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2013, 2014 Andreas Enge <andreas@enge.fr>
;;; Copyright © 2015 Sou Bunnbu <iyzsong@gmail.com>
;;;
;;; This file is part of GNU Guix.
;;;
@ -26,19 +27,27 @@
#:use-module (gnu packages bison)
#:use-module (gnu packages compression)
#:use-module (gnu packages fontutils)
#:use-module (gnu packages flex)
#:use-module (gnu packages gl)
#:use-module (gnu packages glib)
#:use-module (gnu packages gnuzilla)
#:use-module (gnu packages gperf)
#:use-module (gnu packages icu4c)
#:use-module (gnu packages image)
#:use-module (gnu packages linux)
#:use-module (gnu packages databases)
#:use-module (gnu packages ninja)
#:use-module (gnu packages openssl)
#:use-module (gnu packages pciutils)
#:use-module (gnu packages pcre)
#:use-module (gnu packages perl)
#:use-module (gnu packages pkg-config)
#:use-module (gnu packages pulseaudio)
#:use-module (gnu packages python)
#:use-module (gnu packages ruby)
#:use-module (gnu packages xorg))
#:use-module (gnu packages xdisorg)
#:use-module (gnu packages xorg)
#:use-module (gnu packages xml))
(define-public libxkbcommon
(package
@ -81,7 +90,7 @@ X11 (yet).")
(define-public qt
(package
(name "qt")
(version "5.3.2")
(version "5.4.0")
(source (origin
(method url-fetch)
(uri (string-append "http://download.qt-project.org/official_releases/qt/"
@ -91,28 +100,48 @@ X11 (yet).")
version ".tar.xz"))
(sha256
(base32
"1w4v53889kqpwxw45wcqz5bi6zx8xp434jpafk1vlmyb8hrzjnvz"))))
"176351k8ngczb324i8bbkrsz9pby7cvy2qnixfjwybzxp53xzndj"))
(snippet
'(begin
;; Remove broken symlinks.
(delete-file "qtwebengine/src/3rdparty/chromium/third_party/\
mesa/src/src/gallium/state_trackers/d3d1x/w32api")
(delete-file "qtwebengine/src/3rdparty/chromium/third_party/\
webrtc/tools/e2e_quality/audio/perf")))))
(build-system gnu-build-system)
(propagated-inputs
`(("mesa" ,mesa)))
(inputs
`(("alsa-lib" ,alsa-lib)
("dbus" ,dbus)
("expat" ,expat)
("fontconfig" ,fontconfig)
("freetype" ,freetype)
("glib" ,glib)
("icu4c" ,icu4c)
("libjpeg" ,libjpeg)
("libpci" ,pciutils)
("libpng" ,libpng)
("libx11" ,libx11)
("libxcomposite" ,libxcomposite)
("libxcursor" ,libxcursor)
("libxfixes" ,libxfixes)
("libxi" ,libxi)
("libxinerama" ,libxinerama)
("libxkbcommon" ,libxkbcommon)
("libxml2" ,libxml2)
("libxrandr" ,libxrandr)
("libxrender" ,libxrender)
("libxslt" ,libxslt)
("libxtst" ,libxtst)
("mtdev" ,mtdev)
("mysql" ,mysql)
("nss" ,nss)
("openssl" ,openssl)
("pulseaudio" ,pulseaudio)
("python-wrapper" ,python-wrapper)
("ruby" ,ruby)
("pcre" ,pcre)
("sqlite" ,sqlite)
("udev" ,eudev)
("xcb-util" ,xcb-util)
("xcb-util-image" ,xcb-util-image)
("xcb-util-keysyms" ,xcb-util-keysyms)
@ -120,8 +149,15 @@ X11 (yet).")
("xcb-util-wm" ,xcb-util-wm)
("zlib" ,zlib)))
(native-inputs
`(("perl" ,perl)
("pkg-config" ,pkg-config)))
`(("bison" ,bison)
("flex" ,flex)
("gperf" ,gperf)
("ninja" ,ninja)
("perl" ,perl)
("pkg-config" ,pkg-config)
("python" ,python-2)
("ruby" ,ruby)
("which" ,(@ (gnu packages which) which))))
(arguments
`(#:phases
(alist-replace
@ -129,7 +165,15 @@ X11 (yet).")
(lambda* (#:key outputs #:allow-other-keys)
(let ((out (assoc-ref outputs "out")))
(substitute* '("configure" "qtbase/configure")
(("/bin/pwd") (which "pwd")))
(("/bin/pwd") (which "pwd")))
(substitute* "qtbase/src/corelib/global/global.pri"
(("/bin/ls") (which "ls")))
(substitute* "qtwebengine/src/3rdparty/chromium/build/common.gypi"
(("/bin/echo") (which "echo")))
(substitute* "qtwebengine/src/3rdparty/chromium/third_party/\
WebKit/Source/build/scripts/scripts.gypi"
(("/usr/bin/gcc") (which "gcc")))
(setenv "NINJA_PATH" (which "ninja"))
;; do not pass "--enable-fast-install", which makes the
;; configure process fail
(zero? (system*
@ -138,6 +182,9 @@ X11 (yet).")
"-prefix" out
"-opensource"
"-confirm-license"
"-system-sqlite"
;; explicitly link with openssl instead of dlopening it
"-openssl-linked"
;; explicitly link with dbus instead of dlopening it
"-dbus-linked"
;; drop special machine instructions not supported

22
guix/base64.scm
View File

@ -4,6 +4,8 @@
;; (guix base64) by Nikita Karetnikov <nikita@karetnikov.org> on
;; February 12, 2014.
;;
;; Some optimizations made by Ludovic Courtès <ludo@gnu.org>, 2015.
;;
;; Copyright © 2009, 2010 Göran Weinholt <goran@weinholt.se>
;;
;; This program is free software: you can redistribute it and/or modify
@ -33,7 +35,23 @@
(only (srfi :13 strings)
string-index
string-prefix? string-suffix?
string-concatenate string-trim-both))
string-concatenate string-trim-both)
(only (guile) ash logior))
(define-syntax define-alias
(syntax-rules ()
((_ new old)
(define-syntax new (identifier-syntax old)))))
;; Force the use of Guile's own primitives to avoid the overhead of its 'fx'
;; procedures.
(define-alias fxbit-field bitwise-bit-field)
(define-alias fxarithmetic-shift ash)
(define-alias fxarithmetic-shift-left ash)
(define-alias fxand logand)
(define-alias fxior logior)
(define-alias fxxor logxor)
(define base64-alphabet
"ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/")
@ -209,4 +227,4 @@
line-length #f base64-alphabet port)
(display (string-append "\n-----END " type "-----\n") port))
((port type bv)
(put-delimited-base64 port type bv 76)))))
(put-delimited-base64 port type bv 76)))))

77
guix/derivations.scm
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.
;;;
@ -58,9 +58,11 @@
derivation-input-output-paths
derivation-name
derivation-output-names
fixed-output-derivation?
offloadable-derivation?
substitutable-derivation?
substitution-oracle
derivation-hash
read-derivation
@ -135,6 +137,12 @@
(let ((base (store-path-package-name (derivation-file-name drv))))
(string-drop-right base 4)))
(define (derivation-output-names drv)
"Return the names of the outputs of DRV."
(match (derivation-outputs drv)
(((names . _) ...)
names)))
(define (fixed-output-derivation? drv)
"Return #t if DRV is a fixed-output derivation, such as the result of a
download with a fixed hash (aka. `fetchurl')."
@ -177,41 +185,52 @@ download with a fixed hash (aka. `fetchurl')."
;; synonymous, see <http://bugs.gnu.org/18747>.
offloadable-derivation?)
(define (derivation-output-paths drv sub-drvs)
"Return the output paths of outputs SUB-DRVS of DRV."
(match drv
(($ <derivation> outputs)
(map (lambda (sub-drv)
(derivation-output-path (assoc-ref outputs sub-drv)))
sub-drvs))))
(define* (substitution-oracle store drv)
"Return a one-argument procedure that, when passed a store file name,
returns #t if it's substitutable and #f otherwise. The returned procedure
knows about all substitutes for all the derivations listed in DRV and their
prerequisites.
Creating a single oracle (thus making a single 'substitutable-paths' call) and
reusing it is much more efficient than calling 'has-substitutes?' or similar
repeatedly, because it avoids the costs associated with launching the
substituter many times."
(let* ((paths (delete-duplicates
(fold (lambda (drv result)
(let ((self (match (derivation->output-paths drv)
(((names . paths) ...)
paths)))
(deps (append-map derivation-input-output-paths
(derivation-prerequisites
drv))))
(append self deps result)))
'()
drv)))
(subst (substitutable-paths store paths)))
(cut member <> subst)))
(define* (derivation-prerequisites-to-build store drv
#:key
(outputs
(map
car
(derivation-outputs drv)))
(use-substitutes? #t))
(derivation-output-names drv))
(substitutable?
(substitution-oracle store
(list drv))))
"Return two values: the list of derivation-inputs required to build the
OUTPUTS of DRV and not already available in STORE, recursively, and the list
of required store paths that can be substituted. When USE-SUBSTITUTES? is #f,
that second value is the empty list."
(define (derivation-output-paths drv sub-drvs)
(match drv
(($ <derivation> outputs)
(map (lambda (sub-drv)
(derivation-output-path (assoc-ref outputs sub-drv)))
sub-drvs))))
of required store paths that can be substituted. SUBSTITUTABLE? must be a
one-argument procedure similar to that returned by 'substitution-oracle'."
(define built?
(cut valid-path? store <>))
(define substitutable?
;; Return true if the given path is substitutable. Call
;; `substitutable-paths' upfront, to benefit from parallelism in the
;; substituter.
(if use-substitutes?
(let ((s (substitutable-paths store
(append
(derivation-output-paths drv outputs)
(append-map
derivation-input-output-paths
(derivation-prerequisites drv))))))
(cut member <> s))
(const #f)))
(define input-built?
(compose (cut any built? <>) derivation-input-output-paths))
@ -844,7 +863,7 @@ recursively."
replacements))))
(derivation-builder-environment-vars drv))
#:inputs (append (map list sources) inputs)
#:outputs (map car (derivation-outputs drv))
#:outputs (derivation-output-names drv)
#:hash (match (derivation-outputs drv)
((($ <derivation-output> _ algo hash))
hash)

5
guix/hash.scm
View File

@ -26,6 +26,7 @@
#:export (sha256
open-sha256-port
port-sha256
file-sha256
open-sha256-input-port))
;;; Commentary:
@ -129,6 +130,10 @@ output port."
(close-port out)
(get)))
(define (file-sha256 file)
"Return the SHA256 hash (a bytevector) of FILE."
(call-with-input-file file port-sha256))
(define (open-sha256-input-port port)
"Return an input port that wraps PORT and a thunk to get the hash of all the
data read from PORT. The thunk always returns the same value."

167
guix/import/cpan.scm 100644
View File

@ -0,0 +1,167 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2014 Eric Bavier <bavier@member.fsf.org>
;;;
;;; This file is part of GNU Guix.
;;;
;;; GNU Guix is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version.
;;;
;;; GNU Guix is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (guix import cpan)
#:use-module (ice-9 match)
#:use-module (ice-9 regex)
#:use-module (srfi srfi-1)
#:use-module (json)
#:use-module (guix hash)
#:use-module (guix store)
#:use-module (guix base32)
#:use-module ((guix download) #:select (download-to-store))
#:use-module (guix import utils)
#:use-module (guix import json)
#:export (cpan->guix-package))
;;; Commentary:
;;;
;;; Generate a package declaration template for the latest version of a CPAN
;;; module, using meta-data from metacpan.org.
;;;
;;; Code:
(define string->license
(match-lambda
;; List of valid values from https://metacpan.org/pod/CPAN::Meta::Spec.
;; Some licenses are excluded based on their absense from (guix licenses).
("agpl_3" 'agpl3)
;; apache_1_1
("apache_2_0" 'asl2.0)
;; artistic_1_0
;; artistic_2_0
("bsd" 'bsd-3)
("freebsd" 'bsd-2)
;; gfdl_1_2
("gfdl_1_3" 'fdl1.3+)
("gpl_1" 'gpl1)
("gpl_2" 'gpl2)
("gpl_3" 'gpl3)
("lgpl_2_1" 'lgpl2.1)
("lgpl_3_0" 'lgpl3)
("mit" 'x11)
;; mozilla_1_0
("mozilla_1_1" 'mpl1.1)
("openssl" 'openssl)
("perl_5" 'gpl1+) ;and Artistic 1
("qpl_1_0" 'qpl)
;; ssleay
;; sun
("zlib" 'zlib)
((x) (string->license x))
((lst ...) `(list ,@(map string->license lst)))
(_ #f)))
(define (module->name module)
"Transform a 'module' name into a 'release' name"
(regexp-substitute/global #f "::" module 'pre "-" 'post))
(define (cpan-fetch module)
"Return an alist representation of the CPAN metadata for the perl module MODULE,
or #f on failure. MODULE should be e.g. \"Test::Script\""
;; This API always returns the latest release of the module.
(json-fetch (string-append "http://api.metacpan.org/release/"
;; XXX: The 'release' api requires the "release"
;; name of the package. This substitution seems
;; reasonably consistent across packages.
(module->name module))))
(define (cpan-home name)
(string-append "http://search.cpan.org/dist/" name))
(define (cpan-module->sexp meta)
"Return the `package' s-expression for a CPAN module from the metadata in
META."
(define name
(assoc-ref meta "distribution"))
(define (guix-name name)
(if (string-prefix? "perl-" name)
(string-downcase name)
(string-append "perl-" (string-downcase name))))
(define version
(assoc-ref meta "version"))
(define (convert-inputs phases)
;; Convert phase dependencies into a list of name/variable pairs.
(match (flatten
(map (lambda (ph)
(filter-map (lambda (t)
(assoc-ref* meta "metadata" "prereqs" ph t))
'("requires" "recommends" "suggests")))
phases))
(#f
'())
((inputs ...)
(delete-duplicates
;; Listed dependencies may include core modules. Filter those out.
(filter-map (match-lambda
((or (module . "0") ("perl" . _))
;; TODO: A stronger test might to run MODULE through
;; `corelist' from our perl package. This current test
;; seems to be only a loose convention.
#f)
((module . _)
(let ((name (guix-name (module->name module))))
(list name
(list 'unquote (string->symbol name))))))
inputs)))))
(define (maybe-inputs guix-name inputs)
(match inputs
(()
'())
((inputs ...)
(list (list guix-name
(list 'quasiquote inputs))))))
(define source-url
(assoc-ref meta "download_url"))
(let ((tarball (with-store store
(download-to-store store source-url))))
`(package
(name ,(guix-name name))
(version ,version)
(source (origin
(method url-fetch)
(uri (string-append ,@(factorize-uri source-url version)))
(sha256
(base32
,(bytevector->nix-base32-string (file-sha256 tarball))))))
(build-system perl-build-system)
,@(maybe-inputs 'native-inputs
;; "runtime" and "test" may also be needed here. See
;; https://metacpan.org/pod/CPAN::Meta::Spec#Phases,
;; which says they are required during building. We
;; have not yet had a need for cross-compiled perl
;; modules, however, so we leave them out.
(convert-inputs '("configure" "build")))
,@(maybe-inputs 'inputs
(convert-inputs '("runtime")))
(home-page ,(string-append "http://search.cpan.org/dist/" name))
(synopsis ,(assoc-ref meta "abstract"))
(description fill-in-yourself!)
(license ,(string->license (assoc-ref meta "license"))))))
(define (cpan->guix-package module-name)
"Fetch the metadata for PACKAGE-NAME from metacpan.org, and return the
`package' s-expression corresponding to that package, or #f on failure."
(let ((module-meta (cpan-fetch module-name)))
(and=> module-meta cpan-module->sexp)))

7
guix/import/gnu.scm
View File

@ -18,6 +18,7 @@
(define-module (guix import gnu)
#:use-module (guix gnu-maintenance)
#:use-module (guix import utils)
#:use-module (guix utils)
#:use-module (guix store)
#:use-module (guix hash)
@ -38,10 +39,6 @@
;;;
;;; Code:
(define (file-sha256 file)
"Return the SHA256 hash of FILE as a bytevector."
(call-with-input-file file port-sha256))
(define (qualified-url url)
"Return a fully-qualified URL based on URL."
(if (string-prefix? "/" url)
@ -102,7 +99,7 @@ details.)"
(let ((version (gnu-release-version release)))
(match (find-packages (regexp-quote name))
((info . _)
(gnu-package->sexp info release))
(gnu-package->sexp info release #:key-download key-download))
(()
(raise (condition
(&message

32
guix/import/json.scm 100644
View File

@ -0,0 +1,32 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2014 David Thompson <davet@gnu.org>
;;; Copyright © 2015 Eric Bavier <bavier@member.fsf.org>
;;;
;;; This file is part of GNU Guix.
;;;
;;; GNU Guix is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version.
;;;
;;; GNU Guix is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (guix import json)
#:use-module (json)
#:use-module (guix utils)
#:use-module (guix import utils)
#:export (json-fetch))
(define (json-fetch url)
"Return an alist representation of the JSON resource URL, or #f on failure."
(call-with-temporary-output-file
(lambda (temp port)
(and (url-fetch url temp)
(hash-table->alist
(call-with-input-file temp json->scm))))))

47
guix/import/pypi.scm
View File

@ -27,40 +27,15 @@
#:use-module (web uri)
#:use-module (guix utils)
#:use-module (guix import utils)
#:use-module (guix import json)
#:use-module (guix base32)
#:use-module (guix hash)
#:use-module (guix packages)
#:use-module (guix licenses)
#:use-module (guix build-system python)
#:use-module ((guix build download) #:prefix build:)
#:use-module (gnu packages python)
#:export (pypi->guix-package))
(define (hash-table->alist table)
"Return an alist represenation of TABLE."
(map (match-lambda
((key . (lst ...))
(cons key
(map (lambda (x)
(if (hash-table? x)
(hash-table->alist x)
x))
lst)))
((key . (? hash-table? table))
(cons key (hash-table->alist table)))
(pair pair))
(hash-map->list cons table)))
(define (flatten lst)
"Return a list that recursively concatenates all sub-lists of LIST."
(fold-right
(match-lambda*
(((sub-list ...) memo)
(append (flatten sub-list) memo))
((elem memo)
(cons elem memo)))
'() lst))
(define (join lst delimiter)
"Return a list that contains the elements of LST, each separated by
DELIMETER."
@ -71,13 +46,6 @@ DELIMETER."
((elem . rest)
(cons* elem delimiter (join rest delimiter)))))
(define (assoc-ref* alist key . rest)
"Return the value for KEY from ALIST. For each additional key specified,
recursively apply the procedure to the sub-list."
(if (null? rest)
(assoc-ref alist key)
(apply assoc-ref* (assoc-ref alist key) rest)))
(define string->license
(match-lambda
("GNU LGPL" lgpl2.0)
@ -88,19 +56,6 @@ recursively apply the procedure to the sub-list."
("Apache License, Version 2.0" asl2.0)
(_ #f)))
(define (url-fetch url file-name)
"Save the contents of URL to FILE-NAME. Return #f on failure."
(parameterize ((current-output-port (current-error-port)))
(build:url-fetch url file-name)))
(define (json-fetch url)
"Return an alist representation of the JSON resource URL, or #f on failure."
(call-with-temporary-output-file
(lambda (temp port)
(and (url-fetch url temp)
(hash-table->alist
(call-with-input-file temp json->scm))))))
(define (pypi-fetch name)
"Return an alist representation of the PyPI metadata for the package NAME,
or #f on failure."

48
guix/import/utils.scm
View File

@ -20,7 +20,16 @@
#:use-module (ice-9 match)
#:use-module (ice-9 regex)
#:use-module (srfi srfi-1)
#:export (factorize-uri))
#:use-module (guix hash)
#:use-module (guix utils)
#:use-module ((guix build download) #:prefix build:)
#:export (factorize-uri
hash-table->alist
flatten
assoc-ref*
url-fetch))
(define (factorize-uri uri version)
"Factorize URI, a package tarball URI as a string, such that any occurrences
@ -49,3 +58,40 @@ of the string VERSION is replaced by the symbol 'version."
result))))
'()
indices))))))
(define (hash-table->alist table)
"Return an alist represenation of TABLE."
(map (match-lambda
((key . (lst ...))
(cons key
(map (lambda (x)
(if (hash-table? x)
(hash-table->alist x)
x))
lst)))
((key . (? hash-table? table))
(cons key (hash-table->alist table)))
(pair pair))
(hash-map->list cons table)))
(define (flatten lst)
"Return a list that recursively concatenates all sub-lists of LST."
(fold-right
(match-lambda*
(((sub-list ...) memo)
(append (flatten sub-list) memo))
((elem memo)
(cons elem memo)))
'() lst))
(define (assoc-ref* alist key . rest)
"Return the value for KEY from ALIST. For each additional key specified,
recursively apply the procedure to the sub-list."
(if (null? rest)
(assoc-ref alist key)
(apply assoc-ref* (assoc-ref alist key) rest)))
(define (url-fetch url file-name)
"Save the contents of URL to FILE-NAME. Return #f on failure."
(parameterize ((current-output-port (current-error-port)))
(build:url-fetch url file-name)))

59
guix/records.scm
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.
;;;
@ -267,15 +267,12 @@ PORT, according to FIELDS. FIELDS must be a list of field name/getter pairs."
(format port "~a: ~a~%" field (get object))
(loop rest)))))
(define %recutils-field-rx
(make-regexp "^([[:graph:]]+): (.*)$"))
(define %recutils-comment-rx
;; info "(recutils) Comments"
(make-regexp "^#"))
(define %recutils-plus-rx
(make-regexp "^\\+ ?(.*)$"))
(define %recutils-field-charset
;; Valid characters starting a recutils field.
;; info "(recutils) Fields"
(char-set-union char-set:upper-case
char-set:lower-case
(char-set #\%)))
(define (recutils->alist port)
"Read a recutils-style record from PORT and return it as a list of key/value
@ -288,25 +285,29 @@ pairs. Stop upon an empty line (after consuming it) or EOF."
(if (null? result)
(loop (read-line port) result) ; leading space: ignore it
(reverse result))) ; end-of-record marker
((regexp-exec %recutils-comment-rx line)
(loop (read-line port) result))
((regexp-exec %recutils-plus-rx line)
=>
(lambda (m)
(match result
(((field . value) rest ...)
(loop (read-line port)
`((,field . ,(string-append value "\n"
(match:substring m 1)))
,@rest))))))
((regexp-exec %recutils-field-rx line)
=>
(lambda (match)
(loop (read-line port)
(alist-cons (match:substring match 1)
(match:substring match 2)
result))))
(else
(error "unmatched line" line)))))
;; Now check the first character of LINE, since that's what the
;; recutils manual says is enough.
(let ((first (string-ref line 0)))
(cond
((char-set-contains? %recutils-field-charset first)
(let* ((colon (string-index line #\:))
(field (string-take line colon))
(value (string-trim (string-drop line (+ 1 colon)))))
(loop (read-line port)
(alist-cons field value result))))
((eqv? first #\#) ;info "(recutils) Comments"
(loop (read-line port) result))
((eqv? first #\+) ;info "(recutils) Fields"
(let ((new-line (if (string-prefix? "+ " line)
(string-drop line 2)
(string-drop line 1))))
(match result
(((field . value) rest ...)
(loop (read-line port)
`((,field . ,(string-append value "\n" new-line))
,@rest))))))
(else
(error "unmatched line" line))))))))
;;; records.scm ends here

2
guix/scripts/import.scm
View File

@ -73,7 +73,7 @@ rather than \\n."
;;; Entry point.
;;;
(define importers '("gnu" "nix" "pypi"))
(define importers '("gnu" "nix" "pypi" "cpan"))
(define (resolve-importer name)
(let ((module (resolve-interface

91
guix/scripts/import/cpan.scm 100644
View File

@ -0,0 +1,91 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2014 Eric Bavier <bavier@member.fsf.org>
;;;
;;; This file is part of GNU Guix.
;;;
;;; GNU Guix is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version.
;;;
;;; GNU Guix is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (guix scripts import cpan)
#:use-module (guix ui)
#:use-module (guix utils)
#:use-module (guix import cpan)
#:use-module (guix scripts import)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-11)
#:use-module (srfi srfi-37)
#:use-module (ice-9 match)
#:use-module (ice-9 format)
#:export (guix-import-cpan))
;;;
;;; Command-line options.
;;;
(define %default-options
'())
(define (show-help)
(display (_ "Usage: guix import cpan PACKAGE-NAME
Import and convert the CPAN package for PACKAGE-NAME.\n"))
(display (_ "
-h, --help display this help and exit"))
(display (_ "
-V, --version display version information and exit"))
(newline)
(show-bug-report-information))
(define %options
;; Specification of the command-line options.
(cons* (option '(#\h "help") #f #f
(lambda args
(show-help)
(exit 0)))
(option '(#\V "version") #f #f
(lambda args
(show-version-and-exit "guix import cpan")))
%standard-import-options))
;;;
;;; Entry point.
;;;
(define (guix-import-cpan . args)
(define (parse-options)
;; Return the alist of option values.
(args-fold* args %options
(lambda (opt name arg result)
(leave (_ "~A: unrecognized option~%") name))
(lambda (arg result)
(alist-cons 'argument arg result))
%default-options))
(let* ((opts (parse-options))
(args (filter-map (match-lambda
(('argument . value)
value)
(_ #f))
(reverse opts))))
(match args
((package-name)
(let ((sexp (cpan->guix-package package-name)))
(unless sexp
(leave (_ "failed to download meta-data for package '~a'~%")
package-name))
sexp))
(()
(leave (_ "too few arguments~%")))
((many ...)
(leave (_ "too many arguments~%"))))))

13
guix/scripts/substitute-binary.scm
View File

@ -241,7 +241,7 @@ failure."
((version _ sig)
(let ((maybe-number (string->number version)))
(cond ((not (number? maybe-number))
(leave (_ "signature version must be a number: ~a~%")
(leave (_ "signature version must be a number: ~s~%")
version))
;; Currently, there are no other versions.
((not (= 1 maybe-number))
@ -313,18 +313,15 @@ No authentication and authorization checks are performed here!"
"References" "Deriver" "System"
"Signature"))))
(define %signature-line-rx
;; Regexp matching a signature line in a narinfo.
(make-regexp "(.+)^[[:blank:]]*Signature:[[:blank:]].+$"))
(define (narinfo-sha256 narinfo)
"Return the sha256 hash of NARINFO as a bytevector, or #f if NARINFO lacks a
'Signature' field."
(let ((contents (narinfo-contents narinfo)))
(match (regexp-exec %signature-line-rx contents)
(match (string-contains contents "Signature:")
(#f #f)
((= (cut match:substring <> 1) above-signature)
(sha256 (string->utf8 above-signature))))))
(index
(let ((above-signature (string-take contents index)))
(sha256 (string->utf8 above-signature)))))))
(define* (assert-valid-narinfo narinfo
#:optional (acl (current-acl))

11
guix/tests.scm
View File

@ -27,6 +27,7 @@
#:export (open-connection-for-tests
random-text
random-bytevector
mock
with-derivation-narinfo
dummy-package))
@ -70,6 +71,16 @@
(loop (1+ i)))
bv))))
(define-syntax-rule (mock (module proc replacement) body ...)
"Within BODY, replace the definition of PROC from MODULE with the definition
given by REPLACEMENT."
(let* ((m (resolve-module 'module))
(original (module-ref m 'proc)))
(dynamic-wind
(lambda () (module-set! m 'proc replacement))
(lambda () body ...)
(lambda () (module-set! m 'proc original)))))
;;;
;;; Narinfo files, as used by the substituter.

16
guix/ui.scm
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 © 2013 Mark H Weaver <mhw@netris.org>
;;; Copyright © 2013 Nikita Karetnikov <nikita@karetnikov.org>
;;; Copyright © 2014 Alex Kost <alezost@gmail.com>
@ -299,21 +299,27 @@ error."
derivations listed in DRV. Return #t if there's something to build, #f
otherwise. When USE-SUBSTITUTES?, check and report what is prerequisites are
available for download."
(define substitutable?
;; Call 'substitutation-oracle' upfront so we don't end up launching the
;; substituter many times. This makes a big difference, especially when
;; DRV is a long list as is the case with 'guix environment'.
(if use-substitutes?
(substitution-oracle store drv)
(const #f)))
(define (built-or-substitutable? drv)
(let ((out (derivation->output-path drv)))
;; If DRV has zero outputs, OUT is #f.
(or (not out)
(or (valid-path? store out)
(and use-substitutes?
(has-substitutes? store out))))))
(substitutable? out)))))
(let*-values (((build download)
(fold2 (lambda (drv build download)
(let-values (((b d)
(derivation-prerequisites-to-build
store drv
#:use-substitutes?
use-substitutes?)))
#:substitutable? substitutable?)))
(values (append b build)
(append d download))))
'() '()

1109
po/packages/eo.po
View File

File diff suppressed because it is too large Load Diff

107
tests/cpan.scm 100644
View File

@ -0,0 +1,107 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2015 Eric Bavier <bavier@member.fsf.org>
;;;
;;; This file is part of GNU Guix.
;;;
;;; GNU Guix is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version.
;;;
;;; GNU Guix is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (test-cpan)
#:use-module (guix import cpan)
#:use-module (guix base32)
#:use-module (guix hash)
#:use-module (guix tests)
#:use-module (srfi srfi-64)
#:use-module (ice-9 match))
(define test-json
"{
\"metadata\" : {
\"prereqs\" : {
\"configure\" : {
\"requires\" : {
\"ExtUtils::MakeMaker\" : \"0\",
\"Module::Build\" : \"0.28\"
}
},
\"runtime\" : {
\"requires\" : {
\"Getopt::Std\" : \"0\",
\"Test::Script\" : \"1.05\",
}
}
}
\"name\" : \"Foo-Bar\",
\"version\" : \"0.1\"
}
\"name\" : \"Foo-Bar-0.1\",
\"distribution\" : \"Foo-Bar\",
\"license\" : [
\"perl_5\"
],
\"abstract\" : \"Fizzle Fuzz\",
\"download_url\" : \"http://example.com/Foo-Bar-0.1.tar.gz\",
\"author\" : \"GUIX\",
\"version\" : \"0.1\"
}")
(define test-source
"foobar")
(test-begin "cpan")
(test-assert "cpan->guix-package"
;; Replace network resources with sample data.
(mock ((guix build download) url-fetch
(lambda* (url file-name #:key (mirrors '()))
(with-output-to-file file-name
(lambda ()
(display
(match url
("http://api.metacpan.org/release/Foo-Bar"
test-json)
("http://example.com/Foo-Bar-0.1.tar.gz"
test-source)
(_ (error "Unexpected URL: " url))))))))
(match (cpan->guix-package "Foo::Bar")
(('package
('name "perl-foo-bar")
('version "0.1")
('source ('origin
('method 'url-fetch)
('uri ('string-append "http://example.com/Foo-Bar-"
'version ".tar.gz"))
('sha256
('base32
(? string? hash)))))
('build-system 'perl-build-system)
('native-inputs
('quasiquote
(("perl-module-build" ('unquote 'perl-module-build)))))
('inputs
('quasiquote
(("perl-test-script" ('unquote 'perl-test-script)))))
('home-page "http://search.cpan.org/dist/Foo-Bar")
('synopsis "Fizzle Fuzz")
('description 'fill-in-yourself!)
('license 'gpl1+))
(string=? (bytevector->nix-base32-string
(call-with-input-string test-source port-sha256))
hash))
(x
(pk 'fail x #f)))))
(test-end "cpan")
(exit (= (test-runner-fail-count (test-runner-current)) 0))

13
tests/derivations.scm
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.
;;;
@ -178,6 +178,14 @@
(let ((drv (derivation %store "foo-0.0" %bash '())))
(derivation-name drv)))
(test-equal "derivation-output-names"
'(("out") ("bar" "chbouib"))
(let ((drv1 (derivation %store "foo-0.0" %bash '()))
(drv2 (derivation %store "foo-0.0" %bash '()
#:outputs '("bar" "chbouib"))))
(list (derivation-output-names drv1)
(derivation-output-names drv2))))
(test-assert "offloadable-derivation?"
(and (offloadable-derivation? (derivation %store "foo" %bash '()))
(not (offloadable-derivation?
@ -581,7 +589,8 @@
(derivation-prerequisites-to-build store drv))
((build* download*)
(derivation-prerequisites-to-build store drv
#:use-substitutes? #f)))
#:substitutable?
(const #f))))
(and (null? build)
(equal? download (list output))
(null? download*)

1
tests/lint.scm
View File

@ -1,6 +1,7 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2012, 2013 Cyril Roelandt <tipecaml@gmail.com>
;;; Copyright © 2014 Eric Bavier <bavier@member.fsf.org>
;;; Copyright © 2014 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;

11
tests/pypi.scm
View File

@ -20,17 +20,10 @@
#:use-module (guix import pypi)
#:use-module (guix base32)
#:use-module (guix hash)
#:use-module (guix tests)
#:use-module (srfi srfi-64)
#:use-module (ice-9 match))
(define-syntax-rule (mock (module proc replacement) body ...)
(let* ((m (resolve-module 'module))
(original (module-ref m 'proc)))
(dynamic-wind
(lambda () (module-set! m 'proc replacement))
(lambda () body ...)
(lambda () (module-set! m 'proc original)))))
(define test-json
"{
\"info\": {
@ -60,7 +53,7 @@
(test-assert "pypi->guix-package"
;; Replace network resources with sample data.
(mock ((guix import pypi) url-fetch
(mock ((guix import utils) url-fetch
(lambda (url file-name)
(with-output-to-file file-name
(lambda ()