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

4 files changed, 32 insertions, 20 deletions

diff --git a/guix/import/pypi.scm b/guix/import/pypi.scm
index efa69081ef..343445aa22 100644
--- a/guix/import/pypi.scm
+++ b/guix/import/pypi.scm
@@ -33,6 +33,9 @@
   #:use-module (web uri)
   #:use-module (guix ui)
   #:use-module (guix utils)
+  #:use-module ((guix build utils)
+                #:select ((package-name->name+version
+                           . hyphen-package-name->name+version)))
   #:use-module (guix import utils)
   #:use-module ((guix download) #:prefix download:)
   #:use-module (guix import json)
@@ -41,7 +44,8 @@
   #:use-module (guix licenses)
   #:use-module (guix build-system python)
   #:use-module (gnu packages python)
-  #:export (pypi->guix-package
+  #:export (guix-package->pypi-name
+            pypi->guix-package
             %pypi-updater))
 
 (define (pypi-fetch name)
@@ -92,11 +96,8 @@ package."
   "Given a Python PACKAGE built from pypi.python.org, return the name of the
 package on PyPI."
   (let ((source-url (and=> (package-source package) origin-uri)))
-    ;; The URL has the form:
-    ;; 'https://pypi.python.org/packages/source/' +
-    ;; first letter of the package name +
-    ;; '/' + package name + '/' + ...
-    (substring source-url 42 (string-rindex source-url #\/))))
+    (hyphen-package-name->name+version
+     (basename (file-sans-extension source-url)))))
 
 (define (wheel-url->extracted-directory wheel-url)
   (match (string-split (basename wheel-url) #\-)
diff --git a/guix/profiles.scm b/guix/profiles.scm
index 1adb143c16..db807a8136 100644
--- a/guix/profiles.scm
+++ b/guix/profiles.scm
@@ -163,9 +163,8 @@
         (call-with-input-file file read-manifest)
         (manifest '()))))
 
-(define* (package->manifest-entry package #:optional output)
-  "Return a manifest entry for the OUTPUT of package PACKAGE.  When OUTPUT is
-omitted or #f, use the first output of PACKAGE."
+(define* (package->manifest-entry package #:optional (output "out"))
+  "Return a manifest entry for the OUTPUT of package PACKAGE."
   (let ((deps (map (match-lambda
                     ((label package)
                      (gexp-input package))
@@ -175,7 +174,7 @@ omitted or #f, use the first output of PACKAGE."
     (manifest-entry
      (name (package-name package))
      (version (package-version package))
-     (output (or output (car (package-outputs package))))
+     (output output)
      (item package)
      (dependencies (delete-duplicates deps))
      (search-paths (package-transitive-native-search-paths package)))))
@@ -188,8 +187,8 @@ denoting a specific output of a package."
    (map (match-lambda
          ((package output)
           (package->manifest-entry package output))
-         (package
-           (package->manifest-entry package)))
+         ((? package? package)
+          (package->manifest-entry package)))
         packages)))
 
 (define (manifest->gexp manifest)
diff --git a/guix/scripts/environment.scm b/guix/scripts/environment.scm
index ebe966f9cf..9f72b7bf24 100644
--- a/guix/scripts/environment.scm
+++ b/guix/scripts/environment.scm
@@ -90,8 +90,9 @@ existing enviroment variables with additional search paths."
             (evaluate-profile-search-paths profile paths))
 
   ;; Give users a way to know that they're in 'guix environment', so they can
-  ;; adjust 'PS1' accordingly, for instance.
-  (setenv "GUIX_ENVIRONMENT" "t"))
+  ;; adjust 'PS1' accordingly, for instance.  Set it to PROFILE so users can
+  ;; conveniently access its contents.
+  (setenv "GUIX_ENVIRONMENT" profile))
 
 (define (show-search-paths profile search-paths pure?)
   "Display SEARCH-PATHS applied to PROFILE.  When PURE? is #t, do not augment
diff --git a/guix/zlib.scm b/guix/zlib.scm
index 51e5e9e426..74420129f6 100644
--- a/guix/zlib.scm
+++ b/guix/zlib.scm
@@ -92,7 +92,8 @@ closes FD."
   (let ((proc (zlib-procedure int "gzread" (list '* '* unsigned-int))))
     (lambda* (gzfile bv #:optional (start 0) (count (bytevector-length bv)))
       "Read up to COUNT bytes from GZFILE into BV at offset START.  Return the
-number of uncompressed bytes actually read."
+number of uncompressed bytes actually read; it is zero if COUNT is zero or if
+the end-of-stream has been reached."
       (let ((ret (proc (gzip-file->pointer gzfile)
                        (bytevector->pointer bv start)
                        count)))
@@ -167,12 +168,20 @@ closed even if closing GZFILE triggers an exception."
   "Return an input port that decompresses data read from PORT, a file port.
 PORT is automatically closed when the resulting port is closed.  BUFFER-SIZE
 is the size in bytes of the internal buffer, 8 KiB by default; using a larger
-buffer increases decompression speed."
+buffer increases decompression speed.  An error is thrown if PORT contains
+buffered input, which would be lost (and is lost anyway)."
   (define gzfile
-    (gzdopen (fileno port) "r"))
+    (match (drain-input port)
+      (""                                         ;PORT's buffer is empty
+       (gzdopen (fileno port) "r"))
+      (_
+       ;; This is unrecoverable but it's better than having the buffered input
+       ;; be lost, leading to unclear end-of-file or corrupt-data errors down
+       ;; the path.
+       (throw 'zlib-error 'make-gzip-input-port
+              "port contains buffered input" port))))
 
   (define (read! bv start count)
-    ;; XXX: Can 'gzread!' return zero even though we haven't reached the EOF?
     (gzread! gzfile bv start count))
 
   (unless (= buffer-size %default-buffer-size)
@@ -189,8 +198,10 @@ buffer increases decompression speed."
 a file port, as its sink.  PORT is automatically closed when the resulting
 port is closed."
   (define gzfile
-    (gzdopen (fileno port)
-             (string-append "w" (number->string level))))
+    (begin
+      (force-output port)                         ;empty PORT's buffer
+      (gzdopen (fileno port)
+               (string-append "w" (number->string level)))))
 
   (define (write! bv start count)
     (gzwrite gzfile bv start count))