Merge remote-tracking branch 'origin/master' into core-updates

This commit is contained in:
Efraim Flashner 2017-03-23 14:53:33 +02:00
commit 0371b345e8
No known key found for this signature in database
GPG Key ID: F4C1D3917EACEE93
25 changed files with 394 additions and 223 deletions

View File

@ -1,6 +1,6 @@
;;;; test-driver.scm - Guile test driver for Automake testsuite harness
(define script-version "2016-04-03.12") ;UTC
(define script-version "2017-03-22.13") ;UTC
;;; Copyright © 2015, 2016 Mathieu Lirzin <mthl@gnu.org>
;;;
@ -59,7 +59,7 @@ The '--test-name', '--log-file' and '--trs-file' options are mandatory.\n"))
(begin
(format port "~A:~%" field)
(pretty-print value port #:per-line-prefix "+ "))
(format port "~A: ~A~%" field value)))
(format port "~A: ~S~%" field value)))
(define* (result->string symbol #:key colorize?)
"Return SYMBOL as an upper case string. Use colors when COLORIZE is #t."
@ -85,10 +85,10 @@ current output port is supposed to be redirected to a '.log' file."
;; Procedure called at the start of an individual test case, before the
;; test expression (and expected value) are evaluated.
(let ((result (cute assq-ref (test-result-alist runner) <>)))
(test-display "test-name" (result 'test-name))
(test-display "location"
(string-append (result 'source-file) ":"
(number->string (result 'source-line))))
(format #t "test-name: ~A~%" (result 'test-name))
(format #t "location: ~A~%"
(string-append (result 'source-file) ":"
(number->string (result 'source-line))))
(test-display "source" (result 'source-form) #:pretty? #t)))
(define (test-on-test-end-gnu runner)
@ -99,10 +99,9 @@ current output port is supposed to be redirected to a '.log' file."
(result (cut assq-ref results <>)))
(unless brief?
;; Display the result of each test case on the console.
(test-display
(result->string (test-result-kind runner) #:colorize? color?)
(string-append test-name " - " (test-runner-test-name runner))
out-port))
(format out-port "~A: ~A - ~A~%"
(result->string (test-result-kind runner) #:colorize? color?)
test-name (test-runner-test-name runner)))
(when (result? 'expected-value)
(test-display "expected-value" (result 'expected-value)))
(when (result? 'expected-error)
@ -111,12 +110,11 @@ current output port is supposed to be redirected to a '.log' file."
(test-display "actual-value" (result 'actual-value)))
(when (result? 'actual-error)
(test-display "actual-error" (result 'actual-error) #:pretty? #t))
(test-display "result" (result->string (result 'result-kind)))
(format #t "result: ~a~%" (result->string (result 'result-kind)))
(newline)
(test-display ":test-result"
(string-append (result->string (test-result-kind runner))
" " (test-runner-test-name runner))
trs-port)))
(format trs-port ":test-result: ~A ~A~%"
(result->string (test-result-kind runner))
(test-runner-test-name runner))))
(define (test-on-group-end-gnu runner)
;; Procedure called by a 'test-end', including at the end of a test-group.
@ -125,21 +123,18 @@ current output port is supposed to be redirected to a '.log' file."
(skip (or (positive? (test-runner-skip-count runner))
(positive? (test-runner-xfail-count runner)))))
;; XXX: The global results need some refinements for XPASS.
(test-display ":global-test-result"
(if fail "FAIL" (if skip "SKIP" "PASS"))
trs-port)
(test-display ":recheck"
(if fail "yes" "no")
trs-port)
(test-display ":copy-in-global-log"
(if (or fail skip) "yes" "no")
trs-port)
(format trs-port ":global-test-result: ~A~%"
(if fail "FAIL" (if skip "SKIP" "PASS")))
(format trs-port ":recheck: ~A~%"
(if fail "yes" "no"))
(format trs-port ":copy-in-global-log: ~A~%"
(if (or fail skip) "yes" "no"))
(when brief?
;; Display the global test group result on the console.
(test-display (result->string (if fail 'fail (if skip 'skip 'pass))
#:colorize? color?)
test-name
out-port))
(format out-port "~A: ~A~%"
(result->string (if fail 'fail (if skip 'skip 'pass))
#:colorize? color?)
test-name))
#f))
(let ((runner (test-runner-null)))

View File

@ -6523,6 +6523,26 @@ This allows the user's Guix to keep substitute information in cache for
guarantee that the store items it provides will indeed remain available
for as long as @var{ttl}.
@item --nar-path=@var{path}
Use @var{path} as the prefix for the URLs of ``nar'' files
(@pxref{Invoking guix archive, normalized archives}).
By default, nars are served at a URL such as
@code{/nar/gzip/@dots{}-coreutils-8.25}. This option allows you to
change the @code{/nar} part to @var{path}.
@item --public-key=@var{file}
@itemx --private-key=@var{file}
Use the specific @var{file}s as the public/private key pair used to sign
the store items being published.
The files must correspond to the same key pair (the private key is used
for signing and the public key is merely advertised in the signature
metadata). They must contain keys in the canonical s-expression format
as produced by @command{guix archive --generate-key} (@pxref{Invoking
guix archive}). By default, @file{/etc/guix/signing-key.pub} and
@file{/etc/guix/signing-key.sec} are used.
@item --repl[=@var{port}]
@itemx -r [@var{port}]
Spawn a Guile REPL server (@pxref{REPL Servers,,, guile, GNU Guile

View File

@ -506,7 +506,7 @@ dist_patch_DATA = \
%D%/packages/patches/calibre-drop-unrar.patch \
%D%/packages/patches/calibre-no-updates-dialog.patch \
%D%/packages/patches/cdparanoia-fpic.patch \
%D%/packages/patches/chicken-CVE-2016-6830+CVE-2016-6831.patch \
%D%/packages/patches/chicken-CVE-2017-6949.patch \
%D%/packages/patches/chmlib-inttypes.patch \
%D%/packages/patches/clang-libc-search-path.patch \
%D%/packages/patches/clang-3.8-libc-search-path.patch \

View File

@ -165,7 +165,7 @@ exec ~a --no-auto-compile \"$0\" \"$@\"
(define-public autoconf-archive
(package
(name "autoconf-archive")
(version "2016.09.16")
(version "2017.03.21")
(source
(origin
(method url-fetch)
@ -173,7 +173,7 @@ exec ~a --no-auto-compile \"$0\" \"$@\"
version ".tar.xz"))
(sha256
(base32
"10mxz9hfnfz66m1l9s28sbyfb9a04akz92wkyv9blhpq6p9fzwp8"))))
"0rfpapadka2023qhy8294ca5awxpb8d4904js6kv7piby5ax8siq"))))
(build-system gnu-build-system)
(home-page "https://www.gnu.org/software/autoconf-archive")
(synopsis "Collection of freely reusable Autoconf macros")

View File

@ -5051,7 +5051,7 @@ application of SortMeRNA is filtering rRNA from metatranscriptomic data.")
(define-public star
(package
(name "star")
(version "2.5.2b")
(version "2.5.3a")
(source (origin
(method url-fetch)
(uri (string-append "https://github.com/alexdobin/STAR/archive/"
@ -5059,7 +5059,7 @@ application of SortMeRNA is filtering rRNA from metatranscriptomic data.")
(file-name (string-append name "-" version ".tar.gz"))
(sha256
(base32
"1na6np880r1zaamiy00hy8bid5anpy0kgf63587v2yl080krk2zq"))
"013wirlz8lllgjyagl48l75n1isxyabqb3sj7qlsl0x1rmvqw99a"))
(modules '((guix build utils)))
(snippet
'(begin

View File

@ -596,7 +596,7 @@ decompression of some loosely related file formats used by Microsoft.")
(define-public perl-compress-raw-bzip2
(package
(name "perl-compress-raw-bzip2")
(version "2.068")
(version "2.074")
(source
(origin
(method url-fetch)
@ -604,7 +604,7 @@ decompression of some loosely related file formats used by Microsoft.")
"Compress-Raw-Bzip2-" version ".tar.gz"))
(sha256
(base32
"16hl58xppckldz05zdyid1l5gpaykzwvkq682h3rc3nilbhgjqqg"))))
"0b5jwqf15zr787acnx8sfyy2zavdd7gfkd98n1dgy8fs6r8yb8a4"))))
(build-system perl-build-system)
;; TODO: Use our bzip2 package.
(home-page "http://search.cpan.org/dist/Compress-Raw-Bzip2")
@ -616,7 +616,7 @@ compression library.")
(define-public perl-compress-raw-zlib
(package
(name "perl-compress-raw-zlib")
(version "2.068")
(version "2.074")
(source
(origin
(method url-fetch)
@ -624,7 +624,7 @@ compression library.")
"Compress-Raw-Zlib-" version ".tar.gz"))
(sha256
(base32
"06q7n87g26nn5gv4z2p31ca32f6zk124hqxc25rfgkjd3qi5798i"))))
"08bpx9v6i40n54rdcj6invlj294z20amrl8wvwf9b83aldwdwsd3"))))
(build-system perl-build-system)
(inputs
`(("zlib" ,zlib)))
@ -651,7 +651,7 @@ compression library.")
(define-public perl-io-compress
(package
(name "perl-io-compress")
(version "2.068")
(version "2.074")
(source
(origin
(method url-fetch)
@ -659,11 +659,11 @@ compression library.")
"IO-Compress-" version ".tar.gz"))
(sha256
(base32
"0dy0apjp7j9dfkzfjspjd3z9gh26srx5vac72g59bkkz1jf8s1gs"))))
"1wlpy2026djfmq0bjync531yq6s695jf7bcnpvjphrasi776igdl"))))
(build-system perl-build-system)
(propagated-inputs
`(("perl-compress-raw-zlib" ,perl-compress-raw-zlib) ; >=2.068
("perl-compress-raw-bzip2" ,perl-compress-raw-bzip2))) ; >=2.068
`(("perl-compress-raw-zlib" ,perl-compress-raw-zlib) ; >=2.074
("perl-compress-raw-bzip2" ,perl-compress-raw-bzip2))) ; >=2.074
(home-page "http://search.cpan.org/dist/IO-Compress")
(synopsis "IO Interface to compressed files/buffers")
(description "IO-Compress provides a Perl interface to allow reading and

View File

@ -732,6 +732,7 @@ simulator.")
(uri (git-reference
(url "https://github.com/puppeh/binutils-vc4.git")
(commit commit)))
(file-name (string-append name "-" version "-checkout"))
(sha256
(base32
"1kdrz6fki55lm15rwwamn74fnqpy0zlafsida2zymk76n3656c63"))))

View File

@ -247,6 +247,9 @@ without requiring the source code to be rewritten.")
(files '("lib/guile/2.2/site-ccache"
"share/guile/site/2.2")))))))
(define-public guile-next
(deprecated-package "guile-next" guile-2.2))
(define (guile-variant-package-name prefix)
(lambda (name)
"Return NAME with PREFIX instead of \"guile-\", when applicable."

View File

@ -9,6 +9,7 @@
;;; Copyright © 2015, 2016, 2017 Ricardo Wurmus <rekado@elephly.net>
;;; Copyright © 2016, 2017 David Craven <david@craven.ch>
;;; Copyright © 2017 Danny Milosavljevic <dannym@scratchpost.org>
;;; Copyright © 2017 Peter Mikkelsen <petermikkelsen10@gmail.com>
;;;
;;; This file is part of GNU Guix.
;;;
@ -562,6 +563,27 @@ package.")
package.")
(license license:bsd-3)))
(define-public ghc-code-page
(package
(name "ghc-code-page")
(version "0.1.3")
(source
(origin
(method url-fetch)
(uri (string-append
"https://hackage.haskell.org/package/code-page/code-page-"
version ".tar.gz"))
(sha256
(base32
"1491frk4jx6dlhifky9dvcxbsbcfssrz979a5hp5zn061rh8cp76"))))
(build-system haskell-build-system)
(home-page "https://github.com/RyanGlScott/code-page")
(synopsis "Windows code page library for Haskell")
(description "A cross-platform library with functions for adjusting
code pages on Windows. On all other operating systems, the library does
nothing.")
(license license:bsd-3)))
(define-public ghc-haddock-library
(package
(name "ghc-haddock-library")

View File

@ -31,7 +31,7 @@
(define-public idris
(package
(name "idris")
(version "0.99")
(version "0.99.1")
(source (origin
(method url-fetch)
(uri (string-append
@ -39,7 +39,7 @@
"idris-" version "/idris-" version ".tar.gz"))
(sha256
(base32
"1sd4vy5rx0mp32xj99qijhknkgw4d2rxvz6wiy3pym6kaqmc497i"))))
"12kw452arnl5ldip2x749j5np3l40bv7asqdv9w0f60j45hii40r"))))
(build-system haskell-build-system)
(inputs
`(("gmp" ,gmp)
@ -53,6 +53,7 @@
("ghc-blaze-html" ,ghc-blaze-html)
("ghc-blaze-markup" ,ghc-blaze-markup)
("ghc-cheapskate" ,ghc-cheapskate)
("ghc-code-page" ,ghc-code-page)
("ghc-fingertree" ,ghc-fingertree)
("ghc-fsnotify" ,ghc-fsnotify)
("ghc-ieee754" ,ghc-ieee754)

View File

@ -36,6 +36,7 @@
":pserver:anonymous@cvs.savannah.gnu.org:/sources/libffcall")
(module "ffcall")
(revision "2015-01-15")))
(file-name (string-append name "-" version "-checkout"))
(sha256
(base32
"1lwdskc2w4rr98x9flr2726lmj4190l16r0izg7gqxy50801wwgd"))))

View File

@ -1080,7 +1080,7 @@ facilities for checking incoming mail.")
(define-public dovecot
(package
(name "dovecot")
(version "2.2.27")
(version "2.2.28")
(source
(origin
(method url-fetch)
@ -1088,7 +1088,7 @@ facilities for checking incoming mail.")
(version-major+minor version) "/"
name "-" version ".tar.gz"))
(sha256 (base32
"1s8qvr6fa9d0n179kdwgpsi72zkvpbh9q57q8fr2fjysgjl94zw9"))))
"098zpkmkk93372qnv6drgbfg8hp5mynspzc1735qgar6wdcqya70"))))
(build-system gnu-build-system)
(native-inputs
`(("pkg-config" ,pkg-config)))

View File

@ -214,9 +214,9 @@ the Nix package manager.")
;;
;; Note: use a very short commit id; with a longer one, the limit on
;; hash-bang lines would be exceeded while running the tests.
(let ((commit "1162418ee88f155f6b14fd8926479c2176e40e76"))
(let ((commit "73a46451af333c77d2e79aa8764f51be8c34d1ae"))
(package (inherit guix-0.12.0)
(version (string-append "0.12.0-5." (string-take commit 4)))
(version (string-append "0.12.0-6." (string-take commit 4)))
(source (origin
(method git-fetch)
(uri (git-reference
@ -226,7 +226,7 @@ the Nix package manager.")
(commit commit)))
(sha256
(base32
"16pxqbywhayazdgg9l19frigncmyq20j5fvaq4zgvm0iidndhfja"))
"1zfa6c1vf52rg7ba1nrz4hzgdwl16brc4iylcdnhl9mnkjg2fbr5"))
(file-name (string-append "guix-" version "-checkout"))))
(arguments
(substitute-keyword-arguments (package-arguments guix-0.12.0)

View File

@ -1,81 +0,0 @@
diff -ur a/irregex-core.scm b/irregex-core.scm
--- a/irregex-core.scm 2016-09-11 19:03:00.000000000 -0400
+++ b/irregex-core.scm 2017-01-01 22:24:08.000000000 -0500
@@ -30,6 +30,8 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;; History
+;; 0.9.6: 2016/12/05 - fixed exponential memory use of + in compilation
+;; of backtracking matcher.
;; 0.9.5: 2016/09/10 - fixed a bug in irregex-fold handling of bow
;; 0.9.4: 2015/12/14 - performance improvement for {n,m} matches
;; 0.9.3: 2014/07/01 - R7RS library
@@ -3170,16 +3172,7 @@
((sre-empty? (sre-sequence (cdr sre)))
(error "invalid sre: empty *" sre))
(else
- (letrec
- ((body
- (lp (sre-sequence (cdr sre))
- n
- flags
- (lambda (cnk init src str i end matches fail)
- (body cnk init src str i end matches
- (lambda ()
- (next cnk init src str i end matches fail)
- ))))))
+ (let ((body (rec (list '+ (sre-sequence (cdr sre))))))
(lambda (cnk init src str i end matches fail)
(body cnk init src str i end matches
(lambda ()
@@ -3204,10 +3197,21 @@
(lambda ()
(body cnk init src str i end matches fail))))))))
((+)
- (lp (sre-sequence (cdr sre))
- n
- flags
- (rec (list '* (sre-sequence (cdr sre))))))
+ (cond
+ ((sre-empty? (sre-sequence (cdr sre)))
+ (error "invalid sre: empty +" sre))
+ (else
+ (letrec
+ ((body
+ (lp (sre-sequence (cdr sre))
+ n
+ flags
+ (lambda (cnk init src str i end matches fail)
+ (body cnk init src str i end matches
+ (lambda ()
+ (next cnk init src str i end matches fail)
+ ))))))
+ body))))
((=)
(rec `(** ,(cadr sre) ,(cadr sre) ,@(cddr sre))))
((>=)
diff -ur a/irregex-utils.scm b/irregex-utils.scm
--- a/irregex-utils.scm 2016-09-11 19:03:00.000000000 -0400
+++ b/irregex-utils.scm 2017-01-01 22:25:25.000000000 -0500
@@ -89,7 +89,7 @@
(case (car x)
((: seq)
(cond
- ((and (pair? (cddr x)) (pair? (cddr x)) (not (eq? x obj)))
+ ((and (pair? (cdr x)) (pair? (cddr x)) (not (eq? x obj)))
(display "(?:" out) (for-each lp (cdr x)) (display ")" out))
(else (for-each lp (cdr x)))))
((submatch)
diff -ur "a/manual-html/Unit irregex.html" "b/manual-html/Unit irregex.html"
--- "a/manual-html/Unit irregex.html" 2016-09-11 19:10:47.000000000 -0400
+++ "b/manual-html/Unit irregex.html" 2017-01-01 22:26:05.000000000 -0500
@@ -353,6 +353,6 @@
<dd class="defsig"><p>Returns an optimized SRE matching any of the literal strings in the list, like Emacs' <tt>regexp-opt</tt>. Note this optimization doesn't help when irregex is able to build a DFA.</p></dd>
</dl>
<h5 id="sec:sre-.3estring"><a href="#sec:sre-.3estring">sre-&gt;string</a></h5><dl class="defsig"><dt class="defsig" id="def:sre-.3estring"><span class="sig"><tt>(sre-&gt;string &lt;sre&gt;)</tt></span> <span class="type">procedure</span></dt>
-<dd class="defsig"><p>Convert an SRE to a POSIX-style regular expression string, if possible.</p></dd>
+<dd class="defsig"><p>Convert an SRE to a PCRE-style regular expression string, if possible.</p></dd>
</dl>
-<hr /><p>Previous: <a href="Unit%20extras.html">Unit extras</a></p><p>Next: <a href="Unit%20srfi-1.html">Unit srfi-1</a></p></div></div></body>
\ No newline at end of file
+<hr /><p>Previous: <a href="Unit%20extras.html">Unit extras</a></p><p>Next: <a href="Unit%20srfi-1.html">Unit srfi-1</a></p></div></div></body>

View File

@ -0,0 +1,132 @@
From: LemonBoy <thatlemon@gmail.com>
Date: Fri, 10 Mar 2017 16:29:47 +0100
Subject: [PATCH] Add bound checking to all srfi-4 vector allocations.
Do what C_allocate_vector already does and prevent the creation of a
vector that's too big or too small.
We should be very careful to avoid the latter case because the
allocation size is directly fed into `malloc' as 'x + sizeof(C_header)'
thus making possible to successfully allocate a vector smaller than the
C_header structure and get C_block_header_init to write over
uninitialized memory.
To reduce code duplication, type checking is moved from each of the
make-*vector procedures to the common "alloc" helper procedure.
Signed-off-by: Peter Bex <peter@more-magic.net>
Signed-off-by: Kooda <kooda@upyum.com>
---
srfi-4.scm | 34 +++++++++++++++-------------------
1 file changed, 15 insertions(+), 19 deletions(-)
diff --git a/srfi-4.scm b/srfi-4.scm
index 7f5412b..69f58ba 100644
--- a/srfi-4.scm
+++ b/srfi-4.scm
@@ -255,24 +255,28 @@ EOF
;;; Basic constructors:
-(let* ([ext-alloc
- (foreign-lambda* scheme-object ([int bytes])
- "C_word *buf = (C_word *)C_malloc(bytes + sizeof(C_header));"
+(let* ((ext-alloc
+ (foreign-lambda* scheme-object ((size_t bytes))
+ "C_word *buf;"
+ "if (bytes > C_HEADER_SIZE_MASK) C_return(C_SCHEME_FALSE);"
+ "buf = (C_word *)C_malloc(bytes + sizeof(C_header));"
"if(buf == NULL) C_return(C_SCHEME_FALSE);"
"C_block_header_init(buf, C_make_header(C_BYTEVECTOR_TYPE, bytes));"
- "C_return(buf);") ]
- [ext-free
- (foreign-lambda* void ([scheme-object bv])
- "C_free((void *)C_block_item(bv, 1));") ]
- [alloc
+ "C_return(buf);") )
+ (ext-free
+ (foreign-lambda* void ((scheme-object bv))
+ "C_free((void *)C_block_item(bv, 1));") )
+ (alloc
(lambda (loc len ext?)
+ (##sys#check-exact len loc)
+ (when (fx< len 0) (##sys#error loc "size is negative" len))
(if ext?
- (let ([bv (ext-alloc len)])
+ (let ((bv (ext-alloc len)))
(or bv
(##sys#error loc "not enough memory - cannot allocate external number vector" len)) )
- (let ([bv (##sys#allocate-vector len #t #f #t)]) ; this could be made better...
+ (let ((bv (##sys#allocate-vector len #t #f #t))) ; this could be made better...
(##core#inline "C_string_to_bytevector" bv)
- bv) ) ) ] )
+ bv) ) ) ) )
(set! release-number-vector
(lambda (v)
@@ -282,7 +286,6 @@ EOF
(set! make-u8vector
(lambda (len #!optional (init #f) (ext? #f) (fin? #t))
- (##sys#check-exact len 'make-u8vector)
(let ((v (##sys#make-structure 'u8vector (alloc 'make-u8vector len ext?))))
(when (and ext? fin?) (set-finalizer! v ext-free))
(if (not init)
@@ -295,7 +298,6 @@ EOF
(set! make-s8vector
(lambda (len #!optional (init #f) (ext? #f) (fin? #t))
- (##sys#check-exact len 'make-s8vector)
(let ((v (##sys#make-structure 's8vector (alloc 'make-s8vector len ext?))))
(when (and ext? fin?) (set-finalizer! v ext-free))
(if (not init)
@@ -308,7 +310,6 @@ EOF
(set! make-u16vector
(lambda (len #!optional (init #f) (ext? #f) (fin? #t))
- (##sys#check-exact len 'make-u16vector)
(let ((v (##sys#make-structure 'u16vector (alloc 'make-u16vector (##core#inline "C_fixnum_shift_left" len 1) ext?))))
(when (and ext? fin?) (set-finalizer! v ext-free))
(if (not init)
@@ -321,7 +322,6 @@ EOF
(set! make-s16vector
(lambda (len #!optional (init #f) (ext? #f) (fin? #t))
- (##sys#check-exact len 'make-s16vector)
(let ((v (##sys#make-structure 's16vector (alloc 'make-s16vector (##core#inline "C_fixnum_shift_left" len 1) ext?))))
(when (and ext? fin?) (set-finalizer! v ext-free))
(if (not init)
@@ -334,7 +334,6 @@ EOF
(set! make-u32vector
(lambda (len #!optional (init #f) (ext? #f) (fin? #t))
- (##sys#check-exact len 'make-u32vector)
(let ((v (##sys#make-structure 'u32vector (alloc 'make-u32vector (##core#inline "C_fixnum_shift_left" len 2) ext?))))
(when (and ext? fin?) (set-finalizer! v ext-free))
(if (not init)
@@ -347,7 +346,6 @@ EOF
(set! make-s32vector
(lambda (len #!optional (init #f) (ext? #f) (fin? #t))
- (##sys#check-exact len 'make-s32vector)
(let ((v (##sys#make-structure 's32vector (alloc 'make-s32vector (##core#inline "C_fixnum_shift_left" len 2) ext?))))
(when (and ext? fin?) (set-finalizer! v ext-free))
(if (not init)
@@ -360,7 +358,6 @@ EOF
(set! make-f32vector
(lambda (len #!optional (init #f) (ext? #f) (fin? #t))
- (##sys#check-exact len 'make-f32vector)
(let ((v (##sys#make-structure 'f32vector (alloc 'make-f32vector (##core#inline "C_fixnum_shift_left" len 2) ext?))))
(when (and ext? fin?) (set-finalizer! v ext-free))
(if (not init)
@@ -375,7 +372,6 @@ EOF
(set! make-f64vector
(lambda (len #!optional (init #f) (ext? #f) (fin? #t))
- (##sys#check-exact len 'make-f64vector)
(let ((v (##sys#make-structure
'f64vector
(alloc 'make-f64vector (##core#inline "C_fixnum_shift_left" len 3) ext?))))
--
2.1.4

View File

@ -26,7 +26,7 @@
(define-public perl-mojolicious
(package
(name "perl-mojolicious")
(version "7.10")
(version "7.29")
(source
(origin
(method url-fetch)
@ -34,7 +34,7 @@
version ".tar.gz"))
(sha256
(base32
"0811f3wajgf71y02dr2khqnaswjh582pcvhv93k101qpg61syihn"))))
"1kmyb9axqbklyvr3l4d6mxnb0r97s9hzn7jpzksgckklp1ic8sqh"))))
(build-system perl-build-system)
(home-page "http://mojolicious.org/")
(synopsis "Real-time web framework")

View File

@ -1725,14 +1725,14 @@ standard library.")
(define-public python-pafy
(package
(name "python-pafy")
(version "0.5.2")
(version "0.5.3.1")
(source
(origin
(method url-fetch)
(uri (pypi-uri "pafy" version))
(sha256
(base32
"1ckvrypyvb7jbqlgwdz0y337ajagjv7dgxyns326nqwypn1wpq0i"))))
"1a7dxi95m1043rxx1r5x3ngb66nwlq6aqcasyqqjzmmmjps4zrim"))))
(build-system python-build-system)
(arguments
`(#:tests? #f)) ; Currently pafy can not find itself in the tests
@ -4372,14 +4372,14 @@ both of which are installed automatically if you install this library.")
(define-public python-sqlalchemy-utils
(package
(name "python-sqlalchemy-utils")
(version "0.32.11")
(version "0.32.13")
(source
(origin
(method url-fetch)
(uri (pypi-uri "SQLAlchemy-Utils" version))
(sha256
(base32
"1wghyvk73cmq3iqyg3fczw128fv2pan2v76m0xg1bw05h8fhvnk3"))))
"0vsib7gidjamzsz6w4s5pdhxzxsrkghjnm4sqwk94igjrl3i5ixj"))))
(build-system python-build-system)
(arguments
'(#:tests? #f)) ; FIXME: Many tests require a running database server.
@ -4796,7 +4796,7 @@ etc. The core of this module is a decorator factory.")
(define-public python-drmaa
(package
(name "python-drmaa")
(version "0.7.6")
(version "0.7.7")
(source
(origin
(method url-fetch)
@ -4804,7 +4804,7 @@ etc. The core of this module is a decorator factory.")
"https://pypi.python.org/packages/source/d/drmaa/drmaa-"
version ".tar.gz"))
(sha256
(base32 "0bzl9f9g34dlhwf09i3fdv7dqqzf2iq0w7d6c2bafx1nlap8qfbh"))))
(base32 "0xzqriqyvk5b8hszbavsyxd29wm3sxirm8zvvdm73rs2iq7w4hkx"))))
(build-system python-build-system)
;; The test suite requires libdrmaa which is provided by the cluster
;; environment. At runtime the environment variable DRMAA_LIBRARY_PATH
@ -5666,14 +5666,14 @@ libxml2 and libxslt.")
(define-public python-beautifulsoup4
(package
(name "python-beautifulsoup4")
(version "4.5.1")
(version "4.5.3")
(source
(origin
(method url-fetch)
(uri (pypi-uri "beautifulsoup4" version))
(sha256
(base32
"1qgmhw65ncsgccjhslgkkszif47q6gvxwqv4mim17agxd81p951w"))))
"0glaw1vyxnbp03fni7h5496n6iib0n5iim4gax1n0ngscs9s075j"))))
(build-system python-build-system)
(arguments
`(#:phases
@ -6742,7 +6742,7 @@ provided that can be used to do various manipulations with LilyPond files.")
(define-public python-appdirs
(package
(name "python-appdirs")
(version "1.4.0")
(version "1.4.3")
(source
(origin
(method url-fetch)
@ -6752,7 +6752,7 @@ provided that can be used to do various manipulations with LilyPond files.")
".tar.gz"))
(sha256
(base32
"1iddva7v3fq0aqzsahkazxr7vpw28mqcrsy818z4wyiqnkplbhlg"))))
"14id6wxi12lgyw0mg3bcfnf888ad07jz9yj46gfzhn186z8rcn4y"))))
(build-system python-build-system)
(home-page "http://github.com/ActiveState/appdirs")
(synopsis
@ -7126,13 +7126,13 @@ implementations of ASN.1-based codecs and protocols.")
(define-public python-ipaddress
(package
(name "python-ipaddress")
(version "1.0.16")
(version "1.0.18")
(source (origin
(method url-fetch)
(uri (pypi-uri "ipaddress" version))
(sha256
(base32
"1c3imabdrw8nfksgjjflzg7h4ynjckqacb188rf541m74arq4cas"))))
"1q8klj9d84cmxgz66073x1j35cplr3r77vx1znhxiwl5w74391ax"))))
(build-system python-build-system)
(home-page "https://github.com/phihag/ipaddress")
(synopsis "IP address manipulation library")
@ -8994,14 +8994,14 @@ Python at your fingertips, in Lisp form.")
(define-public python-rauth
(package
(name "python-rauth")
(version "0.7.2")
(version "0.7.3")
(source
(origin
(method url-fetch)
(uri (pypi-uri "rauth" version))
(sha256
(base32
"00pq7zw429hhza9c0qzxiqp77m653jv09z92nralnmzwdf6pzicf"))))
"02kv8w8l98ky223avyq7vw7x1f2ya9chrm59r77ylq45qb0xnk2j"))))
(build-system python-build-system)
(arguments
`(#:test-target "check"))
@ -9090,14 +9090,14 @@ otherwise matches 3.2s API.")
(define-public python2-futures
(package
(name "python2-futures")
(version "3.0.3")
(version "3.0.5")
(source
(origin
(method url-fetch)
(uri (pypi-uri "futures" version))
(sha256
(base32
"1vcb34dqhzkhbq1957vdjszhhm5y3j9ba88dgwhqx2zynhmk9qig"))))
"1pw1z4329xvlabdpwqa6b7v2fxf7hl64m4cgr22ckbym8m8m4hh5"))))
(build-system python-build-system)
(arguments `(#:python ,python-2))
(home-page "https://github.com/agronholm/pythonfutures")
@ -12294,13 +12294,13 @@ failures.")
(define-public python-natsort
(package
(name "python-natsort")
(version "5.0.1")
(version "5.0.2")
(source (origin
(method url-fetch)
(uri (pypi-uri "natsort" version))
(sha256
(base32
"1abld5p4a6n5zjnyw5mi2pv37gqalcybv2brjr2y6l9l2p8v9mja"))))
"0bh6j0l8iapjnsgg3bs6q075cnzjl6zw1vlgqyv3qrygm2cxypkn"))))
(build-system python-build-system)
(arguments
`(#:phases

View File

@ -229,18 +229,21 @@ rustc-bootstrap and cargo-bootstrap packages.")
(("/usr/bin/env") (which "env")))
;; Avoid curl as a build dependency.
(substitute* "configure"
(("probe_need CFG_CURL curl") ""))))
(("probe_need CFG_CURL curl") ""))
#t))
(add-after 'unpack 'set-env
(lambda _
(setenv "SHELL" (which "sh"))
(setenv "CONFIG_SHELL" (which "sh"))))
(setenv "CONFIG_SHELL" (which "sh"))
#t))
(add-after 'unpack 'patch-tests
(lambda* (#:key inputs #:allow-other-keys)
(substitute* "src/tools/tidy/src/main.rs"
(("^.*cargo.*::check.*$") ""))
(substitute* "src/libstd/process.rs"
(("\"/bin/sh\"") (string-append "\"" (assoc-ref inputs "bash") "/bin/sh\"")))
#t))
(let ((bash (assoc-ref inputs "bash")))
(substitute* "src/tools/tidy/src/main.rs"
(("^.*cargo.*::check.*$") ""))
(substitute* "src/libstd/process.rs"
(("\"/bin/sh\"") (string-append "\"" bash "/bin/sh\"")))
#t)))
(replace 'configure
(lambda* (#:key inputs outputs #:allow-other-keys)
(let* ((out (assoc-ref outputs "out"))
@ -275,7 +278,8 @@ rustc-bootstrap and cargo-bootstrap packages.")
;; Let gcc find ld and libc startup files.
(wrap-program (string-append out "/bin/rustc")
`("PATH" ":" prefix (,(string-append ld-wrapper "/bin")))
`("LIBRARY_PATH" ":" suffix (,(string-append libc "/lib"))))))))))
`("LIBRARY_PATH" ":" suffix (,(string-append libc "/lib"))))
#t))))))
;; rustc invokes gcc, so we need to set its search paths accordingly.
(native-search-paths (package-native-search-paths gcc))
(synopsis "Compiler for the Rust progamming language")

View File

@ -325,18 +325,16 @@ mashups, office (web agendas, mail clients, ...), etc.")
(define-public chicken
(package
(name "chicken")
(version "4.11.1")
(version "4.12.0")
(source (origin
(method url-fetch)
(uri (string-append "http://code.call-cc.org/releases/"
(uri (string-append "https://code.call-cc.org/releases/"
version "/chicken-" version ".tar.gz"))
(uri (string-append "http://code.call-cc.org/dev-snapshots/"
"2016/09/12/chicken-" version ".tar.gz"))
(sha256
(base32
"1rwymbbmnwdyhdzilv9w75an989xw9kjf3x52iqdng3nphpflcga"))
"12b9gaa9lqh39lj1v4wm48f6z8ww3jdkvc5bh9gqqvn6kd2wwnk0"))
(patches
(search-patches "chicken-CVE-2016-6830+CVE-2016-6831.patch"))))
(search-patches "chicken-CVE-2017-6949.patch"))))
(build-system gnu-build-system)
(arguments
`(#:modules ((guix build gnu-build-system)
@ -359,12 +357,6 @@ mashups, office (web agendas, mail clients, ...), etc.")
;; Parallel builds are not supported, as noted in README.
#:parallel-build? #f))
;; One of the tests ("testing direct invocation can detect calls of too
;; many arguments...") times out when building with a more recent GCC.
;; The problem was reported here:
;; https://lists.gnu.org/archive/html/chicken-hackers/2015-04/msg00059.html
(native-inputs
`(("gcc" ,gcc-4.8)))
(home-page "http://www.call-cc.org/")
(synopsis "R5RS Scheme implementation that compiles native code via C")
(description

View File

@ -984,7 +984,7 @@ access to mpv's powerful playback capabilities.")
(define-public youtube-dl
(package
(name "youtube-dl")
(version "2017.03.16")
(version "2017.03.22")
(source (origin
(method url-fetch)
(uri (string-append "https://yt-dl.org/downloads/"
@ -992,7 +992,7 @@ access to mpv's powerful playback capabilities.")
version ".tar.gz"))
(sha256
(base32
"14nlgl0kh4mwl7sx58vd7nxr5iklxi00612lmydy91ngm6ykrpsm"))))
"1zz97g23diggcnqg2hjq9grijskly8ag727f1i509hl7z0lxkh69"))))
(build-system python-build-system)
(arguments
;; The problem here is that the directory for the man page and completion

View File

@ -23,11 +23,13 @@
#:use-module (system foreign)
#:use-module (rnrs bytevectors)
#:use-module (ice-9 match)
#:use-module (ice-9 rdelim)
#:export (canonical-sexp?
error-source
error-string
string->canonical-sexp
canonical-sexp->string
read-file-sexp
number->canonical-sexp
canonical-sexp-car
canonical-sexp-cdr
@ -143,6 +145,12 @@ thrown along with 'gcry-error'."
(loop (* len 2))
(pointer->string buf size "ISO-8859-1")))))))
(define (read-file-sexp file)
"Return the canonical sexp read from FILE."
(call-with-input-file file
(compose string->canonical-sexp
read-string)))
(define canonical-sexp-car
(let* ((ptr (libgcrypt-func "gcry_sexp_car"))
(proc (pointer->procedure '* ptr '(*))))

View File

@ -1,6 +1,6 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2015 David Thompson <davet@gnu.org>
;;; Copyright © 2015, 2016 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
@ -52,7 +52,10 @@
#:use-module (guix scripts)
#:use-module ((guix utils) #:select (compressed-file?))
#:use-module ((guix build utils) #:select (dump-port))
#:export (guix-publish))
#:export (%public-key
%private-key
guix-publish))
(define (show-help)
(format #t (_ "Usage: guix publish [OPTION]...
@ -68,6 +71,12 @@ Publish ~a over HTTP.\n") %store-directory)
compress archives at LEVEL"))
(display (_ "
--ttl=TTL announce narinfos can be cached for TTL seconds"))
(display (_ "
--nar-path=PATH use PATH as the prefix for nar URLs"))
(display (_ "
--public-key=FILE use FILE as the public key for signatures"))
(display (_ "
--private-key=FILE use FILE as the private key for signatures"))
(display (_ "
-r, --repl[=PORT] spawn REPL server on PORT"))
(newline)
@ -145,6 +154,15 @@ compression disabled~%"))
(leave (_ "~a: invalid duration~%") arg))
(alist-cons 'narinfo-ttl (time-second duration)
result))))
(option '("nar-path") #t #f
(lambda (opt name arg result)
(alist-cons 'nar-path arg result)))
(option '("public-key") #t #f
(lambda (opt name arg result)
(alist-cons 'public-key-file arg result)))
(option '("private-key" "secret-key") #t #f
(lambda (opt name arg result)
(alist-cons 'private-key-file arg result)))
(option '(#\r "repl") #f #t
(lambda (opt name arg result)
;; If port unspecified, use default Guile REPL port.
@ -154,6 +172,12 @@ compression disabled~%"))
(define %default-options
`((port . 8080)
;; By default, serve nars under "/nar".
(nar-path . "nar")
(public-key-file . ,%public-key-file)
(private-key-file . ,%private-key-file)
;; Default to fast & low compression.
(compression . ,(if (zlib-available?)
%default-gzip-compression
@ -162,18 +186,11 @@ compression disabled~%"))
(address . ,(make-socket-address AF_INET INADDR_ANY 0))
(repl . #f)))
(define (lazy-read-file-sexp file)
"Return a promise to read the canonical sexp from FILE."
(delay
(call-with-input-file file
(compose string->canonical-sexp
read-string))))
;; The key pair used to sign narinfos.
(define %private-key
(lazy-read-file-sexp %private-key-file))
(make-parameter #f))
(define %public-key
(lazy-read-file-sexp %public-key-file))
(make-parameter #f))
(define %nix-cache-info
`(("StoreDir" . ,%store-directory)
@ -186,25 +203,26 @@ compression disabled~%"))
(define (signed-string s)
"Sign the hash of the string S with the daemon's key."
(let* ((public-key (force %public-key))
(let* ((public-key (%public-key))
(hash (bytevector->hash-data (sha256 (string->utf8 s))
#:key-type (key-type public-key))))
(signature-sexp hash (force %private-key) public-key)))
(signature-sexp hash (%private-key) public-key)))
(define base64-encode-string
(compose base64-encode string->utf8))
(define* (narinfo-string store store-path key
#:key (compression %no-compression))
#:key (compression %no-compression)
(nar-path "nar"))
"Generate a narinfo key/value string for STORE-PATH; an exception is raised
if STORE-PATH is invalid. Produce a URL that corresponds to COMPRESSION. The
narinfo is signed with KEY."
narinfo is signed with KEY. NAR-PATH specifies the prefix for nar URLs."
(let* ((path-info (query-path-info store store-path))
(compression (if (compressed-file? store-path)
%no-compression
compression))
(url (encode-and-join-uri-path
`("nar"
`(,@(split-and-decode-uri-path nar-path)
,@(match compression
(($ <compression> 'none)
'())
@ -266,11 +284,12 @@ References: ~a~%"
%nix-cache-info))))
(define* (render-narinfo store request hash
#:key ttl (compression %no-compression))
#:key ttl (compression %no-compression)
(nar-path "nar"))
"Render metadata for the store path corresponding to HASH. If TTL is true,
advertise it as the maximum validity period (in seconds) via the
'Cache-Control' header. This allows 'guix substitute' to cache it for an
appropriate duration."
appropriate duration. NAR-PATH specifies the prefix for nar URLs."
(let ((store-path (hash-part->path store hash)))
(if (string-null? store-path)
(not-found request)
@ -279,7 +298,8 @@ appropriate duration."
`((cache-control (max-age . ,ttl)))
'()))
(cut display
(narinfo-string store store-path (force %private-key)
(narinfo-string store store-path (%private-key)
#:nar-path nar-path
#:compression compression)
<>)))))
@ -469,7 +489,12 @@ blocking."
(define* (make-request-handler store
#:key
narinfo-ttl
(nar-path "nar")
(compression %no-compression))
(define nar-path?
(let ((expected (split-and-decode-uri-path nar-path)))
(cut equal? expected <>)))
(lambda (request body)
(format #t "~a ~a~%"
(request-method request)
@ -485,19 +510,23 @@ blocking."
;; NARINFO-TTL.
(render-narinfo store request hash
#:ttl narinfo-ttl
#:nar-path nar-path
#:compression compression))
;; /nar/file/NAME/sha256/HASH
(("file" name "sha256" hash)
(guard (c ((invalid-base32-character? c)
(not-found request)))
(let ((hash (nix-base32-string->bytevector hash)))
(render-content-addressed-file store request
name 'sha256 hash))))
;; Use different URLs depending on the compression type. This
;; guarantees that /nar URLs remain valid even when 'guix publish'
;; is restarted with different compression parameters.
;; /nar/<store-item>
(("nar" store-item)
(render-nar store request store-item
#:compression %no-compression))
;; /nar/gzip/<store-item>
(("nar" "gzip" store-item)
(if (zlib-available?)
((components ... "gzip" store-item)
(if (and (nar-path? components) (zlib-available?))
(render-nar store request store-item
#:compression
(match compression
@ -507,19 +536,21 @@ blocking."
%default-gzip-compression)))
(not-found request)))
;; /nar/file/NAME/sha256/HASH
(("file" name "sha256" hash)
(guard (c ((invalid-base32-character? c)
(not-found request)))
(let ((hash (nix-base32-string->bytevector hash)))
(render-content-addressed-file store request
name 'sha256 hash))))
(_ (not-found request)))
;; /nar/<store-item>
((components ... store-item)
(if (nar-path? components)
(render-nar store request store-item
#:compression %no-compression)
(not-found request)))
(x (not-found request)))
(not-found request))))
(define* (run-publish-server socket store
#:key (compression %no-compression) narinfo-ttl)
#:key (compression %no-compression)
(nar-path "nar") narinfo-ttl)
(run-server (make-request-handler store
#:nar-path nar-path
#:narinfo-ttl narinfo-ttl
#:compression compression)
concurrent-http-server
@ -566,11 +597,13 @@ blocking."
(sockaddr:addr addr)
port)))
(socket (open-server-socket address))
(repl-port (assoc-ref opts 'repl)))
;; Read the key right away so that (1) we fail early on if we can't
;; access them, and (2) we can then drop privileges.
(force %private-key)
(force %public-key)
(nar-path (assoc-ref opts 'nar-path))
(repl-port (assoc-ref opts 'repl))
;; Read the key right away so that (1) we fail early on if we can't
;; access them, and (2) we can then drop privileges.
(public-key (read-file-sexp (assoc-ref opts 'public-key-file)))
(private-key (read-file-sexp (assoc-ref opts 'private-key-file))))
(when user
;; Now that we've read the key material and opened the socket, we can
@ -580,13 +613,17 @@ blocking."
(when (zero? (getuid))
(warning (_ "server running as root; \
consider using the '--user' option!~%")))
(format #t (_ "publishing ~a on ~a, port ~d~%")
%store-directory
(inet-ntop (sockaddr:fam address) (sockaddr:addr address))
(sockaddr:port address))
(when repl-port
(repl:spawn-server (repl:make-tcp-server-socket #:port repl-port)))
(with-store store
(run-publish-server socket store
#:compression compression
#:narinfo-ttl ttl)))))
(parameterize ((%public-key public-key)
(%private-key private-key))
(format #t (_ "publishing ~a on ~a, port ~d~%")
%store-directory
(inet-ntop (sockaddr:fam address) (sockaddr:addr address))
(sockaddr:port address))
(when repl-port
(repl:spawn-server (repl:make-tcp-server-socket #:port repl-port)))
(with-store store
(run-publish-server socket store
#:nar-path nar-path
#:compression compression
#:narinfo-ttl ttl))))))

View File

@ -50,6 +50,7 @@
(test-begin "pack")
(unless (network-reachable?) (test-skip 1))
(test-assertm "self-contained-tarball"
(mlet* %store-monad
((profile (profile-derivation (packages->manifest

View File

@ -33,6 +33,7 @@
#:use-module ((guix records) #:select (recutils->alist))
#:use-module ((guix serialization) #:select (restore-file))
#:use-module (guix pk-crypto)
#:use-module ((guix pki) #:select (%public-key-file %private-key-file))
#:use-module (guix zlib)
#:use-module (web uri)
#:use-module (web client)
@ -100,6 +101,10 @@
;; Wait until the two servers are ready.
(wait-until-ready 6789)
;; Initialize the public/private key SRFI-39 parameters.
(%public-key (read-file-sexp %public-key-file))
(%private-key (read-file-sexp %private-key-file))
(test-begin "publish")
@ -227,6 +232,36 @@ References: ~%"
(list (assoc-ref info "Compression")
(dirname (assoc-ref info "URL")))))
(test-equal "custom nar path"
;; Serve nars at /foo/bar/chbouib instead of /nar.
(list `(("StorePath" . ,%item)
("URL" . ,(string-append "foo/bar/chbouib/" (basename %item)))
("Compression" . "none"))
200
404)
(let ((thread (with-separate-output-ports
(call-with-new-thread
(lambda ()
(guix-publish "--port=6798" "-C0"
"--nar-path=///foo/bar//chbouib/"))))))
(wait-until-ready 6798)
(let* ((base "http://localhost:6798/")
(part (store-path-hash-part %item))
(url (string-append base part ".narinfo"))
(nar-url (string-append base "foo/bar/chbouib/"
(basename %item)))
(body (http-get-port url)))
(list (filter (lambda (item)
(match item
(("Compression" . _) #t)
(("StorePath" . _) #t)
(("URL" . _) #t)
(_ #f)))
(recutils->alist body))
(response-code (http-get nar-url))
(response-code
(http-get (string-append base "nar/" (basename %item))))))))
(test-equal "/nar/ with properly encoded '+' sign"
"Congrats!"
(let ((item (add-text-to-store %store "fake-gtk+" "Congrats!")))

View File

@ -384,8 +384,8 @@
(guard (c ((nix-protocol-error? c) #t))
(build-derivations %store (list d))))))))
(cond-expand
(guile-2.0 "garbage: ?lambda: λ")
(else "garbage: <EFBFBD>lambda: λ"))))
(guile-2.2 "garbage: <20>lambda: λ")
(else "garbage: ?lambda: λ"))))
(test-assert "log-file, derivation"
(let* ((b (add-text-to-store %store "build" "echo $foo > $out" '()))