nixo
/
guix-devel
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Merge branch 'master' into dbus-update

This commit is contained in:
Mark H Weaver 2015-10-23 23:11:38 -04:00
parent 6e4512c470 ca9745e484
commit d3365d4866
34 changed files with 4940 additions and 418 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
Makefile.am
View File

@ -48,6 +48,7 @@ MODULES = \
guix/nar.scm \
guix/derivations.scm \
guix/gnu-maintenance.scm \
guix/upstream.scm \
guix/licenses.scm \
guix/build-system.scm \
guix/build-system/cmake.scm \

31
doc/guix.texi
View File

@ -4211,8 +4211,12 @@ gnu/packages/glib.scm:77:12: glib would be upgraded from 2.34.3 to 2.37.0
@end example
It does so by browsing each package's FTP directory and determining the
highest version number of the source tarballs
therein@footnote{Currently, this only works for GNU packages.}.
highest version number of the source tarballs therein. The command
knows how to update specific types of packages: GNU packages, ELPA
packages, etc.---see the documentation for @option{--type} below. The
are many packages, though, for which it lacks a method to determine
whether a new upstream release is available. However, the mechanism is
extensible, so feel free to get in touch with us to add a new method!
When passed @code{--update}, it modifies distribution source files to
update the version numbers and source tarball hashes of those packages'
@ -4257,6 +4261,29 @@ The @code{non-core} subset refers to the remaining packages. It is
typically useful in cases where an update of the core packages would be
inconvenient.
@item --type=@var{updater}
@itemx -t @var{updater}
Select only packages handled by @var{updater}. Currently, @var{updater}
may be one of:
@table @code
@item gnu
the updater for GNU packages;
@item elpa
the updater for @uref{http://elpa.gnu.org/, ELPA} packages;
@item cran
the updater fro @uref{http://cran.r-project.org/, CRAN} packages.
@end table
For instance, the following commands only checks for updates of Emacs
packages hosted at @code{elpa.gnu.org} and updates of CRAN packages:
@example
$ guix refresh -t elpa -t cran
gnu/packages/statistics.scm:819:13: r-testthat would be upgraded from 0.10.0 to 0.11.0
gnu/packages/emacs.scm:856:13: emacs-auctex would be upgraded from 11.88.6 to 11.88.9
@end example
@end table
In addition, @command{guix refresh} can be passed one or more package

1
gnu-system.am
View File

@ -439,6 +439,7 @@ dist_patch_DATA = \
gnu/packages/patches/elfutils-tests-ptrace.patch \
gnu/packages/patches/emacs-exec-path.patch \
gnu/packages/patches/eudev-rules-directory.patch \
gnu/packages/patches/evilwm-lost-focus-bug.patch \
gnu/packages/patches/expat-CVE-2015-1283.patch \
gnu/packages/patches/fastcap-mulGlobal.patch \
gnu/packages/patches/fastcap-mulSetup.patch \

11
gnu/packages.scm
View File

@ -24,6 +24,7 @@
#:use-module (guix utils)
#:use-module ((guix ftp-client) #:select (ftp-open))
#:use-module (guix gnu-maintenance)
#:use-module (guix upstream)
#:use-module (ice-9 ftw)
#:use-module (ice-9 vlist)
#:use-module (ice-9 match)
@ -377,14 +378,18 @@ it."
(when (false-if-exception (gnu-package? package))
(let ((name (package-name package))
(full-name (package-full-name package)))
;; XXX: This could work with non-GNU packages as well. However,
;; GNU's FTP-based updater would be too slow if it weren't memoized,
;; and the generic interface in (guix upstream) doesn't support
;; that.
(match (waiting (latest-release name
#:ftp-open ftp-open*
#:ftp-close (const #f))
(_ "looking for the latest release of GNU ~a...") name)
((? gnu-release? release)
((? upstream-source? source)
(let ((latest-version
(string-append (gnu-release-package release) "-"
(gnu-release-version release))))
(string-append (upstream-source-package source) "-"
(upstream-source-version source))))
(when (version>? latest-version full-name)
(format (current-error-port)
(_ "~a: note: using ~a \

46
gnu/packages/bioinformatics.scm
View File

@ -2149,6 +2149,52 @@ viewer.")
(string-append bin "/samtools")))))
(delete 'patch-tests)))))))
(define-public mosaik
(let ((commit "5c25216d"))
(package
(name "mosaik")
(version "2.2.30")
(source (origin
;; There are no release tarballs nor tags.
(method git-fetch)
(uri (git-reference
(url "https://github.com/wanpinglee/MOSAIK.git")
(commit commit)))
(file-name (string-append name "-" version))
(sha256
(base32
"17gj3s07cm77r41z92awh0bim7w7q7fbn0sf5nkqmcm1vw052qgw"))))
(build-system gnu-build-system)
(arguments
`(#:tests? #f ; no tests
#:make-flags (list "CC=gcc")
#:phases
(modify-phases %standard-phases
(replace 'configure
(lambda _ (chdir "src") #t))
(replace 'install
(lambda* (#:key outputs #:allow-other-keys)
(let ((bin (string-append (assoc-ref outputs "out")
"/bin")))
(mkdir-p bin)
(copy-recursively "../bin" bin)
#t))))))
(inputs
`(("perl" ,perl)
("zlib" ,zlib)))
(home-page "https://code.google.com/p/mosaik-aligner/")
(synopsis "Map nucleotide sequence reads to reference genomes")
(description
"MOSAIK is a program for mapping second and third-generation sequencing
reads to a reference genome. MOSAIK can align reads generated by all the
major sequencing technologies, including Illumina, Applied Biosystems SOLiD,
Roche 454, Ion Torrent and Pacific BioSciences SMRT.")
;; MOSAIK is released under the GPLv2+ with the exception of third-party
;; code released into the public domain:
;; 1. fastlz by Ariya Hidayat - http://www.fastlz.org/
;; 2. MD5 implementation - RSA Data Security, RFC 1321
(license (list license:gpl2+ license:public-domain)))))
(define-public ngs-sdk
(package
(name "ngs-sdk")

20
gnu/packages/cdrom.scm
View File

@ -2,6 +2,7 @@
;;; Copyright © 2013, 2014, 2015 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2013, 2014 Andreas Enge <andreas@enge.fr>
;;; Copyright © 2015 Taylan Ulrich Bayırlı/Kammer <taylanbayirli@gmail.com>
;;; Copyright © 2015 Paul van der Walt <paul@denknerd.org>
;;;
;;; This file is part of GNU Guix.
;;;
@ -231,6 +232,25 @@ depend on the file system of the medium. The maximum error correction
capacity is user-selectable.")
(license gpl2+)))
(define-public libcue
(package
(name "libcue")
(version "1.4.0")
(source (origin
(method url-fetch)
(uri (string-append "mirror://sourceforge/libcue/libcue-"
version ".tar.bz2"))
(sha256
(base32
"17kjd7rjz1bvfn44n3n2bjb7a1ywd0yc0g4sqp5ihf9b5bn7cwlb"))))
(build-system gnu-build-system)
(home-page "http://libcue.sourceforge.net/")
(synopsis "C library to parse cue sheets")
(description "Libcue is a C library to parse so-called @dfn{cue sheets}
which contain meta-data for CD/DVD tracks. It provides an API to manipulate
the data.")
(license gpl2+)))
(define-public cd-discid
(package
(name "cd-discid")

32
gnu/packages/compression.scm
View File

@ -7,6 +7,7 @@
;;; Copyright © 2015 Ricardo Wurmus <rekado@elephly.net>
;;; Copyright © 2015 Leo Famulari <leo@famulari.name>
;;; Copyright © 2015 Jeff Mickey <j@codemac.net>
;;; Copyright © 2015 Efraim Flashner <efraim@flashner.co.il>
;;;
;;; This file is part of GNU Guix.
;;;
@ -25,6 +26,7 @@
(define-module (gnu packages compression)
#:use-module ((guix licenses) #:prefix license:)
#:use-module (guix utils)
#:use-module (guix packages)
#:use-module (guix download)
#:use-module (guix git-download)
@ -225,6 +227,36 @@ decompression.")
"See LICENSE in the distribution."))
(home-page "http://www.bzip.org/"))))
(define-public pbzip2
(package
(name "pbzip2")
(version "1.1.12")
(source (origin
(method url-fetch)
(uri (string-append "https://launchpad.net/pbzip2/"
(version-major+minor version) "/" version
"/+download/" name "-" version ".tar.gz"))
(sha256
(base32
"1vk6065dv3a47p86vmp8hv3n1ygd9hraz0gq89gvzlx7lmcb6fsp"))))
(build-system gnu-build-system)
(inputs
`(("bzip2", bzip2)))
(arguments
`(#:tests? #f ; no tests
#:phases (modify-phases %standard-phases
(delete 'configure))
#:make-flags (list (string-append "PREFIX=" %output))))
(home-page "http://compression.ca/pbzip2/")
(synopsis "Parallel bzip2 implementation")
(description
"Pbzip2 is a parallel implementation of the bzip2 block-sorting file
compressor that uses pthreads and achieves near-linear speedup on SMP machines.
The output of this version is fully compatible with bzip2 v1.0.2 (i.e. anything
compressed with pbzip2 can be decompressed with bzip2).")
(license (license:non-copyleft "file://COPYING"
"See COPYING in the distribution."))))
(define-public xz
(package
(name "xz")

54
gnu/packages/conkeror.scm
View File

@ -1,6 +1,6 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2014 Cyrill Schenkel <cyrill.schenkel@gmail.com>
;;; Copyright © 2014 Eric Bavier <bavier@member.fsf.org>
;;; Copyright © 2014, 2015 Eric Bavier <bavier@member.fsf.org>
;;;
;;; This file is part of GNU Guix.
;;;
@ -28,46 +28,42 @@
(define-public conkeror
(package
(name "conkeror")
(version "1.0pre1")
(version "1.0pre1.20150730")
(source (origin
(method url-fetch)
(uri
(string-append "http://repo.or.cz/w/conkeror.git/snapshot/"
"8a26fff5896a3360549e2adfbf06b1d57e909266"
".tar.gz")) ; tag: debian-1.0--pre-1+git140616-1
"a1f7e879b129df5cf14ea4ce80a9c1407380ed58"
".tar.gz")) ; tag: debian-1.0--pre-1+git150730-1
(sha256
(base32
"1cgjzi7g3g22zcx6bpfnid4i12sb45w6icmxdzjn8d3c0m8qsyp1"))))
"1q45hc30733gz3ca2ixvw0rzzcbi7rlay7gx7kvzjv17a030nyk0"))))
(build-system gnu-build-system)
(inputs `(("icecat" ,icecat)))
(arguments
`(#:tests? #f ;no tests
#:make-flags '("CC=gcc")
#:make-flags `("CC=gcc"
,(string-append "PREFIX=" (assoc-ref %outputs "out")))
#:phases
(alist-delete
'configure
(alist-replace
'install
(lambda _
(begin
(use-modules (guix build utils))
(let* ((datadir (string-append %output "/share/conkeror"))
(bindir (string-append %output "/bin"))
(launcher (string-append bindir "/conkeror"))
(spawn (string-append bindir "/conkeror-spawn-helper")))
(copy-recursively "." datadir)
(mkdir-p bindir)
(copy-file "conkeror-spawn-helper" spawn)
(call-with-output-file launcher
(lambda (p)
(format p "#!~a/bin/bash
(modify-phases %standard-phases
(delete 'configure)
(add-after
'install 'install-app-launcher
(lambda* (#:key inputs outputs #:allow-other-keys)
;; This overwrites the installed launcher, which execs xulrunner,
;; with one that execs 'icecat --app'
(let* ((out (assoc-ref outputs "out"))
(datadir (string-append out "/share/conkeror"))
(launcher (string-append out "/bin/conkeror")))
(call-with-output-file launcher
(lambda (p)
(format p "#!~a/bin/bash
exec ~a/bin/icecat --app ~a \"$@\"~%"
(assoc-ref %build-inputs "bash") ;implicit input
(assoc-ref %build-inputs "icecat")
(string-append datadir
"/application.ini"))))
(chmod launcher #o555))))
%standard-phases))))
(assoc-ref inputs "bash") ;implicit input
(assoc-ref inputs "icecat")
(string-append datadir
"/application.ini"))))
(chmod launcher #o555)))))))
(synopsis "Keyboard focused web browser with Emacs look and feel")
(description "Conkeror is a highly-programmable web browser based on
Mozilla XULRunner which is the base of all Mozilla products including Firefox.

4
gnu/packages/freeipmi.scm
View File

@ -27,14 +27,14 @@
(define-public freeipmi
(package
(name "freeipmi")
(version "1.4.9")
(version "1.4.10")
(source (origin
(method url-fetch)
(uri (string-append "mirror://gnu/freeipmi/freeipmi-"
version ".tar.gz"))
(sha256
(base32
"0v2xfwik2mv6z8066raiypc4xymjvr8pb0mv3mc3g4ym4km132qp"))))
"1l98l8g8lha85q1d288wr7dyx00x36smh9g5wza15n4wm35c9wqs"))))
(build-system gnu-build-system)
(inputs
`(("readline" ,readline) ("libgcrypt" ,libgcrypt)))

82
gnu/packages/games.scm
View File

@ -6,12 +6,13 @@
;;; Copyright © 2014 Sylvain Beucler <beuc@beuc.net>
;;; Copyright © 2014, 2015 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2014, 2015 Sou Bunnbu <iyzsong@gmail.com>
;;; Copyright © 2014 Mark H Weaver <mhw@netris.org>
;;; Copyright © 2014, 2015 Mark H Weaver <mhw@netris.org>
;;; Copyright © 2015 Andreas Enge <andreas@enge.fr>
;;; Copyright © 2015 David Hashe <david.hashe@dhashe.com>
;;; Copyright © 2015 Christopher Allan Webber <cwebber@dustycloud.org>
;;; Copyright © 2015 Ricardo Wurmus <rekado@elephly.net>
;;; Copyright © 2015 Alex Kost <alezost@gmail.com>
;;; Copyright © 2015 Paul van der Walt <paul@denknerd.org>
;;;
;;; This file is part of GNU Guix.
;;;
@ -34,7 +35,9 @@
#:use-module (guix packages)
#:use-module (guix download)
#:use-module (guix git-download)
#:use-module (guix svn-download)
#:use-module (gnu packages)
#:use-module (gnu packages autotools)
#:use-module (gnu packages base)
#:use-module (gnu packages admin)
#:use-module (gnu packages audio)
@ -49,6 +52,7 @@
#:use-module (gnu packages guile)
#:use-module (gnu packages libcanberra)
#:use-module (gnu packages libunwind)
#:use-module (gnu packages haskell)
#:use-module (gnu packages mp3)
#:use-module (gnu packages image)
#:use-module (gnu packages ncurses)
@ -78,6 +82,7 @@
#:use-module (gnu packages fribidi)
#:use-module (guix build-system trivial)
#:use-module (guix build-system gnu)
#:use-module (guix build-system haskell)
#:use-module (guix build-system cmake)
#:use-module (guix build-system trivial))
@ -1048,6 +1053,48 @@ experience and advance levels, and are carried over from one scenario to the
next campaign.")
(license license:gpl2+)))
(define-public dosbox
(package
(name "dosbox")
(version "0.74.svn3947")
(source (origin
(method svn-fetch)
(uri (svn-reference
(url "http://svn.code.sf.net/p/dosbox/code-0/dosbox/trunk/")
(revision 3947)))
(file-name (string-append name "-" version "-checkout"))
;; Use SVN head, since the last release (2010) is incompatible
;; with GCC 4.8+ (see
;; <https://bugs.debian.org/cgi-bin/bugreport.cgi?bug=624976>).
(sha256
(base32
"1p918j6090d1nkvgq7ifvmn506zrdmyi32y7p3ms40d5ssqjg8fj"))))
(build-system gnu-build-system)
(arguments
`(#:phases (modify-phases %standard-phases
(add-after
'unpack 'autogen.sh
(lambda _
(zero? (system* "sh" "autogen.sh")))))))
(native-inputs
`(("autoconf" ,autoconf)
("automake" ,automake)))
(inputs
`(("sdl" ,sdl)
("libpng" ,libpng)
("zlib" ,zlib)
("alsa-lib" ,alsa-lib)
("glu" ,glu)
("mesa" ,mesa)))
(home-page "http://www.dosbox.com")
(synopsis "x86 emulator with CGA/EGA/VGA/etc. graphics and sound")
(description "DOSBox is a DOS-emulator that uses the SDL library. DOSBox
also emulates CPU:286/386 realmode/protected mode, Directory
FileSystem/XMS/EMS, Tandy/Hercules/CGA/EGA/VGA/VESA graphics, a
SoundBlaster/Gravis Ultra Sound card for excellent sound compatibility with
older games.")
(license license:gpl2+)))
(define-public gamine
(package
(name "gamine")
@ -1094,6 +1141,39 @@ on the screen and keyboard to display letters.")
;; Most files under gpl2+ or gpl3+, but eat.wav under gpl3
(license license:gpl3)))
(define-public raincat
(package
(name "raincat")
(version "1.1.1.3")
(source
(origin
(method url-fetch)
(uri (string-append
"http://hackage.haskell.org/package/Raincat/Raincat-"
version
".tar.gz"))
(sha256
(base32
"1aalh68h6799mv4vyg30zpskl5jkn6x2j1jza7p4lrflyifxzar8"))))
(build-system haskell-build-system)
(inputs
`(("ghc-extensible-exceptions" ,ghc-extensible-exceptions)
("ghc-mtl" ,ghc-mtl)
("ghc-random" ,ghc-random)
("ghc-glut" ,ghc-glut)
("ghc-opengl" ,ghc-opengl)
("ghc-sdl" ,ghc-sdl)
("ghc-sdl-image" ,ghc-sdl-image)
("ghc-sdl-mixer" ,ghc-sdl-mixer)))
(home-page "http://raincat.bysusanlin.com/")
(synopsis "Puzzle game with a cat in lead role")
(description "Project Raincat is a game developed by Carnegie Mellon
students through GCS during the Fall 2008 semester. Raincat features game
play inspired from classics Lemmings and The Incredible Machine. The project
proved to be an excellent learning experience for the programmers. Everything
is programmed in Haskell.")
(license license:bsd-3)))
(define-public manaplus
(package
(name "manaplus")

4
gnu/packages/gnu-pw-mgr.scm
View File

@ -29,7 +29,7 @@
(define-public gnu-pw-mgr
(package
(name "gnu-pw-mgr")
(version "1.5")
(version "1.6")
(source
(origin
(method url-fetch)
@ -37,7 +37,7 @@
version ".tar.xz"))
(sha256
(base32
"1winmckl4h8lypg57hd3nd7jscpdr7f1v8zi432k5h648izkf2dg"))))
"141wfm4w420ygrl7qvrc84drzv34jym0d2bxqcgi7n1vimql0slp"))))
(build-system gnu-build-system)
(native-inputs
`(("which" ,which)

3856
gnu/packages/haskell.scm
View File

File diff suppressed because it is too large Load Diff

4
gnu/packages/less.scm
View File

@ -26,7 +26,7 @@
(define-public less
(package
(name "less")
(version "451")
(version "481")
(source
(origin
(method url-fetch)
@ -34,7 +34,7 @@
version ".tar.gz"))
(sha256
(base32
"0mszdd9m1dsbg59pav62swg9f87xmjpfspcw2jsazzksciy2is4z"))))
"19fxj0h10y5bhr3a1xa7kqvnwl44db3sdypz8jxl1q79yln8z8rz"))))
(build-system gnu-build-system)
(inputs `(("ncurses" ,ncurses)))
(home-page "https://www.gnu.org/software/less/")

4
gnu/packages/linux.scm
View File

@ -210,7 +210,7 @@ for SYSTEM, or #f if there is no configuration for SYSTEM."
#f)))
(define-public linux-libre
(let* ((version "4.2.3")
(let* ((version "4.2.4")
(build-phase
'(lambda* (#:key system inputs #:allow-other-keys #:rest args)
;; Apply the neat patch.
@ -283,7 +283,7 @@ for SYSTEM, or #f if there is no configuration for SYSTEM."
(uri (linux-libre-urls version))
(sha256
(base32
"1xpx32k6bzxqg5y8lyaana97jjcli00iyqklh5fdhirfvjb9dimd"))))
"11r9yhi4c2zwfb8i21zk014gcm1kvnabq410wjy6g6a015d5v37w"))))
(build-system gnu-build-system)
(native-inputs `(("perl" ,perl)
("bc" ,bc)

4
gnu/packages/man.scm
View File

@ -162,7 +162,7 @@ Linux kernel and C library interfaces employed by user-space programs.")
(define-public help2man
(package
(name "help2man")
(version "1.47.1")
(version "1.47.2")
(source
(origin
(method url-fetch)
@ -170,7 +170,7 @@ Linux kernel and C library interfaces employed by user-space programs.")
version ".tar.xz"))
(sha256
(base32
"01ib718afwc28bmh1n0p5h7245vs3rrfm7bj1sq4avmh1kv2d6y5"))))
"0z1zgw6k1fba59fii6ksfi1g2gci6i4ysa3kdfh3j475fdkn1if4"))))
(build-system gnu-build-system)
(arguments `(;; There's no `check' target.
#:tests? #f))

65
gnu/packages/music.scm
View File

@ -1,5 +1,6 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2015 Ricardo Wurmus <rekado@elephly.net>
;;; Copyright © 2015 Paul van der Walt <paul@denknerd.org>
;;;
;;; This file is part of GNU Guix.
;;;
@ -33,6 +34,7 @@
#:use-module (gnu packages base) ;libbdf
#:use-module (gnu packages boost)
#:use-module (gnu packages bison)
#:use-module (gnu packages cdrom)
#:use-module (gnu packages code)
#:use-module (gnu packages check)
#:use-module (gnu packages compression)
@ -55,6 +57,7 @@
#:use-module (gnu packages linux) ; for alsa-utils
#:use-module (gnu packages man)
#:use-module (gnu packages mp3)
#:use-module (gnu packages ncurses)
#:use-module (gnu packages netpbm)
#:use-module (gnu packages pdf)
#:use-module (gnu packages perl)
@ -67,6 +70,7 @@
#:use-module (gnu packages tcl)
#:use-module (gnu packages texinfo)
#:use-module (gnu packages texlive)
#:use-module (gnu packages video)
#:use-module (gnu packages web)
#:use-module (gnu packages xml)
#:use-module (gnu packages xorg)
@ -74,6 +78,67 @@
#:use-module (gnu packages zip)
#:use-module ((srfi srfi-1) #:select (last)))
(define-public cmus
(package
(name "cmus")
(version "2.7.1")
(source (origin
(method url-fetch)
(uri (string-append
"https://github.com/" name "/" name "/archive/v"
version ".tar.gz"))
(file-name (string-append name "-" version ".tar.gz"))
(sha256
(base32
"0raixgjavkm7hxppzsc5zqbfbh2bhjcmbiplhnsxsmyj8flafyc1"))))
(build-system gnu-build-system)
(arguments
`(#:tests? #f ; cmus does not include tests
#:phases
(modify-phases %standard-phases
(replace
'configure
(lambda* (#:key outputs #:allow-other-keys)
(let ((out (assoc-ref outputs "out")))
;; It's an idiosyncratic configure script that doesn't
;; understand --prefix=..; it wants prefix=.. instead.
(zero?
(system* "./configure"
(string-append "prefix=" out)))))))))
;; TODO: cmus optionally supports the following formats, which haven't yet
;; been added to Guix:
;;
;; - Roar, libroar
;;
;; - DISCID_LIBS, apparently different from cd-discid which is included in
;; Guix. See <http://sourceforge.net/projects/discid/>
(native-inputs
`(("pkg-config" ,pkg-config)))
(inputs
`(("alsa-lib" ,alsa-lib)
("ao" ,ao)
("ffmpeg" ,ffmpeg)
("flac" ,flac)
("jack" ,jack-1)
("libcddb" ,libcddb)
("libcdio-paranoia" ,libcdio-paranoia)
("libcue" ,libcue)
("libmad" ,libmad)
("libmodplug" ,libmodplug)
("libmpcdec" ,libmpcdec)
("libsamplerate" ,libsamplerate)
("libvorbis" ,libvorbis)
("ncurses" ,ncurses)
("opusfile" ,opusfile)
("pulseaudio" ,pulseaudio)
("wavpack" ,wavpack)))
(home-page "https://cmus.github.io/")
(synopsis "Small console music player")
(description "Cmus is a small and fast console music player. It supports
many input formats and provides a customisable Vi-style user interface.")
(license license:gpl2+)))
(define-public hydrogen
(package
(name "hydrogen")

4
gnu/packages/ntp.scm
View File

@ -35,7 +35,7 @@
(define-public ntp
(package
(name "ntp")
(version "4.2.8p3")
(version "4.2.8p4")
(source (origin
(method url-fetch)
(uri (string-append
@ -44,7 +44,7 @@
"/ntp-" version ".tar.gz"))
(sha256
(base32
"13zkzcvjm5kbxl4xbcmaq07slplhmpkgahzcqnqlba3cxpra9341"))
"1fgxbhv0wyiivi6kh5zpzrd0yqmc48z7d3zmjspw9lj84mbn2s8d"))
(modules '((guix build utils)))
(snippet
'(begin

18
gnu/packages/patches/evilwm-lost-focus-bug.patch Normal file
View File

@ -0,0 +1,18 @@
evilwm may sometimes lose focus after closing a window. This means that
evilwm stops responding to keyboard shortcuts, and if no other window is open
which the mouse can be moved over to regain focus evilwm becomes unusable and
has to be restarted.
Patch derived from discussion at
https://wiki.archlinux.org/index.php/Evilwm#Lost_focus_bug_fix
--- evilwm-1.1.1/client.c
+++ evilwm-1.1.1/client.c
@@ -172,6 +172,7 @@
* _NET_WM_STATE) */
if (c->remove) {
LOG_DEBUG("setting WithdrawnState\n");
+ XSetInputFocus(dpy, PointerRoot, RevertToPointerRoot, CurrentTime);
set_wm_state(c, WithdrawnState);
ewmh_withdraw_client(c);
} else {

37
gnu/packages/python.scm
View File

@ -3060,6 +3060,43 @@ that client code uses to construct the grammar directly in Python code.")
(define-public python2-numpydoc
(package-with-python2 python-numpydoc))
(define-public python-numexpr
(package
(name "python-numexpr")
(version "2.4.4")
(source
(origin
(method url-fetch)
(uri (string-append "https://pypi.python.org/packages/source/"
"n/numexpr/numexpr-" version ".tar.gz"))
(sha256
(base32
"0nsnff5312fm38w6dm34bw7ghfqqy8vl9gig0al963h4mz8zm8nz"))))
(build-system python-build-system)
(arguments `(#:tests? #f)) ; no tests included
(propagated-inputs
`(("python-numpy" ,python-numpy)))
(home-page "https://github.com/pydata/numexpr")
(synopsis "Fast numerical expression evaluator for NumPy")
(description
"Numexpr is a fast numerical expression evaluator for NumPy. With it,
expressions that operate on arrays are accelerated and use less memory than
doing the same calculation in Python. In addition, its multi-threaded
capabilities can make use of all your cores, which may accelerate
computations, most specially if they are not memory-bounded (e.g. those using
transcendental functions).")
(license license:expat)))
(define-public python2-numexpr
(let ((numexpr (package-with-python2 python-numexpr)))
(package (inherit numexpr)
;; Make sure to use special packages for Python 2 instead
;; of those automatically rewritten by package-with-python2.
(propagated-inputs
`(("python2-numpy" ,python2-numpy)
,@(alist-delete "python-numpy"
(package-propagated-inputs numexpr)))))))
(define-public python-matplotlib
(package
(name "python-matplotlib")

122
gnu/packages/statistics.scm
View File

@ -24,6 +24,7 @@
#:use-module (guix utils)
#:use-module (guix build-system gnu)
#:use-module (guix build-system r)
#:use-module (guix build-system python)
#:use-module (gnu packages)
#:use-module (gnu packages compression)
#:use-module (gnu packages gcc)
@ -35,11 +36,14 @@
#:use-module (gnu packages pcre)
#:use-module (gnu packages perl)
#:use-module (gnu packages pkg-config)
#:use-module (gnu packages python)
#:use-module (gnu packages readline)
#:use-module (gnu packages texlive)
#:use-module (gnu packages texinfo)
#:use-module (gnu packages base)
#:use-module (gnu packages xorg))
#:use-module (gnu packages xorg)
#:use-module (gnu packages zip)
#:use-module (srfi srfi-1))
(define-public r
(package
@ -933,3 +937,119 @@ times.")
large data (e.g. 100GB in RAM), fast ordered joins, fast add/modify/delete of
columns by group, column listing and fast file reading.")
(license license:gpl2+)))
(define-public python-patsy
(package
(name "python-patsy")
(version "0.4.0")
(source (origin
(method url-fetch)
(uri (string-append "https://pypi.python.org/packages/source/"
"p/patsy/patsy-" version ".zip"))
(sha256
(base32
"1kbs996xc2haxalmhd19rr1wh5fa4gbbxf81czkf5w4kam7h7wz4"))))
(build-system python-build-system)
(arguments
`(#:phases
(modify-phases %standard-phases
(replace 'check (lambda _ (zero? (system* "nosetests" "-v"))))
(add-after 'unpack 'prevent-generation-of-egg-archive
(lambda _
(substitute* "setup.py"
(("from setuptools import setup")
"from distutils.core import setup"))
#t)))))
(propagated-inputs
`(("python-numpy" ,python-numpy)
("python-scipy" ,python-scipy)
("python-six" ,python-six)))
(native-inputs
`(("python-nose" ,python-nose)
("unzip" ,unzip)))
(home-page "https://github.com/pydata/patsy")
(synopsis "Describe statistical models and build design matrices")
(description
"Patsy is a Python package for describing statistical models and for
building design matrices.")
;; The majority of the code is distributed under BSD-2. The module
;; patsy.compat contains code derived from the Python standard library,
;; and is covered by the PSFL.
(license (list license:bsd-2 license:psfl))))
(define-public python2-patsy
(let ((patsy (package-with-python2 python-patsy)))
(package (inherit patsy)
(native-inputs
`(("python2-setuptools" ,python2-setuptools)
,@(package-native-inputs patsy)))
(propagated-inputs
`(("python2-numpy" ,python2-numpy)
("python2-scipy" ,python2-scipy)
,@(alist-delete "python-numpy"
(alist-delete "python-scipy"
(package-propagated-inputs patsy))))))))
(define-public python-statsmodels
(package
(name "python-statsmodels")
(version "0.6.1")
(source
(origin
(method url-fetch)
(uri (string-append "https://pypi.python.org/packages/source/"
"s/statsmodels/statsmodels-" version ".tar.gz"))
(sha256
(base32
"0xn67sqr0cc1lmlhzm71352hrb4hw7g318p5ff5q97pc98vl8kmy"))))
(build-system python-build-system)
(arguments
`(#:phases
(modify-phases %standard-phases
;; tests must be run after installation
(delete 'check)
(add-after 'unpack 'set-matplotlib-backend-to-agg
(lambda _
;; Set the matplotlib backend to Agg to avoid problems using the
;; GTK backend without a display.
(substitute* (find-files "statsmodels/graphics/tests" "\\.py")
(("import matplotlib\\.pyplot as plt" line)
(string-append "import matplotlib;matplotlib.use('Agg');"
line)))
#t))
(add-after 'install 'check
(lambda _
(with-directory-excursion "/tmp"
(zero? (system* "nosetests"
"--stop"
"-v" "statsmodels"))))))))
(propagated-inputs
`(("python-numpy" ,python-numpy)
("python-scipy" ,python-scipy)
("python-pandas" ,python-pandas)
("python-patsy" ,python-patsy)
("python-matplotlib" ,python-matplotlib)))
(native-inputs
`(("python-cython" ,python-cython)
("python-nose" ,python-nose)
("python-sphinx" ,python-sphinx)))
(home-page "http://statsmodels.sourceforge.net/")
(synopsis "Statistical modeling and econometrics in Python")
(description
"Statsmodels is a Python package that provides a complement to scipy for
statistical computations including descriptive statistics and estimation and
inference for statistical models.")
(license license:bsd-3)))
(define-public python2-statsmodels
(let ((stats (package-with-python2 python-statsmodels)))
(package (inherit stats)
(propagated-inputs
`(("python2-numpy" ,python2-numpy)
("python2-scipy" ,python2-scipy)
("python2-pandas" ,python2-pandas)
("python2-patsy" ,python2-patsy)
("python2-matplotlib" ,python2-matplotlib)))
(native-inputs
`(("python2-setuptools" ,python2-setuptools)
,@(package-native-inputs stats))))))

10
gnu/packages/video.scm
View File

@ -3,6 +3,7 @@
;;; Copyright © 2014, 2015 David Thompson <davet@gnu.org>
;;; Copyright © 2014, 2015 Mark H Weaver <mhw@netris.org>
;;; Copyright © 2015 Taylan Ulrich Bayırlı/Kammer <taylanbayirli@gmail.com>
;;; Copyright © 2015 Efraim Flashner <efraim@flashner.co.il>
;;;
;;; This file is part of GNU Guix.
;;;
@ -584,7 +585,7 @@ treaming protocols.")
(define-public mplayer
(package
(name "mplayer")
(version "1.1.1")
(version "1.2")
(source (origin
(method url-fetch)
(uri (string-append
@ -592,7 +593,7 @@ treaming protocols.")
version ".tar.xz"))
(sha256
(base32
"0xlcg7rszrwmw29wqr0plsw5d1rq0hb7vjsq7bmmfsly2z1wg3yf"))))
"1dp2lbxyhgjr8sn91kf6xw3w6d7dsgq08v4dgrq20afz1bqzdrzz"))))
(build-system gnu-build-system)
;; FIXME: Add additional inputs once available.
(native-inputs
@ -601,8 +602,11 @@ treaming protocols.")
`(("alsa-lib" ,alsa-lib)
("cdparanoia" ,cdparanoia)
("fontconfig" ,fontconfig)
("ffmpeg", ffmpeg)
("freetype" ,freetype)
("lame" ,lame)
("libdvdcss", libdvdcss)
("libdvdnav", libdvdnav)
("libmpg123" ,mpg123) ; audio codec for MP3
;; ("giflib" ,giflib) ; uses QuantizeBuffer, requires version >= 5
("libjpeg" ,libjpeg)
@ -639,7 +643,7 @@ treaming protocols.")
"./configure"
(string-append "--extra-cflags=-I"
libx11 "/include") ; to detect libx11
"--disable-tremor-internal" ; forces external libvorbis
"--disable-ffmpeg_a" ; disables bundled ffmpeg
(string-append "--prefix=" out)
;; Enable runtime cpu detection where supported,
;; and choose a suitable target.

63
gnu/packages/wm.scm
View File

@ -3,6 +3,7 @@
;;; Copyright © 2015 Siniša Biđin <sinisa@bidin.eu>
;;; Copyright © 2015 Eric Bavier <bavier@member.fsf.org>
;;; Copyright © 2015 xd1le <elisp.vim@gmail.com>
;;; Copyright © 2015 Paul van der Walt <paul@denknerd.org>
;;;
;;; This file is part of GNU Guix.
;;;
@ -22,6 +23,7 @@
(define-module (gnu packages wm)
#:use-module (guix licenses)
#:use-module (guix packages)
#:use-module (gnu packages)
#:use-module (gnu packages linux)
#:use-module (guix build-system gnu)
#:use-module (guix build-system haskell)
@ -190,10 +192,19 @@ developers.")
(source (origin
(method url-fetch)
(uri (string-append "http://hackage.haskell.org/package/xmonad/"
"xmonad-" version ".tar.gz"))
name "-" version ".tar.gz"))
(sha256
(base32
"1pfjssamiwpwjp1qqkm9m9p9s35pv381m0cwg6jxg0ppglibzq1r"))))
"1pfjssamiwpwjp1qqkm9m9p9s35pv381m0cwg6jxg0ppglibzq1r"))
(modules '((guix build utils)))
(snippet
;; Here we update the constraints on the utf8-string package in
;; the Cabal file. We allow a newer version which is compatible
;; with GHC 7.10.2. The same change is applied on Hackage. See
;; <https://hackage.haskell.org/package/xmonad-0.11.1/revisions/>.
'(substitute* "xmonad.cabal"
(("utf8-string >= 0.3 && < 0.4")
"utf8-string >= 0.3 && < 1.1")))))
(build-system haskell-build-system)
(inputs
`(("ghc-mtl" ,ghc-mtl)
@ -232,7 +243,7 @@ tiled on several screens.")
(define-public ghc-xmonad-contrib
(package
(name "ghc-xmonad-contrib")
(version "0.11.3")
(version "0.11.4")
(source
(origin
(method url-fetch)
@ -240,10 +251,11 @@ tiled on several screens.")
"xmonad-contrib-" version ".tar.gz"))
(sha256
(base32
"14h9vr33yljymswj50wbimav263y9abdcgi07mvfis0zd08rxqxa"))))
"1g5cw9vvnfbiyi599fngk02zlmdhrf82x0bndhypkn6kybab6yd3"))))
(build-system haskell-build-system)
(propagated-inputs
`(("ghc-mtl" ,ghc-mtl)
("ghc-old-time" ,ghc-old-time)
("ghc-random" ,ghc-random)
("ghc-utf8-string" ,ghc-utf8-string)
("ghc-extensible-exceptions" ,ghc-extensible-exceptions)
@ -256,3 +268,46 @@ tiled on several screens.")
"Third party tiling algorithms, configurations, and scripts to Xmonad, a
tiling window manager for X.")
(license bsd-3)))
(define-public evilwm
(package
(name "evilwm")
(version "1.1.1")
(source
(origin
(method url-fetch)
(uri (string-append "http://www.6809.org.uk/evilwm/evilwm-"
version ".tar.gz"))
(sha256
(base32
"0ak0yajzk3v4dg5wmaghv6acf7v02a4iw8qxmq5yw5ard8lrqn3r"))
(patches (map search-patch '("evilwm-lost-focus-bug.patch")))))
(build-system gnu-build-system)
(inputs
`(("libx11" ,libx11)
("libxext" ,libxext)
("libxrandr" ,libxrandr)))
(arguments
`(#:modules ((srfi srfi-26)
(guix build utils)
(guix build gnu-build-system))
#:make-flags (let ((inputs (map (cut assoc-ref %build-inputs <>)
'("libx11" "libxext" "libxrandr")))
(join (lambda (proc strs)
(string-join (map proc strs) " ")))
(dash-I (cut string-append "-I" <> "/include"))
(dash-L (cut string-append "-L" <> "/lib")))
`("desktopfilesdir=$(prefix)/share/xsessions"
,(string-append "prefix=" (assoc-ref %outputs "out"))
,(string-append "CPPFLAGS=" (join dash-I inputs))
,(string-append "LDFLAGS=" (join dash-L inputs))))
#:tests? #f ;no tests
#:phases (modify-phases %standard-phases
(delete 'configure)))) ;no configure script
(home-page "http://www.6809.org.uk/evilwm/")
(synopsis "Minimalist window manager for the X Window System")
(description
"evilwm is a minimalist window manager based on aewm, extended to feature
many keyboard controls with repositioning and maximize toggles, solid window
drags, snap-to-border support, and virtual desktops.")
(license (x11-style "file:///README"))))

30
gnu/packages/xiph.scm
View File

@ -4,6 +4,7 @@
;;; Copyright © 2013 David Thompson <dthompson2@worcester.edu>
;;; Copyright © 2014 Sree Harsha Totakura <sreeharsha@totakura.in>
;;; Copyright © 2014 Mark H Weaver <mhw@netris.org>
;;; Copyright © 2015 Paul van der Walt <paul@denknerd.org>
;;;
;;; This file is part of GNU Guix.
;;;
@ -46,6 +47,7 @@
libkate
vorbis-tools
opus
opusfile
opus-tools))
(define libogg
@ -341,6 +343,34 @@ decoding .opus files.")
(license license:bsd-3)
(home-page "http://www.opus-codec.org")))
(define opusfile
(package
(name "opusfile")
(version "0.6")
(source (origin
(method url-fetch)
(uri (string-append
"http://downloads.xiph.org/releases/opus/opusfile-" version
".tar.gz"))
(sha256
(base32
"19iys2kld75k0210b807i4illrdmj3cmmnrgxlc9y4vf6mxp2a14"))))
(build-system gnu-build-system)
(propagated-inputs
`(("opus" ,opus)))
(native-inputs
`(("pkg-config" ,pkg-config)))
(inputs
`(("libogg" ,libogg)
("openssl" ,openssl)))
(synopsis "Versatile audio codec")
(description
"The opusfile library provides seeking, decode, and playback of Opus
streams in the Ogg container (.opus files) including over http(s) on posix and
windows systems.")
(license license:bsd-3)
(home-page "http://www.opus-codec.org")))
(define-public icecast
(package
(name "icecast")

47
gnu/packages/xorg.scm
View File

@ -1,7 +1,7 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2013, 2014 Andreas Enge <andreas@enge.fr>
;;; Copyright © 2014, 2015 Mark H Weaver <mhw@netris.org>
;;; Copyright © 2014 Eric Bavier <bavier@member.fsf.org>
;;; Copyright © 2014, 2015 Eric Bavier <bavier@member.fsf.org>
;;; Copyright © 2015 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2015 Eric Dvorsak <eric@dvorsak.fr>
;;;
@ -413,6 +413,23 @@ provided.")
"16ic8wfwwr3jicaml7b5a0sk6plcgc1kg84w02881yhwmqm3nicb"))))
(build-system gnu-build-system)
(native-inputs `(("pkg-config" ,pkg-config)))
(arguments
`(#:phases (modify-phases %standard-phases
(add-after
'install 'install-fonts-dir
;; The X font server will not add directories to the font
;; path unless they contain a "fonts.dir" file, so add some
;; dummy files.
(lambda* (#:key outputs #:allow-other-keys)
(let ((out (assoc-ref outputs "out")))
(for-each (lambda (d)
(call-with-output-file
(string-append out "/share/fonts/X11"
"/" d "/fonts.dir")
(lambda (p)
(format p "0~%"))))
'("75dpi" "100dpi" "misc" "cyrillic"))
#t))))))
(home-page "http://www.x.org/wiki/")
(synopsis "Xorg font aliases")
(description
@ -3826,6 +3843,34 @@ running on X server.")
(license license:x11)))
(define-public xlsfonts
(package
(name "xlsfonts")
(version "1.0.5")
(source
(origin
(method url-fetch)
(uri (string-append
"mirror://xorg/individual/app/xlsfonts-"
version
".tar.bz2"))
(sha256
(base32
"1yi774g6r1kafsbnxbkrwyndd3i60362ck1fps9ywz076pn5naa0"))))
(build-system gnu-build-system)
(inputs
`(("xproto" ,xproto)
("libx11" ,libx11)))
(native-inputs
`(("pkg-config" ,pkg-config)))
(home-page "http://www.x.org/wiki/")
(synopsis "List fonts available from an X server")
(description
"xlsfonts lists fonts available from an X server via the X11 core
protocol.")
(license license:x11)))
(define-public xmodmap
(package
(name "xmodmap")

4
gnu/services/xorg.scm
View File

@ -89,6 +89,10 @@ EndSection"))
(apply mixed-text-file "xserver.conf" "
Section \"Files\"
FontPath \"" font-alias "/share/fonts/X11/75dpi\"
FontPath \"" font-alias "/share/fonts/X11/100dpi\"
FontPath \"" font-alias "/share/fonts/X11/misc\"
FontPath \"" font-alias "/share/fonts/X11/cyrillic\"
FontPath \"" font-adobe75dpi "/share/fonts/X11/75dpi\"
ModulePath \"" xf86-video-vesa "/lib/xorg/modules/drivers\"
ModulePath \"" xf86-video-fbdev "/lib/xorg/modules/drivers\"

253
guix/gnu-maintenance.scm
View File

@ -29,16 +29,10 @@
#:use-module (system foreign)
#:use-module (guix http-client)
#:use-module (guix ftp-client)
#:use-module (guix ui)
#:use-module (guix utils)
#:use-module (guix records)
#:use-module (guix upstream)
#:use-module (guix packages)
#:use-module ((guix download) #:select (download-to-store))
#:use-module (guix gnupg)
#:use-module (rnrs io ports)
#:use-module (guix base32)
#:use-module ((guix build utils)
#:select (substitute))
#:export (gnu-package-name
gnu-package-mundane-name
gnu-package-copyright-holder
@ -56,21 +50,12 @@
find-packages
gnu-package?
gnu-release?
gnu-release-package
gnu-release-version
gnu-release-directory
gnu-release-files
releases
latest-release
gnu-release-archive-types
gnu-package-name->name+version
download-tarball
package-update-path
package-update
update-package-source))
%gnu-updater))
;;; Commentary:
;;;
@ -218,13 +203,6 @@ network to check in GNU's database."
;;; Latest release.
;;;
(define-record-type* <gnu-release> gnu-release make-gnu-release
gnu-release?
(package gnu-release-package)
(version gnu-release-version)
(directory gnu-release-directory)
(files gnu-release-files))
(define (ftp-server/directory project)
"Return the FTP server and directory where PROJECT's tarball are
stored."
@ -284,29 +262,6 @@ true."
(gnu-package-name->name+version (sans-extension tarball))))
version))
(define (coalesce-releases releases)
"Coalesce the elements of RELEASES that correspond to the same version."
(define (same-version? r1 r2)
(string=? (gnu-release-version r1) (gnu-release-version r2)))
(define (release>? r1 r2)
(version>? (gnu-release-version r1) (gnu-release-version r2)))
(fold (lambda (release result)
(match result
((head . tail)
(if (same-version? release head)
(cons (gnu-release
(inherit release)
(files (append (gnu-release-files release)
(gnu-release-files head))))
tail)
(cons release result)))
(()
(list release))))
'()
(sort releases release>?)))
(define (releases project)
"Return the list of releases of PROJECT as a list of release name/directory
pairs. Example: (\"mit-scheme-9.0.1\" . \"/gnu/mit-scheme/stable.pkg/9.0.1\"). "
@ -319,13 +274,24 @@ pairs. Example: (\"mit-scheme-9.0.1\" . \"/gnu/mit-scheme/stable.pkg/9.0.1\").
(match directories
(()
(ftp-close conn)
(coalesce-releases result))
(coalesce-sources result))
((directory rest ...)
(let* ((files (ftp-list conn directory))
(subdirs (filter-map (match-lambda
((name 'directory . _) name)
(_ #f))
((name 'directory . _) name)
(_ #f))
files)))
(define (file->url file)
(string-append "ftp://" server directory "/" file))
(define (file->source file)
(let ((url (file->url file)))
(upstream-source
(package project)
(version (tarball->version file))
(urls (list url))
(signature-urls (list (string-append url ".sig"))))))
(loop (append (map (cut string-append directory "/" <>)
subdirs)
rest)
@ -335,15 +301,10 @@ pairs. Example: (\"mit-scheme-9.0.1\" . \"/gnu/mit-scheme/stable.pkg/9.0.1\").
;; in /gnu/guile, filter out guile-oops and
;; guile-www; in mit-scheme, filter out binaries.
(filter-map (match-lambda
((file 'file . _)
(if (release-file? project file)
(gnu-release
(package project)
(version (tarball->version file))
(directory directory)
(files (list file)))
#f))
(_ #f))
((file 'file . _)
(and (release-file? project file)
(file->source file)))
(_ #f))
files)
result))))))))
@ -355,7 +316,7 @@ open (resp. close) FTP connections; this can be useful to reuse connections."
(if (version>? a b) a b))
(define (latest-release a b)
(if (version>? (gnu-release-version a) (gnu-release-version b))
(if (version>? (upstream-source-version a) (upstream-source-version b))
a b))
(define contains-digit?
@ -368,6 +329,17 @@ open (resp. close) FTP connections; this can be useful to reuse connections."
(let-values (((server directory) (ftp-server/directory project)))
(define conn (ftp-open server))
(define (file->url file)
(string-append "ftp://" server directory "/" file))
(define (file->source file)
(let ((url (file->url file)))
(upstream-source
(package project)
(version (tarball->version file))
(urls (list url))
(signature-urls (list (string-append url ".sig"))))))
(let loop ((directory directory)
(result #f))
(let* ((entries (ftp-list conn directory))
@ -375,12 +347,12 @@ open (resp. close) FTP connections; this can be useful to reuse connections."
;; Filter out sub-directories that do not contain digits---e.g.,
;; /gnuzilla/lang and /gnupg/patches.
(subdirs (filter-map (match-lambda
(((? patch-directory-name? dir)
'directory . _)
#f)
(((? contains-digit? dir) 'directory . _)
dir)
(_ #f))
(((? patch-directory-name? dir)
'directory . _)
#f)
(((? contains-digit? dir) 'directory . _)
dir)
(_ #f))
entries))
;; Whether or not SUBDIRS is empty, compute the latest releases
@ -390,19 +362,14 @@ open (resp. close) FTP connections; this can be useful to reuse connections."
(releases (filter-map (match-lambda
((file 'file . _)
(and (release-file? project file)
(gnu-release
(package project)
(version
(tarball->version file))
(directory directory)
(files (list file)))))
(file->source file)))
(_ #f))
entries)))
;; Assume that SUBDIRS correspond to versions, and jump into the
;; one with the highest version number.
(let* ((release (reduce latest-release #f
(coalesce-releases releases)))
(coalesce-sources releases)))
(result (if (and result release)
(latest-release release result)
(or release result)))
@ -414,10 +381,18 @@ open (resp. close) FTP connections; this can be useful to reuse connections."
(ftp-close conn)
result)))))))
(define (gnu-release-archive-types release)
"Return the available types of archives for RELEASE---a list of strings such
as \"gz\" or \"xz\"."
(map file-extension (gnu-release-files release)))
(define (latest-release* package)
"Like 'latest-release', but ignore FTP errors that might occur when PACKAGE
is not actually a GNU package, or not hosted on ftp.gnu.org, or not under that
name (this is the case for \"emacs-auctex\", for instance.)"
(catch 'ftp-error
(lambda ()
(latest-release package))
(lambda (key port . rest)
(if (ftp-connection? port)
(ftp-close port)
(close-port port))
#f)))
(define %package-name-rx
;; Regexp for a package name, e.g., "foo-X.Y". Since TeXmacs uses
@ -431,121 +406,15 @@ as \"gz\" or \"xz\"."
(values name+version #f)
(values (match:substring match 1) (match:substring match 2)))))
;;;
;;; Auto-update.
;;;
(define (non-emacs-gnu-package? package)
"Return true if PACKAGE is a non-Emacs GNU package. This excludes AucTeX,
for instance, whose releases are now uploaded to elpa.gnu.org."
(and (not (string-prefix? "emacs-" (package-name package)))
(gnu-package? package)))
(define (package-update-path package)
"Return an update path for PACKAGE, or #f if no update is needed."
(and (gnu-package? package)
(match (latest-release (package-name package))
(($ <gnu-release> name version directory)
(and (version>? version (package-version package))
`(,version . ,directory)))
(_ #f))))
(define* (download-tarball store project directory version
#:key (archive-type "gz")
(key-download 'interactive))
"Download PROJECT's tarball over FTP and check its OpenPGP signature. On
success, return the tarball file name. KEY-DOWNLOAD specifies a download
policy for missing OpenPGP keys; allowed values: 'interactive' (default),
'always', and 'never'."
(let* ((server (ftp-server/directory project))
(base (string-append project "-" version ".tar." archive-type))
(url (string-append "ftp://" server "/" directory "/" base))
(sig-url (string-append url ".sig"))
(tarball (download-to-store store url))
(sig (download-to-store store sig-url)))
(let ((ret (gnupg-verify* sig tarball #:key-download key-download)))
(if ret
tarball
(begin
(warning (_ "signature verification failed for `~a'~%")
base)
(warning (_ "(could be because the public key is not in your keyring)~%"))
#f)))))
(define* (package-update store package #:key (key-download 'interactive))
"Return the new version and the file name of the new version tarball for
PACKAGE, or #f and #f when PACKAGE is up-to-date. KEY-DOWNLOAD specifies a
download policy for missing OpenPGP keys; allowed values: 'always', 'never',
and 'interactive' (default)."
(match (package-update-path package)
((version . directory)
(let-values (((name)
(package-name package))
((archive-type)
(let ((source (package-source package)))
(or (and (origin? source)
(file-extension (origin-uri source)))
"gz"))))
(let ((tarball (download-tarball store name directory version
#:archive-type archive-type
#:key-download key-download)))
(values version tarball))))
(_
(values #f #f))))
(define (update-package-source package version hash)
"Modify the source file that defines PACKAGE to refer to VERSION,
whose tarball has SHA256 HASH (a bytevector). Return the new version string
if an update was made, and #f otherwise."
(define (new-line line matches replacement)
;; Iterate over MATCHES and return the modified line based on LINE.
;; Replace each match with REPLACEMENT.
(let loop ((m* matches) ; matches
(o 0) ; offset in L
(r '())) ; result
(match m*
(()
(let ((r (cons (substring line o) r)))
(string-concatenate-reverse r)))
((m . rest)
(loop rest
(match:end m)
(cons* replacement
(substring line o (match:start m))
r))))))
(define (update-source file old-version version
old-hash hash)
;; Update source file FILE, replacing occurrences OLD-VERSION by VERSION
;; and occurrences of OLD-HASH by HASH (base32 representation thereof).
;; TODO: Currently this is a bit of a sledgehammer: if VERSION occurs in
;; different unrelated places, we may modify it more than needed, for
;; instance. We should try to make changes only within the sexp that
;; corresponds to the definition of PACKAGE.
(let ((old-hash (bytevector->nix-base32-string old-hash))
(hash (bytevector->nix-base32-string hash)))
(substitute file
`((,(regexp-quote old-version)
. ,(cut new-line <> <> version))
(,(regexp-quote old-hash)
. ,(cut new-line <> <> hash))))
version))
(let ((name (package-name package))
(loc (package-field-location package 'version)))
(if loc
(let ((old-version (package-version package))
(old-hash (origin-sha256 (package-source package)))
(file (and=> (location-file loc)
(cut search-path %load-path <>))))
(if file
(update-source file
old-version version
old-hash hash)
(begin
(warning (_ "~a: could not locate source file")
(location-file loc))
#f)))
(begin
(format (current-error-port)
(_ "~a: ~a: no `version' field in source; skipping~%")
(location->string (package-location package))
name)))))
(define %gnu-updater
(upstream-updater 'gnu
non-emacs-gnu-package?
latest-release*))
;;; gnu-maintenance.scm ends here

2
guix/http-client.scm
View File

@ -241,7 +241,7 @@ Raise an '&http-get-error' condition if downloading fails."
;;; Caching.
;;;
(define (%http-cache-ttl)
(define %http-cache-ttl
;; Time-to-live in seconds of the HTTP cache of in ~/.cache/guix.
(make-parameter
(* 3600 (or (and=> (getenv "GUIX_HTTP_CACHE_TTL")

85
guix/import/cran.scm
View File

@ -1,5 +1,6 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2015 Ricardo Wurmus <rekado@elephly.net>
;;; Copyright © 2015 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
@ -20,6 +21,7 @@
#:use-module (ice-9 match)
#:use-module (ice-9 regex)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-26)
#:use-module (sxml simple)
#:use-module (sxml match)
#:use-module (sxml xpath)
@ -29,7 +31,10 @@
#:use-module (guix base32)
#:use-module ((guix download) #:select (download-to-store))
#:use-module (guix import utils)
#:export (cran->guix-package))
#:use-module (guix upstream)
#:use-module (guix packages)
#:export (cran->guix-package
%cran-updater))
;;; Commentary:
;;;
@ -89,7 +94,7 @@ first cell of a table row is considered a label cell."
"Return an sxml representation of the CRAN page for the R package NAME,
or #f on failure. NAME is case-sensitive."
;; This API always returns the latest release of the module.
(let ((cran-url (string-append %cran-url name)))
(let ((cran-url (string-append %cran-url name "/")))
(false-if-exception
(xml->sxml (http-fetch cran-url)
#:trim-whitespace? #t
@ -108,12 +113,25 @@ or #f on failure. NAME is case-sensitive."
name)
(symbol->string name))))))))
(define (downloads->url downloads)
"Extract from DOWNLOADS, the downloads item of the CRAN sxml tree, the
download URL."
(string-append "mirror://cran/"
;; Remove double dots, because we want an
;; absolute path.
(regexp-substitute/global
#f "\\.\\./"
(string-join ((sxpath '((xhtml:a 1) @ href *text*))
(table-datum downloads " Package source: ")))
'pre 'post)))
(define (nodes->text nodeset)
"Return the concatenation of the text nodes among NODESET."
(string-join ((sxpath '(// *text*)) nodeset) " "))
(define (cran-sxml->sexp sxml)
"Return the `package' s-expression for a CRAN package from the SXML
representation of the package page."
(define (nodes->text nodeset)
(string-join ((sxpath '(// *text*)) nodeset) " "))
(define (guix-name name)
(if (string-prefix? "r-" name)
(string-downcase name)
@ -136,16 +154,7 @@ representation of the package page."
(table-datum summary "License:")))
(home-page (nodes->text ((sxpath '((xhtml:a 1)))
(table-datum summary "URL:"))))
(source-url (string-append "mirror://cran/"
;; Remove double dots, because we want an
;; absolute path.
(regexp-substitute/global
#f "\\.\\./"
(string-join
((sxpath '((xhtml:a 1) @ href *text*))
(table-datum downloads
" Package source: ")))
'pre 'post)))
(source-url (downloads->url downloads))
(tarball (with-store store (download-to-store store source-url)))
(sysdepends (map match:substring
(list-matches
@ -186,3 +195,49 @@ representation of the package page."
`package' s-expression corresponding to that package, or #f on failure."
(let ((module-meta (cran-fetch package-name)))
(and=> module-meta cran-sxml->sexp)))
;;;
;;; Updater.
;;;
(define (latest-release package)
"Return an <upstream-source> for the latest release of PACKAGE."
(define name
(if (string-prefix? "r-" package)
(string-drop package 2)
package))
(define sxml
(cran-fetch name))
(and sxml
(sxml-match-let*
(((*TOP* (xhtml:html
,head
(xhtml:body
(xhtml:h2 ,name-and-synopsis)
(xhtml:p ,description)
,summary
(xhtml:h4 "Downloads:") ,downloads
. ,rest)))
sxml))
(let ((version (nodes->text (table-datum summary "Version:")))
(url (downloads->url downloads)))
;; CRAN does not provide signatures.
(upstream-source
(package package)
(version version)
(urls (list url)))))))
(define (cran-package? package)
"Return true if PACKAGE is an R package from CRAN."
;; Assume all R packages are available on CRAN.
(string-prefix? "r-" (package-name package)))
(define %cran-updater
(upstream-updater 'cran
cran-package?
latest-release))
;;; cran.scm ends here

63
guix/import/elpa.scm
View File

@ -1,5 +1,6 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2015 Federico Beffa <beffa@fbengineering.ch>
;;; Copyright © 2015 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
@ -19,6 +20,7 @@
(define-module (guix import elpa)
#:use-module (ice-9 match)
#:use-module (ice-9 rdelim)
#:use-module (web uri)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-9)
#:use-module (srfi srfi-9 gnu)
@ -26,13 +28,17 @@
#:use-module (srfi srfi-26)
#:use-module ((guix download) #:select (download-to-store))
#:use-module (guix import utils)
#:use-module (guix http-client)
#:use-module (guix store)
#:use-module (guix ui)
#:use-module (guix hash)
#:use-module (guix base32)
#:use-module (guix upstream)
#:use-module (guix packages)
#:use-module ((guix utils) #:select (call-with-temporary-output-file
memoize))
#:export (elpa->guix-package))
#:export (elpa->guix-package
%elpa-updater))
(define (elpa-dependencies->names deps)
"Convert DEPS, a list of symbol/version pairs à la ELPA, to a list of
@ -74,20 +80,16 @@ NAMES (strings)."
(let ((url (and=> (elpa-url repo)
(cut string-append <> "/archive-contents"))))
(if url
(call-with-downloaded-file url read)
;; Use a relatively small TTL for the archive itself.
(parameterize ((%http-cache-ttl (* 6 3600)))
(call-with-downloaded-file url read))
(leave (_ "~A: currently not supported~%") repo))))
(define* (call-with-downloaded-file url proc #:optional (error-thunk #f))
"Fetch URL, store the content in a temporary file and call PROC with that
file. Returns the value returned by PROC. On error call ERROR-THUNK and
return its value or leave if it's false."
(call-with-temporary-output-file
(lambda (temp port)
(or (and (url-fetch url temp)
(call-with-input-file temp proc))
(if error-thunk
(error-thunk)
(leave (_ "~A: download failed~%") url))))))
(proc (http-fetch/cached (string->uri url))))
(define (is-elpa-package? name elpa-pkg-spec)
"Return true if the string NAME corresponds to the name of the package
@ -231,4 +233,47 @@ type '<elpa-package>'."
(let ((pkg (fetch-elpa-package name repo)))
(and=> pkg elpa-package->sexp)))
;;;
;;; Updates.
;;;
(define (latest-release package)
"Return an <upstream-release> for the latest release of PACKAGE. PACKAGE
may be a Guix package name such as \"emacs-debbugs\" or an upstream name such
as \"debbugs\"."
(define name
(if (string-prefix? "emacs-" package)
(string-drop package 6)
package))
(let* ((repo 'gnu)
(info (elpa-package-info name repo))
(version (match info
((name raw-version . _)
(elpa-version->string raw-version))))
(url (match info
((_ raw-version reqs synopsis kind . rest)
(package-source-url kind name version repo)))))
(upstream-source
(package package)
(version version)
(urls (list url))
(signature-urls (list (string-append url ".sig"))))))
(define (package-from-gnu.org? package)
"Return true if PACKAGE is from elpa.gnu.org."
(match (and=> (package-source package) origin-uri)
((? string? uri)
(let ((uri (string->uri uri)))
(and uri (string=? (uri-host uri) "elpa.gnu.org"))))
(_ #f)))
(define %elpa-updater
;; The ELPA updater. We restrict it to packages hosted on elpa.gnu.org
;; because for other repositories, we typically grab the source elsewhere.
(upstream-updater 'elpa
package-from-gnu.org?
latest-release))
;;; elpa.scm ends here

44
guix/import/hackage.scm
View File

@ -32,37 +32,35 @@
#:export (hackage->guix-package))
(define ghc-standard-libraries
;; List of libraries distributed with ghc (7.8.4). We include GHC itself as
;; List of libraries distributed with ghc (7.10.2). We include GHC itself as
;; some packages list it.
'("ghc"
"haskell98"
"hoopl"
'("array"
"base"
"transformers"
"deepseq"
"array"
"bin-package-db"
"binary"
"bytestring"
"cabal" ;; in the output of `ghc-pkg list` Cabal is uppercased, but
;; hackage-name->package-name takes this into account.
"containers"
"time"
"cabal"
"bin-package-db"
"ghc-prim"
"integer-gmp"
"integer-simple"
"win32"
"template-haskell"
"process"
"haskeline"
"terminfo"
"deepseq"
"directory"
"filepath"
"old-locale"
"unix"
"old-time"
"ghc"
"ghc-prim"
"haskeline"
"hoopl"
"hpc"
"integer-gmp"
"pretty"
"xhtml"
"hpc"))
"process"
"rts"
"template-haskell"
"terminfo"
"time"
"transformers"
"unix"
"win32"
"xhtml"))
(define package-name-prefix "ghc-")

2
guix/scripts/import/hackage.scm
View File

@ -55,7 +55,7 @@ version.\n"))
(display (_ "
-s, --stdin read from standard input"))
(display (_ "
-t, --no-test-dependencies don't include test only dependencies"))
-t, --no-test-dependencies don't include test-only dependencies"))
(display (_ "
-V, --version display version information and exit"))
(newline)

94
guix/scripts/refresh.scm
View File

@ -25,7 +25,10 @@
#:use-module (guix store)
#:use-module (guix utils)
#:use-module (guix packages)
#:use-module (guix gnu-maintenance)
#:use-module (guix upstream)
#:use-module ((guix gnu-maintenance) #:select (%gnu-updater))
#:use-module (guix import elpa)
#:use-module (guix import cran)
#:use-module (guix gnupg)
#:use-module (gnu packages)
#:use-module ((gnu packages commencement) #:select (%final-inputs))
@ -63,6 +66,9 @@
(x
(leave (_ "~a: invalid selection; expected `core' or `non-core'~%")
arg)))))
(option '(#\t "type") #t #f
(lambda (opt name arg result)
(alist-cons 'updater (string->symbol arg) result)))
(option '(#\l "list-dependent") #f #f
(lambda (opt name arg result)
(alist-cons 'list-dependent? #t result)))
@ -104,6 +110,8 @@ specified with `--select'.\n"))
-s, --select=SUBSET select all the packages in SUBSET, one of
`core' or `non-core'"))
(display (_ "
-t, --type=UPDATER restrict to updates from UPDATER--e.g., 'gnu'"))
(display (_ "
-l, --list-dependent list top-level dependent packages that would need to
be rebuilt as a result of upgrading PACKAGE..."))
(newline)
@ -124,19 +132,33 @@ specified with `--select'.\n"))
(newline)
(show-bug-report-information))
(define* (update-package store package #:key (key-download 'interactive))
;;;
;;; Updates.
;;;
(define %updaters
;; List of "updaters" used by default. They are consulted in this order.
(list %gnu-updater
%elpa-updater
%cran-updater))
(define (lookup-updater name)
"Return the updater called NAME."
(find (lambda (updater)
(eq? name (upstream-updater-name updater)))
%updaters))
(define* (update-package store package updaters
#:key (key-download 'interactive))
"Update the source file that defines PACKAGE with the new version.
KEY-DOWNLOAD specifies a download policy for missing OpenPGP keys; allowed
values: 'interactive' (default), 'always', and 'never'."
(let-values (((version tarball)
(catch #t
(lambda ()
(package-update store package #:key-download key-download))
(lambda _
(values #f #f))))
(package-update store package updaters
#:key-download key-download))
((loc)
(or (package-field-location package
'version)
(or (package-field-location package 'version)
(package-location package))))
(when version
(if (and=> tarball file-exists?)
@ -153,7 +175,6 @@ values: 'interactive' (default), 'always', and 'never'."
downloaded and authenticated; not updating~%")
(package-name package) version)))))
;;;
;;; Entry point.
@ -169,6 +190,19 @@ downloaded and authenticated; not updating~%")
(alist-cons 'argument arg result))
%default-options))
(define (options->updaters opts)
;; Return the list of updaters to use.
(match (filter-map (match-lambda
(('updater . name)
(lookup-updater name))
(_ #f))
opts)
(()
;; Use the default updaters.
%updaters)
(lst
lst)))
(define (keep-newest package lst)
;; If a newer version of PACKAGE is already in LST, return LST; otherwise
;; return LST minus the other version of PACKAGE in it, plus PACKAGE.
@ -185,8 +219,8 @@ downloaded and authenticated; not updating~%")
(define core-package?
(let* ((input->package (match-lambda
((name (? package? package) _ ...) package)
(_ #f)))
((name (? package? package) _ ...) package)
(_ #f)))
(final-inputs (map input->package %final-inputs))
(core (append final-inputs
(append-map (compose (cut filter-map input->package <>)
@ -205,6 +239,7 @@ update would trigger a complete rebuild."
(let* ((opts (parse-options))
(update? (assoc-ref opts 'update?))
(updaters (options->updaters opts))
(list-dependent? (assoc-ref opts 'list-dependent?))
(key-download (assoc-ref opts 'key-download))
(packages
@ -215,18 +250,18 @@ update would trigger a complete rebuild."
(specification->package spec))
(_ #f))
opts)
(() ; default to all packages
(let ((select? (match (assoc-ref opts 'select)
('core core-package?)
('non-core (negate core-package?))
(_ (const #t)))))
(fold-packages (lambda (package result)
(if (select? package)
(keep-newest package result)
result))
'())))
(some ; user-specified packages
some))))
(() ; default to all packages
(let ((select? (match (assoc-ref opts 'select)
('core core-package?)
('non-core (negate core-package?))
(_ (const #t)))))
(fold-packages (lambda (package result)
(if (select? package)
(keep-newest package result)
result))
'())))
(some ; user-specified packages
some))))
(with-error-handling
(cond
(list-dependent?
@ -258,18 +293,19 @@ dependent packages are rebuilt: ~{~a~^ ~}~%"
(or (assoc-ref opts 'gpg-command)
(%gpg-command))))
(for-each
(cut update-package store <> #:key-download key-download)
(cut update-package store <> updaters
#:key-download key-download)
packages))))
(else
(for-each (lambda (package)
(match (false-if-exception (package-update-path package))
((new-version . directory)
(match (package-update-path package updaters)
((? upstream-source? source)
(let ((loc (or (package-field-location package 'version)
(package-location package))))
(format (current-error-port)
(_ "~a: ~a would be upgraded from ~a to ~a~%")
(location->string loc)
(package-name package) (package-version package)
new-version)))
(_ #f)))
(upstream-source-version source))))
(#f #f)))
packages))))))

259
guix/upstream.scm Normal file
View File

@ -0,0 +1,259 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2010, 2011, 2012, 2013, 2014, 2015 Ludovic Courtès <ludo@gnu.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 upstream)
#:use-module (guix records)
#:use-module (guix utils)
#:use-module ((guix download)
#:select (download-to-store))
#:use-module ((guix build utils)
#:select (substitute))
#:use-module (guix gnupg)
#:use-module (guix packages)
#:use-module (guix ui)
#:use-module (guix base32)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-9)
#:use-module (srfi srfi-11)
#:use-module (srfi srfi-26)
#:use-module (ice-9 match)
#:use-module (ice-9 regex)
#:export (upstream-source
upstream-source?
upstream-source-package
upstream-source-version
upstream-source-urls
upstream-source-signature-urls
coalesce-sources
upstream-updater
upstream-updater?
upstream-updater-name
upstream-updater-predicate
upstream-updater-latest
download-tarball
package-update-path
package-update
update-package-source))
;;; Commentary:
;;;
;;; This module provides tools to represent and manipulate a upstream source
;;; code, and to auto-update package recipes.
;;;
;;; Code:
;; Representation of upstream's source. There can be several URLs--e.g.,
;; tar.gz, tar.gz, etc. There can be correspond signature URLs, one per
;; source URL.
(define-record-type* <upstream-source>
upstream-source make-upstream-source
upstream-source?
(package upstream-source-package) ;string
(version upstream-source-version) ;string
(urls upstream-source-urls) ;list of strings
(signature-urls upstream-source-signature-urls ;#f | list of strings
(default #f)))
(define (upstream-source-archive-types release)
"Return the available types of archives for RELEASE---a list of strings such
as \"gz\" or \"xz\"."
(map file-extension (upstream-source-urls release)))
(define (coalesce-sources sources)
"Coalesce the elements of SOURCES, a list of <upstream-source>, that
correspond to the same version."
(define (same-version? r1 r2)
(string=? (upstream-source-version r1) (upstream-source-version r2)))
(define (release>? r1 r2)
(version>? (upstream-source-version r1) (upstream-source-version r2)))
(fold (lambda (release result)
(match result
((head . tail)
(if (same-version? release head)
(cons (upstream-source
(inherit release)
(urls (append (upstream-source-urls release)
(upstream-source-urls head)))
(signature-urls
(append (upstream-source-signature-urls release)
(upstream-source-signature-urls head))))
tail)
(cons release result)))
(()
(list release))))
'()
(sort sources release>?)))
;;;
;;; Auto-update.
;;;
(define-record-type <upstream-updater>
(upstream-updater name pred latest)
upstream-updater?
(name upstream-updater-name)
(pred upstream-updater-predicate)
(latest upstream-updater-latest))
(define (lookup-updater package updaters)
"Return an updater among UPDATERS that matches PACKAGE, or #f if none of
them matches."
(any (match-lambda
(($ <upstream-updater> _ pred latest)
(and (pred package) latest)))
updaters))
(define (package-update-path package updaters)
"Return an upstream source to update PACKAGE to, or #f if no update is
needed or known."
(match (lookup-updater package updaters)
((? procedure? latest-release)
(match (latest-release (package-name package))
((and source ($ <upstream-source> name version))
(and (version>? version (package-version package))
source))
(_ #f)))
(#f #f)))
(define* (download-tarball store url signature-url
#:key (key-download 'interactive))
"Download the tarball at URL to the store; check its OpenPGP signature at
SIGNATURE-URL, unless SIGNATURE-URL is false. On success, return the tarball
file name. KEY-DOWNLOAD specifies a download policy for missing OpenPGP keys;
allowed values: 'interactive' (default), 'always', and 'never'."
(let ((tarball (download-to-store store url)))
(if (not signature-url)
tarball
(let* ((sig (download-to-store store signature-url))
(ret (gnupg-verify* sig tarball #:key-download key-download)))
(if ret
tarball
(begin
(warning (_ "signature verification failed for `~a'~%")
url)
(warning (_ "(could be because the public key is not in your keyring)~%"))
#f))))))
(define (find2 pred lst1 lst2)
"Like 'find', but operate on items from both LST1 and LST2. Return two
values: the item from LST1 and the item from LST2 that match PRED."
(let loop ((lst1 lst1) (lst2 lst2))
(match lst1
((head1 . tail1)
(match lst2
((head2 . tail2)
(if (pred head1 head2)
(values head1 head2)
(loop tail1 tail2)))))
(()
(values #f #f)))))
(define* (package-update store package updaters
#:key (key-download 'interactive))
"Return the new version and the file name of the new version tarball for
PACKAGE, or #f and #f when PACKAGE is up-to-date. KEY-DOWNLOAD specifies a
download policy for missing OpenPGP keys; allowed values: 'always', 'never',
and 'interactive' (default)."
(match (package-update-path package updaters)
(($ <upstream-source> _ version urls signature-urls)
(let*-values (((name)
(package-name package))
((archive-type)
(match (and=> (package-source package) origin-uri)
((? string? uri)
(or (file-extension uri) "gz"))
(_
"gz")))
((url signature-url)
(find2 (lambda (url sig-url)
(string-suffix? archive-type url))
urls
(or signature-urls (circular-list #f)))))
(let ((tarball (download-tarball store url signature-url
#:key-download key-download)))
(values version tarball))))
(#f
(values #f #f))))
(define (update-package-source package version hash)
"Modify the source file that defines PACKAGE to refer to VERSION,
whose tarball has SHA256 HASH (a bytevector). Return the new version string
if an update was made, and #f otherwise."
(define (new-line line matches replacement)
;; Iterate over MATCHES and return the modified line based on LINE.
;; Replace each match with REPLACEMENT.
(let loop ((m* matches) ; matches
(o 0) ; offset in L
(r '())) ; result
(match m*
(()
(let ((r (cons (substring line o) r)))
(string-concatenate-reverse r)))
((m . rest)
(loop rest
(match:end m)
(cons* replacement
(substring line o (match:start m))
r))))))
(define (update-source file old-version version
old-hash hash)
;; Update source file FILE, replacing occurrences OLD-VERSION by VERSION
;; and occurrences of OLD-HASH by HASH (base32 representation thereof).
;; TODO: Currently this is a bit of a sledgehammer: if VERSION occurs in
;; different unrelated places, we may modify it more than needed, for
;; instance. We should try to make changes only within the sexp that
;; corresponds to the definition of PACKAGE.
(let ((old-hash (bytevector->nix-base32-string old-hash))
(hash (bytevector->nix-base32-string hash)))
(substitute file
`((,(regexp-quote old-version)
. ,(cut new-line <> <> version))
(,(regexp-quote old-hash)
. ,(cut new-line <> <> hash))))
version))
(let ((name (package-name package))
(loc (package-field-location package 'version)))
(if loc
(let ((old-version (package-version package))
(old-hash (origin-sha256 (package-source package)))
(file (and=> (location-file loc)
(cut search-path %load-path <>))))
(if file
(update-source file
old-version version
old-hash hash)
(begin
(warning (_ "~a: could not locate source file")
(location-file loc))
#f)))
(begin
(format (current-error-port)
(_ "~a: ~a: no `version' field in source; skipping~%")
(location->string (package-location package))
name)))))
;;; upstream.scm ends here

2
po/guix/POTFILES.in
View File

@ -23,7 +23,7 @@ guix/scripts/edit.scm
guix/scripts/size.scm
guix/scripts/graph.scm
guix/scripts/challenge.scm
guix/gnu-maintenance.scm
guix/upstream.scm
guix/ui.scm
guix/http-client.scm
guix/nar.scm