summaryrefslogtreecommitdiff
path: root/guix
diff options
context:
space:
mode:
authorMark H Weaver <mhw@netris.org>2015-07-19 18:12:34 -0400
committerMark H Weaver <mhw@netris.org>2015-07-19 18:12:34 -0400
commit1b4e48d498a96d478baa1aae7d9c7ecdbd817d6f (patch)
tree4b650999e49a6f4d3dd116fab3f9ee8222247e07 /guix
parentaa27987f71cb8afa698ede551e20b1248f160113 (diff)
parent50c7a1e297bff0935674b4f30e854a8889becfdd (diff)
Merge branch 'master' into core-updates
Diffstat (limited to 'guix')
-rw-r--r--guix/build-system/ruby.scm2
-rw-r--r--guix/build/download.scm3
-rw-r--r--guix/build/ruby-build-system.scm12
-rw-r--r--guix/build/syscalls.scm32
-rw-r--r--guix/licenses.scm6
-rw-r--r--guix/scripts/package.scm16
-rw-r--r--guix/scripts/publish.scm2
-rw-r--r--guix/scripts/size.scm21
-rw-r--r--guix/scripts/system.scm11
-rw-r--r--guix/ui.scm17
10 files changed, 69 insertions, 53 deletions
diff --git a/guix/build-system/ruby.scm b/guix/build-system/ruby.scm
index e4fda30cf3..135eda665b 100644
--- a/guix/build-system/ruby.scm
+++ b/guix/build-system/ruby.scm
@@ -71,6 +71,7 @@
(define* (ruby-build store name inputs
#:key
+ (gem-flags ''())
(test-target "test")
(tests? #t)
(phases '(@ (guix build ruby-build-system)
@@ -95,6 +96,7 @@
(source
source))
#:system ,system
+ #:gem-flags ,gem-flags
#:test-target ,test-target
#:tests? ,tests?
#:phases ,phases
diff --git a/guix/build/download.scm b/guix/build/download.scm
index 65d18eb839..ae59b0109c 100644
--- a/guix/build/download.scm
+++ b/guix/build/download.scm
@@ -231,7 +231,8 @@ host name without trailing dot."
(resolve-interface '(web client))
'current-http-proxy))
(parameterize ((current-http-proxy #f))
- (when (getenv "https_proxy")
+ (when (and=> (getenv "https_proxy")
+ (negate string-null?))
(format (current-error-port)
"warning: 'https_proxy' is ignored~%"))
(thunk))
diff --git a/guix/build/ruby-build-system.scm b/guix/build/ruby-build-system.scm
index fce39b8dfd..307ac919dd 100644
--- a/guix/build/ruby-build-system.scm
+++ b/guix/build/ruby-build-system.scm
@@ -63,7 +63,8 @@ directory."
(zero? (system* "rake" test-target))
#t))
-(define* (install #:key source inputs outputs #:allow-other-keys)
+(define* (install #:key source inputs outputs (gem-flags '())
+ #:allow-other-keys)
(let* ((ruby-version
(match:substring (string-match "ruby-(.*)\\.[0-9]$"
(assoc-ref inputs "ruby"))
@@ -72,10 +73,11 @@ directory."
(gem-home (string-append out "/lib/ruby/gems/" ruby-version ".0")))
(setenv "GEM_HOME" gem-home)
(mkdir-p gem-home)
- (zero? (system* "gem" "install" "--local"
- (first-matching-file "\\.gem$")
- ;; Executables should go into /bin, not /lib/ruby/gems.
- "--bindir" (string-append out "/bin")))))
+ (zero? (apply system* "gem" "install" "--local"
+ (first-matching-file "\\.gem$")
+ ;; Executables should go into /bin, not /lib/ruby/gems.
+ "--bindir" (string-append out "/bin")
+ gem-flags))))
(define %standard-phases
(modify-phases gnu:%standard-phases
diff --git a/guix/build/syscalls.scm b/guix/build/syscalls.scm
index dcca5fc339..b7c0f7e745 100644
--- a/guix/build/syscalls.scm
+++ b/guix/build/syscalls.scm
@@ -398,22 +398,23 @@ system to PUT-OLD."
(define-syntax read-types
(syntax-rules ()
- ((_ bv offset ())
- '())
- ((_ bv offset (type0 types ...))
- (cons (read-type bv offset type0)
- (read-types bv (+ offset (type-size type0)) (types ...))))))
+ ((_ return bv offset () (values ...))
+ (return values ...))
+ ((_ return bv offset (type0 types ...) (values ...))
+ (read-types return
+ bv (+ offset (type-size type0)) (types ...)
+ (values ... (read-type bv offset type0))))))
(define-syntax define-c-struct
(syntax-rules ()
- "Define READ as an optimized serializer and WRITE! as a deserializer for
-the C structure with the given TYPES."
- ((_ name read write! (fields types) ...)
+ "Define READ as a deserializer and WRITE! as a serializer for the C
+structure with the given TYPES. READ uses WRAP-FIELDS to return its value."
+ ((_ name wrap-fields read write! (fields types) ...)
(begin
(define (write! bv offset fields ...)
(write-types bv offset (types ...) (fields ...)))
(define (read bv offset)
- (read-types bv offset (types ...)))))))
+ (read-types wrap-fields bv offset (types ...) ()))))))
;;;
@@ -463,6 +464,8 @@ the C structure with the given TYPES."
32))
(define-c-struct sockaddr-in ;<linux/in.h>
+ (lambda (family port address)
+ (make-socket-address family address port))
read-sockaddr-in
write-sockaddr-in!
(family unsigned-short)
@@ -470,6 +473,8 @@ the C structure with the given TYPES."
(address (int32 ~ big)))
(define-c-struct sockaddr-in6 ;<linux/in6.h>
+ (lambda (family port flowinfo address scopeid)
+ (make-socket-address family address port flowinfo scopeid))
read-sockaddr-in6
write-sockaddr-in6!
(family unsigned-short)
@@ -501,14 +506,9 @@ bytevector BV at INDEX."
"Read a socket address from bytevector BV at INDEX."
(let ((family (bytevector-u16-native-ref bv index)))
(cond ((= family AF_INET)
- (match (read-sockaddr-in bv index)
- ((family port address)
- (make-socket-address family address port))))
+ (read-sockaddr-in bv index))
((= family AF_INET6)
- (match (read-sockaddr-in6 bv index)
- ((family port flowinfo address scopeid)
- (make-socket-address family address port
- flowinfo scopeid))))
+ (read-sockaddr-in6 bv index))
(else
"unsupported socket address family" family))))
diff --git a/guix/licenses.scm b/guix/licenses.scm
index a036c8e903..5539f3e3e8 100644
--- a/guix/licenses.scm
+++ b/guix/licenses.scm
@@ -32,6 +32,7 @@
cddl1.0
cecill-c
artistic2.0 clarified-artistic
+ copyleft-next
cpl1.0
epl1.0
expat
@@ -154,6 +155,11 @@ at URI, which may be a file:// URI pointing the package's tree."
"http://gianluca.dellavedova.org/2011/01/03/clarified-artistic-license/"
"https://www.gnu.org/licenses/license-list.html#ArtisticLicense2"))
+(define copyleft-next
+ (license "copyleft-next"
+ "https://raw.github.com/richardfontana/copyleft-next/master/Releases/copyleft-next-0.3.0"
+ "GPL-compatible copyleft license"))
+
(define cpl1.0
(license "CPL 1.0"
"http://directory.fsf.org/wiki/License:CPLv1.0"
diff --git a/guix/scripts/package.scm b/guix/scripts/package.scm
index 56a6e2db64..b545ea2672 100644
--- a/guix/scripts/package.scm
+++ b/guix/scripts/package.scm
@@ -307,22 +307,6 @@ RX."
((<) #t)
(else #f)))))
-(define-syntax-rule (leave-on-EPIPE exp ...)
- "Run EXP... in a context when EPIPE errors are caught and lead to 'exit'
-with successful exit code. This is useful when writing to the standard output
-may lead to EPIPE, because the standard output is piped through 'head' or
-similar."
- (catch 'system-error
- (lambda ()
- exp ...)
- (lambda args
- ;; We really have to exit this brutally, otherwise Guile eventually
- ;; attempts to flush all the ports, leading to an uncaught EPIPE down
- ;; the path.
- (if (= EPIPE (system-error-errno args))
- (primitive-_exit 0)
- (apply throw args)))))
-
(define (upgradeable? name current-version current-path)
"Return #t if there's a version of package NAME newer than CURRENT-VERSION,
or if the newest available version is equal to CURRENT-VERSION but would have
diff --git a/guix/scripts/publish.scm b/guix/scripts/publish.scm
index 7bad2619b9..e0226f35ee 100644
--- a/guix/scripts/publish.scm
+++ b/guix/scripts/publish.scm
@@ -143,7 +143,7 @@ Publish ~a over HTTP.\n") %store-directory)
"Generate a narinfo key/value string for STORE-PATH using the details in
PATH-INFO. The narinfo is signed with KEY."
(let* ((url (string-append "nar/" (basename store-path)))
- (hash (bytevector->base32-string
+ (hash (bytevector->nix-base32-string
(path-info-hash path-info)))
(size (path-info-nar-size path-info))
(references (string-join
diff --git a/guix/scripts/size.scm b/guix/scripts/size.scm
index 13341fdfe2..1339742946 100644
--- a/guix/scripts/size.scm
+++ b/guix/scripts/size.scm
@@ -280,15 +280,16 @@ Report the size of PACKAGE and its dependencies.\n"))
(()
(leave (_ "missing store item argument\n")))
((file)
- (with-store store
- (run-with-store store
- (mlet* %store-monad ((item (ensure-store-item file))
- (profile (store-profile item)))
- (if map-file
- (begin
- (profile->page-map profile map-file)
- (return #t))
- (display-profile* profile)))
- #:system system)))
+ (leave-on-EPIPE
+ (with-store store
+ (run-with-store store
+ (mlet* %store-monad ((item (ensure-store-item file))
+ (profile (store-profile item)))
+ (if map-file
+ (begin
+ (profile->page-map profile map-file)
+ (return #t))
+ (display-profile* profile)))
+ #:system system))))
((files ...)
(leave (_ "too many arguments\n")))))))
diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm
index 6084ab8a37..45f598219d 100644
--- a/guix/scripts/system.scm
+++ b/guix/scripts/system.scm
@@ -249,16 +249,19 @@ it atomically, and then run OS's activation script."
(('boot-parameters ('version 0)
('label label) ('root-device root)
('kernel linux)
- _ ...)
+ rest ...)
(menu-entry
(label (string-append label " (#"
(number->string number) ", "
(seconds->string time) ")"))
(linux linux)
(linux-arguments
- (list (string-append "--root=" root)
- #~(string-append "--system=" #$system)
- #~(string-append "--load=" #$system "/boot")))
+ (cons* (string-append "--root=" root)
+ #~(string-append "--system=" #$system)
+ #~(string-append "--load=" #$system "/boot")
+ (match (assq 'kernel-arguments rest)
+ ((_ args) args)
+ (#f '())))) ;old format
(initrd #~(string-append #$system "/initrd"))))
(_ ;unsupported format
(warning (_ "unrecognized boot parameters for '~a'~%")
diff --git a/guix/ui.scm b/guix/ui.scm
index 11af646a6e..28d4b97118 100644
--- a/guix/ui.scm
+++ b/guix/ui.scm
@@ -62,6 +62,7 @@
show-manifest-transaction
call-with-error-handling
with-error-handling
+ leave-on-EPIPE
read/eval
read/eval-package-expression
location->string
@@ -430,6 +431,22 @@ interpreted."
(leave (_ "~a: ~a~%") proc
(apply format #f format-string format-args))))))
+(define-syntax-rule (leave-on-EPIPE exp ...)
+ "Run EXP... in a context when EPIPE errors are caught and lead to 'exit'
+with successful exit code. This is useful when writing to the standard output
+may lead to EPIPE, because the standard output is piped through 'head' or
+similar."
+ (catch 'system-error
+ (lambda ()
+ exp ...)
+ (lambda args
+ ;; We really have to exit this brutally, otherwise Guile eventually
+ ;; attempts to flush all the ports, leading to an uncaught EPIPE down
+ ;; the path.
+ (if (= EPIPE (system-error-errno args))
+ (primitive-_exit 0)
+ (apply throw args)))))
+
(define %guix-user-module
;; Module in which user expressions are evaluated.
;; Compute lazily to avoid circularity with (guix gexp).