Merge branch 'master' into core-updates

5 files changed, 69 insertions, 56 deletions

diff --git a/guix/scripts/build.scm b/guix/scripts/build.scm
index 61ca4dca9f..ec58ba871b 100644
--- a/guix/scripts/build.scm
+++ b/guix/scripts/build.scm
@@ -836,11 +836,9 @@ build."
            (#t
             (match (package-source p)
               (#f
-               (format (current-error-port)
-                       (G_ "~a: warning: \
-package '~a' has no source~%")
-                       (location->string (package-location p))
-                       (package-name p))
+               (warning (package-location p)
+                        (G_ "package '~a' has no source~%")
+                        (package-name p))
                '())
               (s
                (list (package-source-derivation store s)))))
@@ -918,7 +916,8 @@ needed."
                                    '())))
                    (items (filter-map (match-lambda
                                         (('argument . (? store-path? file))
-                                         file)
+                                         (and (not (derivation-path? file))
+                                              file))
                                         (_ #f))
                                       opts))
                    (roots (filter-map (match-lambda
diff --git a/guix/scripts/graph.scm b/guix/scripts/graph.scm
index 8fe81ad64b..2e14857f1e 100644
--- a/guix/scripts/graph.scm
+++ b/guix/scripts/graph.scm
@@ -254,8 +254,7 @@ GNU-BUILD-SYSTEM have zero dependencies."
   "Return the <derivation> objects and store items corresponding to the
 dependencies of OBJ, a <derivation> or store item."
   (if (derivation? obj)
-      (append (map (compose read-derivation-from-file derivation-input-path)
-                   (derivation-inputs obj))
+      (append (map derivation-input-derivation (derivation-inputs obj))
               (derivation-sources obj))
       '()))
 
diff --git a/guix/scripts/package.scm b/guix/scripts/package.scm
index 5751123525..7b277b63f1 100644
--- a/guix/scripts/package.scm
+++ b/guix/scripts/package.scm
@@ -26,6 +26,7 @@
 (define-module (guix scripts package)
   #:use-module (guix ui)
   #:use-module ((guix status) #:select (with-status-verbosity))
+  #:use-module ((guix build syscalls) #:select (terminal-rows))
   #:use-module (guix store)
   #:use-module (guix grafts)
   #:use-module (guix derivations)
@@ -178,9 +179,9 @@ hooks\" run when building the profile."
 ;;;
 
 (define (find-packages-by-description regexps)
-  "Return two values: the list of packages whose name, synopsis, description,
-or output matches at least one of REGEXPS sorted by relevance, and the list of
-relevance scores."
+  "Return a list of pairs: packages whose name, synopsis, description,
+or output matches at least one of REGEXPS sorted by relevance, and its
+non-zero relevance score."
   (let ((matches (fold-packages (lambda (package result)
                                   (if (package-superseded package)
                                       result
@@ -189,19 +190,19 @@ relevance scores."
                                         ((? zero?)
                                          result)
                                         (score
-                                         (cons (list package score)
+                                         (cons (cons package score)
                                                result)))))
                                 '())))
-    (unzip2 (sort matches
-                  (lambda (m1 m2)
-                    (match m1
-                      ((package1 score1)
-                       (match m2
-                         ((package2 score2)
-                          (if (= score1 score2)
-                              (string>? (package-full-name package1)
-                                        (package-full-name package2))
-                              (> score1 score2)))))))))))
+    (sort matches
+          (lambda (m1 m2)
+            (match m1
+              ((package1 . score1)
+               (match m2
+                 ((package2 . score2)
+                  (if (= score1 score2)
+                      (string>? (package-full-name package1)
+                                (package-full-name package2))
+                      (> score1 score2))))))))))
 
 (define (transaction-upgrade-entry entry transaction)
   "Return a variant of TRANSACTION that accounts for the upgrade of ENTRY, a
@@ -755,16 +756,10 @@ processed, #f otherwise."
                                       (('query 'search rx) rx)
                                       (_                   #f))
                                     opts))
-              (regexps  (map (cut make-regexp* <> regexp/icase) patterns)))
+              (regexps  (map (cut make-regexp* <> regexp/icase) patterns))
+              (matches  (find-packages-by-description regexps)))
          (leave-on-EPIPE
-          (let-values (((packages scores)
-                        (find-packages-by-description regexps)))
-            (for-each (lambda (package score)
-                        (package->recutils package (current-output-port)
-                                           #:extra-fields
-                                           `((relevance . ,score))))
-                      packages
-                      scores)))
+          (display-search-results matches (current-output-port)))
          #t))
 
       (('show requested-name)
diff --git a/guix/scripts/publish.scm b/guix/scripts/publish.scm
index b4334b3f16..c716998a5b 100644
--- a/guix/scripts/publish.scm
+++ b/guix/scripts/publish.scm
@@ -724,6 +724,32 @@ example: \"/foo/bar\" yields '(\"foo\" \"bar\")."
 (define %http-write
   (@@ (web server http) http-write))
 
+(match (list (major-version) (minor-version) (micro-version))
+  (("2" "2" "5")                                  ;Guile 2.2.5
+   (let ()
+     (define %read-line (@ (ice-9 rdelim) %read-line))
+     (define bad-header (@@ (web http) bad-header))
+
+     ;; XXX: Work around <https://bugs.gnu.org/36350> by reverting to the
+     ;; definition of 'read-header-line' as found in 2.2.4 and earlier.
+     (define (read-header-line port)
+       "Read an HTTP header line and return it without its final CRLF or LF.
+Raise a 'bad-header' exception if the line does not end in CRLF or LF,
+or if EOF is reached."
+       (match (%read-line port)
+         (((? string? line) . #\newline)
+          ;; '%read-line' does not consider #\return a delimiter; so if it's
+          ;; there, remove it.  We are more tolerant than the RFC in that we
+          ;; tolerate LF-only endings.
+          (if (string-suffix? "\r" line)
+              (string-drop-right line 1)
+              line))
+         ((line . _)                              ;EOF or missing delimiter
+          (bad-header 'read-header-line line))))
+
+     (set! (@@ (web http) read-header-line) read-header-line)))
+  (_ #t))
+
 (define (strip-headers response)
   "Return RESPONSE's headers minus 'Content-Length' and our internal headers."
   (fold alist-delete
diff --git a/guix/scripts/system/search.scm b/guix/scripts/system/search.scm
index 955cdd1e95..5278062edd 100644
--- a/guix/scripts/system/search.scm
+++ b/guix/scripts/system/search.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2017, 2018 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2018 Clément Lassieur <clement@lassieur.org>
 ;;;
 ;;; This file is part of GNU Guix.
@@ -139,9 +139,8 @@ columns."
      . 1)))
 
 (define (find-service-types regexps)
-  "Return two values: the list of service types whose name or description
-matches at least one of REGEXPS sorted by relevance, and the list of relevance
-scores."
+  "Return a list of service type/score pairs: service types whose name or
+description matches REGEXPS sorted by relevance, and their score."
   (let ((matches (fold-service-types
                   (lambda (type result)
                     (match (relevance type regexps
@@ -149,30 +148,25 @@ scores."
                       ((? zero?)
                        result)
                       (score
-                       (cons (list type score) result))))
+                       (cons (cons type score) result))))
                   '())))
-    (unzip2 (sort matches
-                  (lambda (m1 m2)
-                    (match m1
-                      ((type1 score1)
-                       (match m2
-                         ((type2 score2)
-                          (if (= score1 score2)
-                              (string>? (service-type-name* type1)
-                                        (service-type-name* type2))
-                              (> score1 score2)))))))))))
+    (sort matches
+          (lambda (m1 m2)
+            (match m1
+              ((type1 . score1)
+               (match m2
+                 ((type2 . score2)
+                  (if (= score1 score2)
+                      (string>? (service-type-name* type1)
+                                (service-type-name* type2))
+                      (> score1 score2))))))))))
 
 
 (define (guix-system-search . args)
   (with-error-handling
-    (let ((regexps (map (cut make-regexp* <> regexp/icase) args)))
+    (let* ((regexps (map (cut make-regexp* <> regexp/icase) args))
+           (matches (find-service-types regexps)))
       (leave-on-EPIPE
-       (let-values (((services scores)
-                     (find-service-types regexps)))
-         (for-each (lambda (service score)
-                     (service-type->recutils service
-                                             (current-output-port)
-                                             #:extra-fields
-                                             `((relevance . ,score))))
-                   services
-                   scores))))))
+       (display-search-results matches (current-output-port)
+                               #:print service-type->recutils
+                               #:command "guix system search")))))