Merge branch 'master' into core-updates

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).