Special treatment for file:// URIs on Windows

* lisp/url/url-parse.el (url-generic-parse-url): Remove prefix /
when a file URI's filename starts with a single letter followed
by a colon and a slash or backslash.
(url-recreate-url): Mirror the change applied when parsing, so
the URL is recreated properly on MS-Windows.
* test/lisp/url/url-parse-tests.el
(url-generic-parse-url/ms-windows-file-uri-hanlding): New test.
(Bug#76982)

(cherry picked from commit fec6e16f143c08d68ad336b9039f8ed1c3cbfc05)

diff --git a/lisp/url/url-parse.el b/lisp/url/url-parse.el
index 4c65721b83d1cdbc6332d86c51ddfd7358dada52..d2f49ef2c5ff9b42d1bda8fe73cfa0d83c910739 100644 (file)
--- a/lisp/url/url-parse.el
+++ b/lisp/url/url-parse.el
@@ -83,7 +83,12 @@ If the specified port number is the default, return nil."
         ;; port is empty or if its value would be the same as that of
         ;; the scheme's default."
         (port (url-port-if-non-default urlobj))
-        (file (url-filename urlobj))
+         ;; For Windows/DOS-like paths, `url-generic-parse-url' strips
+         ;; the leading /, so we need to add it back (bug#76982)
+        (file (if (and (string= "file" type)
+                        (string-match "^[A-Za-z]:[/\\]" (url-filename urlobj)))
+                   (concat "/" (url-filename urlobj))
+                 (url-filename urlobj)))
         (frag (url-target urlobj)))
     (concat (if type (concat type ":"))
            (if (url-fullness urlobj) "//")
@@ -190,6 +195,12 @@ parses to
          ;; authority) at the beginning of the absolute path.
 
           (setq save-pos (point))
+          ;; For file:// URIs, if the path "looks like" Windows/DOS,
+          ;; it makes sense to strip the leading slash (bug#76982)
+          (when (and (string= "file" scheme)
+                     (looking-at "/[A-Za-z]:[/\\]"))
+            (forward-char)
+            (setq save-pos (point)))
           (if (string= "data" scheme)
              ;; For the "data" URI scheme, all the rest is the FILE.
              (setq file (buffer-substring save-pos (point-max)))
@@ -210,6 +221,7 @@ parses to
 
           (if (and host (string-match "%[0-9][0-9]" host))
               (setq host (url-unhex-string host)))
+
           (url-parse-make-urlobj scheme user pass host port file
                                 fragment nil full))))))
 

diff --git a/test/lisp/url/url-parse-tests.el b/test/lisp/url/url-parse-tests.el
index e70c1eef32f7ff2e28f64a79b515cc82684656bd..8d57190ac325c39a6cd5b62d7c3845f663ea1853 100644 (file)
--- a/test/lisp/url/url-parse-tests.el
+++ b/test/lisp/url/url-parse-tests.el
@@ -166,6 +166,27 @@
                  (url-parse-make-urlobj "http" nil nil "банки.рф" nil
                                         "/фыва/" nil nil t))))
 
+(ert-deftest url-generic-parse-url/ms-windows-file-uri-hanlding ()
+  "bug#76982  Make an exception if a URI refers to a filename and it \"looks like\" a Windows path: strip the leading /"
+  (should (equal (url-generic-parse-url "file:///c:/windows-path") (url-parse-make-urlobj "file" nil nil "" nil "c:/windows-path" nil nil t)))
+  (should (equal (url-filename (url-generic-parse-url "file:///c:/directory/file.txt")) "c:/directory/file.txt"))
+  (should (equal (url-recreate-url (url-parse-make-urlobj "file" nil nil "" nil "c:/directory/file.txt" nil nil t)) "file:///c:/directory/file.txt"))
+  ;; https://www.rfc-editor.org/rfc/rfc8089.html#appendix-E.2
+  (should (equal (url-generic-parse-url "file:c:/path/to/file") (url-parse-make-urlobj "file" nil nil nil nil "c:/path/to/file" nil nil nil)))
+  (should (equal (url-recreate-url (url-parse-make-urlobj "file" nil nil nil nil "c:/path/to/file" nil nil nil)) "file:c:/path/to/file"))
+  ;; accept backslashes too
+  (should (equal (url-filename (url-generic-parse-url "file:///c:\\directory\\file.txt")) "c:\\directory\\file.txt"))
+  ;;
+  (should (equal (url-filename (url-generic-parse-url "file://localhost/c:/path/to/file")) "c:/path/to/file"))
+  )
+
+
+
+
+
+
+
+
 (provide 'url-parse-tests)
 
 ;;; url-parse-tests.el ends here