pkg/lib: more fixes to handling of relative package sources in catalogs

Relative paths in a catalog should be treated as relative URLs, not
relative paths.

pkgs/racket-pkgs/racket-doc/pkg/scribblings/catalog-protocol.scrbl

@@ -46,7 +46,7 @@ information about packages:
 
         @item{@racket['source] (required) --- a @tech{package source}
               string, typically a remote URL. If this source is a
-              relative path, then it is treated as relative to the
+              relative URL, then it is treated as relative to the
               catalog.
 
               @history[#:changed "6.0.1.7" @elem{Added relative-path support

pkgs/racket-pkgs/racket-test/tests/pkg/tests-catalogs.rkt

@@ -107,8 +107,9 @@
   $ (~a "raco pkg catalog-archive " archive-d " http://localhost:9990")
   $ (~a "test -f " archive-d "/pkgs/pkg-test1.zip")
 
-  (define rx:pkg-test1 (regexp
+  (define (rx:pkg-test1 as-url?)
-                        (~a (regexp-quote (~a "Source: " archive-d "/pkgs/pkg-test1.zip"))
+    (regexp
+     (~a (regexp-quote (~a "Source: " (if as-url? "file://" "") archive-d "/pkgs/pkg-test1.zip"))
          ".*"
          (regexp-quote (~a "Checksum: " (file->string 
                                          (build-path archive-d
@@ -116,7 +117,7 @@
                                                      "pkg-test1.zip.CHECKSUM")))))))
   
   $ (~a "raco pkg catalog-show --catalog file://" archive-d "/catalog pkg-test1")
-  =stdout> rx:pkg-test1
+  =stdout> (rx:pkg-test1 #f)
 
   (delete-directory/files archive-d)
 
@@ -127,7 +128,7 @@
         " " archive-d)
   =stdout> #rx"== Archiving pkg-test1 =="
   $ (~a "raco pkg catalog-show --catalog file://" archive-d "/catalog pkg-test1")
-  =stdout> rx:pkg-test1
+  =stdout> (rx:pkg-test1 #t)
   $ (~a "grep archive " archive-d "/catalog/pkg/pkg-test1") ; relative path => no "archive"
   =exit> 1
   $ (~a "test -f " archive-d "/pkgs/pkg-test2.zip")

racket/collects/pkg/lib.rkt

@@ -448,34 +448,27 @@
     (define new-ht
       (cond
        [s
-        ;; If `i' is a "file:" URL, then it makes sense to parse
+        ;; If `s' is a relative URL, then we rely on the pun
-        ;; `s' as a path and make it absolute relative to `i'.
+        ;; that it will parse as a relative path.
-        ;; If `i' is a URL, then `s' might be treated as a relative
-        ;; URL, and we rely on the pun that a relative URL looks
-        ;; like a relative path.
         (define-values (name type) (package-source->name+type s #f))
         (cond
          [(and (or (eq? type 'dir) (eq? type 'file))
-               (not (complete-path? (package-source->path s type))))
+               (not (regexp-match? #rx"^file://" s))
-          (define full-path
+               (relative-path? s))
+          (define i-for-combine
             (cond
              [(equal? "file" (url-scheme i))
-              (define path (url->path i))
+              (define i-path (url->path i))
-              (define dir (if (db-path? path)
+              (if (db-path? i-path)
-                              (let-values ([(base name dir?) (split-path path)])
+                  i
-                                base)
+                  ;; Make sure we interpret `i' as a directory when
-                              path))
+                  ;; adding a relative path:
-              (path->string (simplify-path (path->complete-path (package-source->path s type)
+                  (path->url (path->directory-path (url->path i))))]
-                                                                (path->complete-path dir))))]
+             [else i]))
-             [else
+          (define full-url
-              (define rel-url (string-join (for/list ([e (explode-path (package-source->path s type))])
+            (url->string
-                                             (cond
+             (combine-url/relative i-for-combine s)))
-                                              [(eq? e 'same) "."]
+          (hash-set ht 'source full-url)]
-                                              [(eq? e 'up) ".."]
-                                              [else (path-element->string e)]))
-                                           "/"))
-              (url->string (combine-url/relative i rel-url))]))
-          (hash-set ht 'source full-path)]
          [else ht])]
        [else ht]))
     (let ([v (hash-ref new-ht 'versions #f)])
@@ -499,15 +492,10 @@
        [(or (eq? type 'dir) (eq? type 'file))
         (hash-set ht
                   'source
-                  (string-join (map (lambda (s)
+                  (relative-path->relative-url-string
-                                      (case s
+                   (find-relative-path
-                                        [(up) ".."]
-                                        [(same) "."]
-                                        [else (path-element->string s)]))
-                                    (explode-path (find-relative-path 
                     dir
-                                                   (package-source->path s type))))
+                    (package-source->path s type))))]
-                               "/"))]
        [else ht])]
      [else ht]))
   (let ([v (hash-ref new-ht 'versions #f)])