Implement ftp: and file:

1 files changed, 39 insertions, 0 deletions

diff --git a/lisp/url/with-url.el b/lisp/url/with-url.el
index da28ee66e28..17b1a16d88e 100644
--- a/lisp/url/with-url.el
+++ b/lisp/url/with-url.el
@@ -201,6 +201,12 @@ If given, return the value in BUFFER instead."
     (setf (url-request-url req) (url-request-original-url req)))
   (setf (url-request-parsed-url req)
         (url-generic-parse-url (url-request-url req)))
+  (pcase (url-type (url-request-parsed-url req))
+    ((or "http" "https") (with-url--fetch-http req))
+    ("ftp" (with-url--fetch-ftp req))
+    ("file" (with-url--fetch-file req))))
+
+(defun with-url--fetch-http (req)
   (when (or (url-request-timeout req)
             (url-request-read-timeout req))
     (setf (url-request-timer req)
@@ -232,6 +238,39 @@ If given, return the value in BUFFER instead."
              :filter #'with-url--filter)))
       (setf (url-request-process req) process))))
 
+(defun with-url--fetch-ftp (req)
+  (let ((parsed (url-request-parsed-url req)))
+    ;; Transform the URL into Tramp syntax and let it worry about it.
+    (with-url--fetch-file
+     (concat "/"
+             (and (url-user parsed)
+                  (format "%s@" (url-user parsed)))
+             (url-host)
+             (and (url-port parsed)
+                  (format "#s" (url-port parsed)))
+             ":"
+             (url-filename parsed)))))
+
+(defun with-url--fetch-file (req)
+  (with-current-buffer (generate-new-buffer "*request*")
+    (set-buffer-multibyte nil)
+    (let ((coding-system-for-read 'binary)
+          (coding-system-for-write 'binary)
+          (buffer (current-buffer)))
+      (condition-case err
+          (insert-file-contents-literally
+           (url-filename (url-request-parsed-url req)))
+        (error
+         (setq-local with-url--status
+                     (list 500 (format "Error occurred while fetching file: %s"
+                                       err)))))
+      (when (or (not (url-request-ignore-errors req))
+                (url-okp))
+        (goto-char (point-min))
+        (unwind-protect
+            (funcall (url-request-callback req))
+          (kill-buffer buffer))))))
+
 (defun with-url--timer (req)
   (let ((now (float-time)))
     ;; There are two possible timeouts: One for the overall time of