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

Merge branch 'master' into core-updates

This commit is contained in:
Mark H Weaver 2014-03-22 11:19:19 -04:00
parent b1a01474ac 6212b8e5d3
commit 1eefbb2693
25 changed files with 343 additions and 75 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
gnu-system.am
View File

@ -89,6 +89,7 @@ GNU_SYSTEM_MODULES = \
gnu/packages/gnome.scm \
gnu/packages/gnunet.scm \
gnu/packages/gnupg.scm \
gnu/packages/gnustep.scm \
gnu/packages/gnutls.scm \
gnu/packages/gnuzilla.scm \
gnu/packages/gnu-pw-mgr.scm \

8
gnu/packages/admin.scm
View File

@ -1,6 +1,7 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2012, 2013, 2014 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2013 Cyril Roelandt <tipecaml@gmail.com>
;;; Copyright © 2014 Mark H Weaver <mhw@netris.org>
;;;
;;; This file is part of GNU Guix.
;;;
@ -317,6 +318,13 @@ ONC RPC numbers")
(base32
"1frjcdkhkpzk0f84hx6hmw5l0ynpmji8vcbaxg8h5k2svyxz0nmm"))))
(build-system gnu-build-system)
(arguments
`(#:configure-flags
;; By default, man and info pages are put in PREFIX/{man,info},
;; but we want them in PREFIX/share/{man,info}.
(let ((out (assoc-ref %outputs "out")))
(list (string-append "--mandir=" out "/share/man")
(string-append "--infodir=" out "/share/info")))))
(home-page "http://netcat.sourceforge.net")
(synopsis "Read and write data over TCP/IP")
(description

11
gnu/packages/algebra.scm
View File

@ -1,6 +1,7 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2012, 2013 Andreas Enge <andreas@enge.fr>
;;; Copyright © 2013 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2014 Mark H Weaver <mhw@netris.org>
;;;
;;; This file is part of GNU Guix.
;;;
@ -179,8 +180,14 @@ GP2C, the GP to C compiler, translates GP scripts to PARI programs.")
(let ((out (assoc-ref outputs "out")))
(setenv "CONFIG_SHELL" (which "bash"))
(zero?
(system* "./configure"
(string-append "--prefix=" out)))))
(system*
"./configure"
(string-append "--prefix=" out)
;; By default, man and info pages are put in
;; PREFIX/{man,info}, but we want them in
;; PREFIX/share/{man,info}.
(string-append "--mandir=" out "/share/man")
(string-append "--infodir=" out "/share/info")))))
%standard-phases)))
(home-page "http://www.gnu.org/software/bc/")
(synopsis "Arbitrary precision numeric processing language")

7
gnu/packages/base.scm
View File

@ -1,6 +1,7 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2012, 2013, 2014 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2012 Nikita Karetnikov <nikita@karetnikov.org>
;;; Copyright © 2014 Mark H Weaver <mhw@netris.org>
;;;
;;; This file is part of GNU Guix.
;;;
@ -500,7 +501,7 @@ with the Linux kernel.")
(define-public tzdata
(package
(name "tzdata")
(version "2013d")
(version "2014a")
(source (origin
(method url-fetch)
(uri (string-append
@ -508,7 +509,7 @@ with the Linux kernel.")
version ".tar.gz"))
(sha256
(base32
"011v63ppr73vhjgxv00inkn5pc7z48i8lhbapkpdq3kfczq9c76d"))))
"1cg843ajz4g16axpz56zvalwsbp1s764na2bk4fb44ayx162bzvw"))))
(build-system gnu-build-system)
(arguments
'(#:tests? #f
@ -555,7 +556,7 @@ with the Linux kernel.")
version ".tar.gz"))
(sha256
(base32
"1dh7nzmfxs8fps4bzcd2lz5fz24zxy2123a99avxsk34jh6bk7id"))))))
"1xfkqi1q8cnxqbv8azdj5pqlzhkjz6xag09f1z0s8rxi86jkpf85"))))))
(home-page "http://www.iana.org/time-zones")
(synopsis "Database of current and historical time zones")
(description "The Time Zone Database (often called tz or zoneinfo)

26
gnu/packages/cmake.scm
View File

@ -1,5 +1,6 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2013 Cyril Roelandt <tipecaml@gmail.com>
;;; Copyright © 2014 Mark H Weaver <mhw@netris.org>
;;;
;;; This file is part of GNU Guix.
;;;
@ -22,7 +23,8 @@
#:use-module (guix download)
#:use-module (guix build-system gnu)
#:use-module (gnu packages)
#:use-module (gnu packages file))
#:use-module (gnu packages file)
#:use-module (srfi srfi-1))
(define-public cmake
(package
@ -32,15 +34,15 @@
(method url-fetch)
(uri (string-append
"http://www.cmake.org/files/v"
(substring version 0
(string-index version #\. (+ 1 (string-index version #\.))))
(string-join (take (string-split version #\.) 2)
".")
"/cmake-" version ".tar.gz"))
(sha256
(base32 "11q21vyrr6c6smyjy81k2k07zmn96ggjia9im9cxwvj0n88bm1fq"))
(patches (list (search-patch "cmake-fix-tests.patch")))))
(build-system gnu-build-system)
(arguments
'(#:test-target "test"
`(#:test-target "test"
#:phases (alist-replace
'configure
(lambda* (#:key outputs #:allow-other-keys)
@ -61,8 +63,20 @@
"Utilities/cmlibarchive/libarchive/archive_write_set_format_shar.c"
"Tests/CMakeLists.txt")
(("/bin/sh") (which "sh")))
(zero? (system* "./configure"
(string-append "--prefix=" out)))))
(zero? (system*
"./configure"
(string-append "--prefix=" out)
;; By default, the man pages and other docs land
;; in PREFIX/man and PREFIX/doc, but we want them
;; in share/{man,doc}. Note that unlike
;; autoconf-generated configure scripts, cmake's
;; configure prepends "PREFIX/" to what we pass
;; to --mandir and --docdir.
"--mandir=share/man"
,(string-append
"--docdir=share/doc/cmake-"
(string-join (take (string-split version #\.) 2)
"."))))))
%standard-phases)))
(inputs
`(("file" ,file)))

71
gnu/packages/gnustep.scm Normal file
View File

@ -0,0 +1,71 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2014 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 (gnu packages gnustep)
#:use-module (guix download)
#:use-module (guix packages)
#:use-module (guix build-system gnu)
#:use-module (guix licenses)
#:use-module (gnu packages xorg)
#:use-module (gnu packages fontutils)
#:use-module (gnu packages libjpeg)
#:use-module (gnu packages pkg-config))
(define-public windowmaker
(package
(name "windowmaker")
(version "0.95.5")
(source (origin
(method url-fetch)
(uri (string-append
"http://windowmaker.org/pub/source/release/WindowMaker-"
version ".tar.gz"))
(sha256
(base32
"1l3hmx4jzf6vp0zclqx9gsqrlwh4rvqm1g1zr5ha0cp0zmsg89ab"))))
(build-system gnu-build-system)
(arguments
'(#:phases (alist-cons-after
'install 'wrap
(lambda* (#:key outputs #:allow-other-keys)
(let* ((out (assoc-ref outputs "out"))
(bin (string-append out "/bin")))
;; 'wmaker' wants to invoke 'wmaker.inst' the first time,
;; which in turn wants to invoke 'wmmenugen' etc., so
;; make sure everything is in $PATH.
(wrap-program (string-append bin "/wmaker")
`("PATH" ":" prefix (,bin)))))
%standard-phases)))
(inputs
`(("libxmu" ,libxmu)
("libxft" ,libxft)
("libx11" ,libx11)
("fontconfig" ,fontconfig)
("libjpeg" ,libjpeg)))
(native-inputs
`(("pkg-config" ,pkg-config)))
(home-page "http://windowmaker.org/")
(synopsis "NeXTSTEP-like window manager")
(description
"Window Maker is an X11 window manager originally designed to provide
integration support for the GNUstep Desktop Environment. In every way
possible, it reproduces the elegant look and feel of the NeXTSTEP user
interface. It is fast, feature rich, easy to configure, and easy to use.")
;; Artwork is distributed under the WTFPL.
(license gpl2+)))

6
gnu/packages/imagemagick.scm
View File

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2013 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2013, 2014 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
@ -37,14 +37,14 @@
(define-public imagemagick
(package
(name "imagemagick")
(version "6.8.8-4")
(version "6.8.8-8")
(source (origin
(method url-fetch)
(uri (string-append "mirror://imagemagick/ImageMagick-"
version ".tar.xz"))
(sha256
(base32
"0bfxhfymkdbvardlr0nbjfmv53m47lcl9kkycipk4hxawfs927jr"))))
"1b1j4j6gyxd02nm7v70d8prjvh09dk9klralrr8avm9ys1wqd7r4"))))
(build-system gnu-build-system)
(arguments
`(#:phases (alist-cons-before

4
gnu/packages/lua.scm
View File

@ -66,13 +66,13 @@ for configuration, scripting, and rapid prototyping.")
(define-public luajit
(package
(name "luajit")
(version "2.0.2")
(version "2.0.3")
(source (origin
(method url-fetch)
(uri (string-append "http://luajit.org/download/LuaJIT-"
version ".tar.gz"))
(sha256
(base32 "0f3cykihfdn3gi6na9p0xjd4jnv26z18m441n5vyg42q9abh4ln0"))))
(base32 "0ydxpqkmsn2c341j4r2v6r5r0ig3kbwv3i9jran3iv81s6r6rgjm"))))
(build-system gnu-build-system)
(arguments
'(#:tests? #f ;luajit is distributed without tests

10
gnu/packages/lynx.scm
View File

@ -33,13 +33,15 @@
(define-public lynx
(package
(name "lynx")
(version "2.8.8")
(version "2.8.8rel.2")
(source (origin
(method url-fetch)
(uri (string-append "http://lynx.isc.org/lynx" version
"/lynx" version ".tar.bz2"))
(uri (string-append
"http://lynx.isc.org/lynx"
(substring version 0 (string-index version char-set:letter))
"/lynx" version ".tar.bz2"))
(sha256
(base32 "00jcfmx4bxnrzywzzlllz3z45a2mc4fl91ca5lrzz1pyr1s1qnm2"))))
(base32 "1rxysl08acqll5b87368f04kckl8sggy1qhnq59gsxyny1ffg039"))))
(build-system gnu-build-system)
(native-inputs `(("pkg-config" ,pkg-config)
("perl" ,perl)))

8
gnu/packages/screen.scm
View File

@ -1,5 +1,6 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2013 Cyril Roelandt <tipecaml@gmail.com>
;;; Copyright © 2014 Mark H Weaver <mhw@netris.org>
;;;
;;; This file is part of GNU Guix.
;;;
@ -39,6 +40,13 @@
(inputs
`(("ncurses", ncurses)
("perl" ,perl)))
(arguments
`(#:configure-flags
;; By default, man and info pages are put in PREFIX/{man,info},
;; but we want them in PREFIX/share/{man,info}.
(let ((out (assoc-ref %outputs "out")))
(list (string-append "--mandir=" out "/share/man")
(string-append "--infodir=" out "/share/info")))))
(home-page "http://www.gnu.org/software/screen/")
(synopsis "Full-screen window manager providing multiple terminals")
(description

5
gnu/packages/ssh.scm
View File

@ -1,5 +1,6 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2013 Andreas Enge <andreas@enge.fr>
;;; Copyright © 2014 Mark H Weaver <mhw@netris.org>
;;;
;;; This file is part of GNU Guix.
;;;
@ -121,14 +122,14 @@ a server that supports the SSH-2 protocol.")
(define-public openssh
(package
(name "openssh")
(version "6.5p1")
(version "6.6p1")
(source (origin
(method url-fetch)
(uri (string-append
"ftp://ftp.fr.openbsd.org/pub/OpenBSD/OpenSSH/portable/openssh-"
version ".tar.gz"))
(sha256 (base32
"09wh7mi65aahyxd2xvq1makckhd5laid8c0pb8njaidrbpamw6d1"))))
"1fq3w86q05y5nn6z878wm312k0svaprw8k007188fd259dkg1ha8"))))
(build-system gnu-build-system)
(inputs `(("groff" ,groff)
("openssl" ,openssl)

11
gnu/packages/xiph.scm
View File

@ -3,6 +3,7 @@
;;; Copyright © 2013 Nikita Karetnikov <nikita@karetnikov.org>
;;; Copyright © 2013 David Thompson <dthompson2@worcester.edu>
;;; Copyright © 2014 Sree Harsha Totakura <sreeharsha@totakura.in>
;;; Copyright © 2014 Mark H Weaver <mhw@netris.org>
;;;
;;; This file is part of GNU Guix.
;;;
@ -80,7 +81,8 @@ periodic timestamps for seeking.")
"1gby6hapz9njx4l9g0pndyk4q83z5fgrgc30mfwfgx7bllspsk43"))))
(build-system gnu-build-system)
(propagated-inputs `(("libogg" ,libogg)))
(arguments `(#:configure-flags '("LDFLAGS=-lm")))
(arguments `(#:configure-flags '("LDFLAGS=-lm")
#:parallel-tests? #f))
(synopsis "libvorbis, a library implementing the vorbis audio format")
(description
"The libvorbis library implements the ogg vorbis audio format,
@ -201,7 +203,12 @@ OpenBSD's sndio.")
(list (search-patch "flac-fix-memcmp-not-declared.patch")))))
(build-system gnu-build-system)
(arguments
`(#:parallel-tests? #f))
`(#:parallel-tests? #f
;; By default, man pages are put in PREFIX/man,
;; but we want them in PREFIX/share/man.
#:configure-flags (list (string-append "--mandir="
(assoc-ref %outputs "out")
"/share/man"))))
;; FIXME: configure also looks for xmms, input could be added once it exists
(inputs `(("libogg" ,libogg)))
(synopsis "flac free lossless audio codec")

14
gnu/packages/xorg.scm
View File

@ -1260,13 +1260,13 @@ tracking.")
"1gdv6559cdz1lfw73x7wsvax1fkvphmayrymprljhyyb5nwk5kkz"))))
(build-system gnu-build-system)
(propagated-inputs
;; xft.pc refers to 'xrender'.
`(("libxrender" ,libxrender)))
(inputs
`(("libx11" ,libx11)
("xproto" ,xproto)
;; xft.pc refers to all these.
`(("libxrender" ,libxrender)
("freetype" ,freetype)
("fontconfig" ,fontconfig)))
(inputs
`(("libx11" ,libx11)
("xproto" ,xproto)))
(native-inputs
`(("pkg-config" ,pkg-config)))
(home-page "http://www.x.org/wiki/")
@ -4731,14 +4731,14 @@ icccm: Both client and window-manager helpers for ICCCM.")
(define-public xterm
(package
(name "xterm")
(version "301")
(version "303")
(source (origin
(method url-fetch)
(uri ; XXX: constant URL!
"http://invisible-island.net/datafiles/release/xterm.tar.gz")
(sha256
(base32
"040rarvv18zg0lk7qy0m3n7gv10mh40jic708wvng01z4rlbpfhz"))))
"0n7hay16aam9kfn642ri0wj5yzilbjm3l8znxc2p5dx9pn3rkwla"))))
(build-system gnu-build-system)
(arguments
'(#:configure-flags '("--enable-wide-chars" "--enable-256-color"

5
gnu/packages/zip.scm
View File

@ -1,5 +1,6 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2013 Andreas Enge <andreas@enge.fr>
;;; Copyright © 2014 Mark H Weaver <mhw@netris.org>
;;;
;;; This file is part of GNU Guix.
;;;
@ -89,7 +90,9 @@ Compression ratios of 2:1 to 3:1 are common for text files.")
(lambda* (#:key inputs outputs #:allow-other-keys)
(let* ((out (assoc-ref outputs "out")))
(copy-file "unix/Makefile" "Makefile")
(substitute* "Makefile" (("/usr/local") out))))
(substitute* "Makefile"
(("/usr/local") out)
(("/man/") "/share/man/"))))
%standard-phases)))
(home-page "http://www.info-zip.org/UnZip.html")
(synopsis "Unzip decompression and file extraction utility")

41
guix/pk-crypto.scm
View File

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2013 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2013, 2014 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
@ -24,7 +24,8 @@
#:use-module (system foreign)
#:use-module (rnrs bytevectors)
#:use-module (ice-9 match)
#:export (canonical-sexp?
#:export (gcrypt-version
canonical-sexp?
error-source
error-string
string->canonical-sexp
@ -39,6 +40,7 @@
canonical-sexp-list?
bytevector->hash-data
hash-data->bytevector
key-type
sign
verify
generate-key
@ -85,6 +87,17 @@
"Return a pointer to symbol FUNC in libgcrypt."
(dynamic-func func lib))))
(define gcrypt-version
;; According to the manual, this function must be called before any other,
;; and it's not clear whether it can be called more than once. So call it
;; right here from the top level.
(let* ((ptr (libgcrypt-func "gcry_check_version"))
(proc (pointer->procedure '* ptr '(*)))
(version (pointer->string (proc %null-pointer))))
(lambda ()
"Return the version number of libgcrypt as a string."
version)))
(define finalize-canonical-sexp!
(libgcrypt-func "gcry_sexp_release"))
@ -232,15 +245,31 @@ Return #f if that element does not exist, or if it's a list."
"Return an s-expression representing NUMBER."
(string->canonical-sexp (string-append "#" (number->string number 16) "#")))
(define* (bytevector->hash-data bv #:optional (hash-algo "sha256"))
(define* (bytevector->hash-data bv
#:optional
(hash-algo "sha256")
#:key (key-type 'ecc))
"Given BV, a bytevector containing a hash, return an s-expression suitable
for use as the data for 'sign'."
for use as the data for 'sign'. KEY-TYPE must be a symbol: 'dsa, 'ecc, or
'rsa."
(string->canonical-sexp
(format #f "(data (flags pkcs1) (hash \"~a\" #~a#))"
(format #f "(data (flags ~a) (hash \"~a\" #~a#))"
(case key-type
((ecc dsa) "rfc6979")
((rsa) "pkcs1")
(else (error "unknown key type" key-type)))
hash-algo
(bytevector->base16-string bv))))
(define (hash-data->bytevector data)
(define (key-type sexp)
"Return a symbol denoting the type of key representing by SEXP--e.g., 'rsa',
'ecc'--or #f if SEXP does not denote a valid key."
(case (canonical-sexp-nth-data sexp 0)
((public-key private-key)
(canonical-sexp-nth-data (canonical-sexp-nth sexp 1) 0))
(else #f)))
(define* (hash-data->bytevector data)
"Return two values: the hash value (a bytevector), and the hash algorithm (a
string) extracted from DATA, an sexp as returned by 'bytevector->hash-data'.
Return #f if DATA does not conform."

18
guix/scripts/archive.scm
View File

@ -87,6 +87,13 @@ Export/import one or more packages from/to the store.\n"))
(newline)
(show-bug-report-information))
(define %key-generation-parameters
;; Default key generation parameters. We prefer Ed25519, but it was
;; introduced in libgcrypt 1.6.0.
(if (version>? (gcrypt-version) "1.6.0")
"(genkey (ecdsa (curve Ed25519) (flags rfc6979)))"
"(genkey (rsa (nbits 4:4096)))"))
(define %options
;; Specifications of the command-line options.
(cons* (option '(#\h "help") #f #f
@ -110,13 +117,16 @@ Export/import one or more packages from/to the store.\n"))
(lambda (opt name arg result)
(catch 'gcry-error
(lambda ()
;; XXX: Curve25519 was actually introduced in
;; libgcrypt 1.6.0.
(let ((params
(string->canonical-sexp
(or arg "(genkey (rsa (nbits 4:4096)))"))))
(or arg %key-generation-parameters))))
(alist-cons 'generate-key params result)))
(lambda args
(leave (_ "invalid key generation parameters: ~s~%")
arg)))))
(lambda (key err)
(leave (_ "invalid key generation parameters: ~a: ~a~%")
(error-source err)
(error-string err))))))
(option '("authorize") #f #f
(lambda (opt name arg result)
(alist-cons 'authorize #t result)))

9
guix/scripts/authenticate.scm
View File

@ -39,11 +39,12 @@
(call-with-input-file file
(compose string->canonical-sexp get-string-all)))
(define (read-hash-data file)
"Read sha256 hash data from FILE and return it as a gcrypt sexp."
(define (read-hash-data file key-type)
"Read sha256 hash data from FILE and return it as a gcrypt sexp. KEY-TYPE
is a symbol representing the type of public key algo being used."
(let* ((hex (call-with-input-file file get-string-all))
(bv (base16-string->bytevector (string-trim-both hex))))
(bytevector->hash-data bv)))
(bytevector->hash-data bv #:key-type key-type)))
;;;
@ -64,7 +65,7 @@
(leave
(_ "cannot find public key for secret key '~a'~%")
key)))
(data (read-hash-data hash-file))
(data (read-hash-data hash-file (key-type public-key)))
(signature (signature-sexp data secret-key public-key)))
(display (canonical-sexp->string signature))
#t))

50
guix/scripts/offload.scm
View File

@ -159,19 +159,35 @@ determined."
;; (leave (_ "failed to execute '~a': ~a~%")
;; %lsh-command (strerror (system-error-errno args))))))
(define (remote-pipe machine mode command)
(define-syntax with-error-to-port
(syntax-rules ()
((_ port exp0 exp ...)
(let ((new port)
(old (current-error-port)))
(dynamic-wind
(lambda ()
(set-current-error-port new))
(lambda ()
exp0 exp ...)
(lambda ()
(set-current-error-port old)))))))
(define* (remote-pipe machine mode command
#:key (error-port (current-error-port)))
"Run COMMAND on MACHINE, assuming an lsh gateway has been set up."
(catch 'system-error
(lambda ()
(apply open-pipe* mode %lshg-command "-z"
"-l" (build-machine-user machine)
"-p" (number->string (build-machine-port machine))
;; Let the child inherit ERROR-PORT.
(with-error-to-port error-port
(apply open-pipe* mode %lshg-command "-z"
"-l" (build-machine-user machine)
"-p" (number->string (build-machine-port machine))
;; XXX: Remove '-i' when %LSHG-COMMAND really is lshg.
"-i" (build-machine-private-key machine)
;; XXX: Remove '-i' when %LSHG-COMMAND really is lshg.
"-i" (build-machine-private-key machine)
(build-machine-name machine)
command))
(build-machine-name machine)
command)))
(lambda args
(warning (_ "failed to execute '~a': ~a~%")
%lshg-command (strerror (system-error-errno args)))
@ -257,9 +273,18 @@ connections allowed to MACHINE."
;;; Offloading.
;;;
(define (build-log-port)
"Return the default port where build logs should be sent. The default is
file descriptor 4, which is open by the daemon before running the offload
hook."
(let ((port (fdopen 4 "w0")))
;; Make sure file descriptor 4 isn't closed when PORT is GC'd.
(set-port-revealed! port 1)
port))
(define* (offload drv machine
#:key print-build-trace? (max-silent-time 3600)
build-timeout (log-port (current-output-port)))
build-timeout (log-port (build-log-port)))
"Perform DRV on MACHINE, assuming DRV and its prerequisites are available
there, and write the build log to LOG-PORT. Return the exit status."
(format (current-error-port) "offloading '~a' to '~a'...~%"
@ -276,7 +301,11 @@ there, and write the build log to LOG-PORT. Return the exit status."
(list (format #f "--timeout=~a"
build-timeout))
'())
,(derivation-file-name drv)))))
,(derivation-file-name drv))
;; Since 'guix build' writes the build log to its
;; stderr, everything will go directly to LOG-PORT.
#:error-port log-port)))
(let loop ((line (read-line pipe)))
(unless (eof-object? line)
(display line log-port)
@ -597,6 +626,7 @@ This tool is meant to be used internally by 'guix-daemon'.\n"))
;;; Local Variables:
;;; eval: (put 'with-machine-lock 'scheme-indent-function 2)
;;; eval: (put 'with-file-lock 'scheme-indent-function 1)
;;; eval: (put 'with-error-to-port 'scheme-indent-function 1)
;;; End:
;;; offload.scm ends here

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

@ -125,9 +125,10 @@ again."
(sigaction SIGALRM SIG_DFL)
(apply values result)))))
(define* (fetch uri #:key (buffered? #t) (timeout? #t))
(define* (fetch uri #:key (buffered? #t) (timeout? #t) (quiet-404? #f))
"Return a binary input port to URI and the number of bytes it's expected to
provide."
provide. If QUIET-404? is true, HTTP 404 error conditions are passed through
to the caller without emitting an error message."
(case (uri-scheme uri)
((file)
(let ((port (open-file (uri-path uri)
@ -135,10 +136,12 @@ provide."
(values port (stat:size (stat port)))))
((http)
(guard (c ((http-get-error? c)
(leave (_ "download from '~a' failed: ~a, ~s~%")
(uri->string (http-get-error-uri c))
(http-get-error-code c)
(http-get-error-reason c))))
(let ((code (http-get-error-code c)))
(if (and (= code 404) quiet-404?)
(raise c)
(leave (_ "download from '~a' failed: ~a, ~s~%")
(uri->string (http-get-error-uri c))
code (http-get-error-reason c))))))
;; On Guile 2.0.5, `http-fetch' fetches the whole thing at once. So
;; honor TIMEOUT? to disable the timeout when fetching a nar.
;;
@ -275,8 +278,9 @@ reading PORT."
"Return the <narinfo> record for PATH, or #f if CACHE does not hold PATH."
(define (download url)
;; Download the .narinfo from URL, and return its contents as a list of
;; key/value pairs.
(false-if-exception (fetch (string->uri url))))
;; key/value pairs. Don't emit an error message upon 404.
(false-if-exception (fetch (string->uri url)
#:quiet-404? #t)))
(and (string=? (cache-store-directory cache) (%store-prefix))
(and=> (download (string-append (cache-url cache) "/"

2
nix-upstream

@ -1 +1 @@
Subproject commit bf0ad8aabca67b4faabe3a1ac3c57884ae9924f4
Subproject commit 3fc056927c962ec9778e94528f2f9ae316afca4e

9
nix/nix-daemon/guix-daemon.cc
View File

@ -287,10 +287,11 @@ main (int argc, char *argv[])
string subs = getEnv ("NIX_SUBSTITUTERS", "default");
if (subs == "default")
settings.substituters.push_back (settings.nixLibexecDir
+ "/guix/substitute-binary");
else
settings.substituters = tokenizeString<Strings> (subs, ":");
{
string subst =
settings.nixLibexecDir + "/guix/substitute-binary";
setenv ("NIX_SUBSTITUTERS", subst.c_str (), 1);
}
}
if (geteuid () == 0 && settings.buildUsersGroup.empty ())

2
test-env.in
View File

@ -30,7 +30,7 @@ then
NIX_IGNORE_SYMLINK_STORE=1 # in case the store is a symlink
NIX_STORE_DIR="@GUIX_TEST_ROOT@/store"
NIX_LOCALSTATE_DIR="@GUIX_TEST_ROOT@/var"
NIX_LOG_DIR="@GUIX_TEST_ROOT@/var/log/nix"
NIX_LOG_DIR="@GUIX_TEST_ROOT@/var/log/guix"
NIX_DB_DIR="@GUIX_TEST_ROOT@/db"
NIX_ROOT_FINDER="@abs_top_builddir@/nix/scripts/list-runtime-roots"

4
tests/guix-register.sh
View File

@ -84,8 +84,8 @@ guix-register --prefix "$new_store" "$closure"
NIX_IGNORE_SYMLINK_STORE=1
NIX_STORE_DIR="$new_store_dir"
NIX_STATE_DIR="$new_store$localstatedir"
NIX_LOG_DIR="$new_store$localstatedir/log/nix"
NIX_DB_DIR="$new_store$localstatedir/nix/db"
NIX_LOG_DIR="$new_store$localstatedir/log/guix"
NIX_DB_DIR="$new_store$localstatedir/guix/db"
export NIX_IGNORE_SYMLINK_STORE NIX_STORE_DIR NIX_STATE_DIR \
NIX_LOG_DIR NIX_DB_DIR

42
tests/pk-crypto.scm
View File

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2013 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2013, 2014 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
@ -31,7 +31,7 @@
;; Test the (guix pk-crypto) module.
(define %key-pair
;; Key pair that was generated with:
;; RSA key pair that was generated with:
;; (generate-key (string->canonical-sexp "(genkey (rsa (nbits 4:1024)))"))
;; which takes a bit of time.
"(key-data
@ -48,6 +48,20 @@
(q #00E9AD22F158060BC9AE3601DA623AFC60FFF3058795802CA92371C00097335CF9A23D7782DE353C9DBA93D7BB99E6A24A411107605E722481C5C191F80D7EB77F#)
(u #59B45B95AE01A7A7370FAFDB08FE73A4793CE37F228961B09B1B1E7DDAD9F8D3E28F5C5E8B4B067E6B8E0BBF3F690B42991A79E46108DDCDA2514323A66964DE#))))")
(define %ecc-key-pair
;; Ed25519 key pair generated with:
;; (generate-key (string->canonical-sexp "(genkey (ecdsa (curve Ed25519) (flags rfc6979 transient)))"))
"(key-data
(public-key
(ecc
(curve Ed25519)
(q #94869C1B9E69DB8DD910B7F7F4D6E56A63A964A59AE8F90F6703ACDDF6F50C81#)))
(private-key
(ecc
(curve Ed25519)
(q #94869C1B9E69DB8DD910B7F7F4D6E56A63A964A59AE8F90F6703ACDDF6F50C81#)
(d #6EFB32D0B4EC6B3237B523539F1979379B82726AAA605EB2FBA6775B2B777B78#))))")
(test-begin "pk-crypto")
(let ((sexps '("(foo bar)"
@ -148,8 +162,32 @@
(and (string=? algo "sha256")
(bytevector=? value bv))))))
(test-equal "key-type"
'(rsa ecc)
(map (compose key-type
(cut find-sexp-token <> 'public-key)
string->canonical-sexp)
(list %key-pair %ecc-key-pair)))
(test-assert "sign + verify"
(let* ((pair (string->canonical-sexp %key-pair))
(secret (find-sexp-token pair 'private-key))
(public (find-sexp-token pair 'public-key))
(data (bytevector->hash-data
(sha256 (string->utf8 "Hello, world."))
#:key-type (key-type public)))
(sig (sign data secret)))
(and (verify sig data public)
(not (verify sig
(bytevector->hash-data
(sha256 (string->utf8 "Hi!"))
#:key-type (key-type public))
public)))))
;; Ed25519 appeared in libgcrypt 1.6.0.
(test-skip (if (version>? (gcrypt-version) "1.6.0") 0 1))
(test-assert "sign + verify, Ed25519"
(let* ((pair (string->canonical-sexp %ecc-key-pair))
(secret (find-sexp-token pair 'private-key))
(public (find-sexp-token pair 'public-key))
(data (bytevector->hash-data

34
tests/store.scm
View File

@ -87,7 +87,39 @@
(%store-prefix)
"/283gqy39v3g9dxjy26rynl0zls82fmcg-guile-2.0.7/bin/guile")))))
(test-skip (if %store 0 11))
(test-skip (if %store 0 13))
(test-assert "valid-path? live"
(let ((p (add-text-to-store %store "hello" "hello, world")))
(valid-path? %store p)))
(test-assert "valid-path? false"
(not (valid-path? %store
(string-append (%store-prefix) "/"
(make-string 32 #\e) "-foobar"))))
(test-assert "valid-path? error"
(with-store s
(guard (c ((nix-protocol-error? c) #t))
(valid-path? s "foo")
#f)))
(test-assert "valid-path? recovery"
;; Prior to Nix commit 51800e0 (18 Mar. 2014), the daemon would immediately
;; close the connection after receiving a 'valid-path?' RPC with a non-store
;; file name. See
;; <http://article.gmane.org/gmane.linux.distributions.nixos/12411> for
;; details.
(with-store s
(let-syntax ((true-if-error (syntax-rules ()
((_ exp)
(guard (c ((nix-protocol-error? c) #t))
exp #f)))))
(and (true-if-error (valid-path? s "foo"))
(true-if-error (valid-path? s "bar"))
(true-if-error (valid-path? s "baz"))
(true-if-error (valid-path? s "chbouib"))
(valid-path? s (add-text-to-store s "valid" "yeah"))))))
(test-assert "hash-part->path"
(let ((p (add-text-to-store %store "hello" "hello, world")))