Re: package.el support for file: URLs

[Chong Yidong <cyd@stupidchicken.com>]

Ted Zlatanov <tzz@lifelogs.com> writes:

> Also, package.el assumes HTTP URLs so it breaks if you try to set up a
> local ELPA repo.  I made it work with these changes to just two
> functions.  The change introduces filep and uses it to determine if we
> need to do:
>
>         (package-handle-response)
>         (re-search-forward "^$" nil 'move)
>         (forward-char)
>
> Patch attached, please review as I don't know package.el so well.  It
> seems to work for me.

Don't we need to do the re-search-forward and forward-char even for
file:// URLs?  Those lines are intended to skip over the `Content-type'
and `Content-length' headers, which `url-retrieve-synchronously'
produces regardless of the URL type.

Also, you forgot `package-download-single' and package-x.el.

I modified your patch as follows.  Does it do the right thing?


=== modified file 'lisp/emacs-lisp/package.el'
*** lisp/emacs-lisp/package.el	2010-08-09 18:05:56 +0000
--- lisp/emacs-lisp/package.el	2010-08-14 22:11:57 +0000
***************
*** 625,653 ****
        (let ((load-path (cons pkg-dir load-path)))
  	(byte-recompile-directory pkg-dir 0 t)))))
  
! (defun package-handle-response ()
!   "Handle the response from the server.
! Parse the HTTP response and throw if an error occurred.
! The url package seems to require extra processing for this.
  This should be called in a `save-excursion', in the download buffer.
  It will move point to somewhere in the headers."
!   ;; We assume HTTP here.
!   (require 'url-http)
!   (let ((response (url-http-parse-response)))
!     (when (or (< response 200) (>= response 300))
!       (display-buffer (current-buffer))
!       (error "Error during download request:%s"
! 	     (buffer-substring-no-properties (point) (progn
! 						       (end-of-line)
! 						       (point)))))))
  
  (defun package-download-single (name version desc requires)
    "Download and install a single-file package."
!   (let ((buffer (url-retrieve-synchronously
! 		 (concat (package-archive-url name)
! 			 (symbol-name name) "-" version ".el"))))
      (with-current-buffer buffer
!       (package-handle-response)
        (re-search-forward "^$" nil 'move)
        (forward-char)
        (delete-region (point-min) (point))
--- 625,653 ----
        (let ((load-path (cons pkg-dir load-path)))
  	(byte-recompile-directory pkg-dir 0 t)))))
  
! (defun package-handle-response (url)
!   "Handle the response from the server we accessed via URL.
! If URL is a HTTP URL, parse the HTTP response and signal an error
! if a HTTP error occurred.  For other URL types, nothing is done.
  This should be called in a `save-excursion', in the download buffer.
  It will move point to somewhere in the headers."
!   (when (equal "http" (url-type (url-generic-parse-url url)))
!     (require 'url-http)
!     (let ((response (url-http-parse-response)))
!       (when (or (< response 200) (>= response 300))
! 	(display-buffer (current-buffer))
! 	(error "Error during download request:%s"
! 	       (buffer-substring-no-properties (point) (progn
! 							 (end-of-line)
! 							 (point))))))))
  
  (defun package-download-single (name version desc requires)
    "Download and install a single-file package."
!   (let* ((url (concat (package-archive-url name)
! 		      (symbol-name name) "-" version ".el"))
! 	 (buffer (url-retrieve-synchronously url)))
      (with-current-buffer buffer
!       (package-handle-response url)
        (re-search-forward "^$" nil 'move)
        (forward-char)
        (delete-region (point-min) (point))
***************
*** 656,666 ****
  
  (defun package-download-tar (name version)
    "Download and install a tar package."
!   (let ((tar-buffer (url-retrieve-synchronously
! 		     (concat (package-archive-url name)
! 			     (symbol-name name) "-" version ".tar"))))
      (with-current-buffer tar-buffer
!       (package-handle-response)
        (re-search-forward "^$" nil 'move)
        (forward-char)
        (package-unpack name version)
--- 656,666 ----
  
  (defun package-download-tar (name version)
    "Download and install a tar package."
!   (let* ((url (concat (package-archive-url name)
! 		      (symbol-name name) "-" version ".tar"))
! 	 (tar-buffer (url-retrieve-synchronously url)))
      (with-current-buffer tar-buffer
!       (package-handle-response url)
        (re-search-forward "^$" nil 'move)
        (forward-char)
        (package-unpack name version)
***************
*** 995,1003 ****
           (archive-url  (cdr archive))
  	 (dir (expand-file-name "archives" package-user-dir))
  	 (dir (expand-file-name archive-name dir))
!          (buffer (url-retrieve-synchronously (concat archive-url file))))
      (with-current-buffer buffer
!       (package-handle-response)
        (re-search-forward "^$" nil 'move)
        (forward-char)
        (delete-region (point-min) (point))
--- 995,1004 ----
           (archive-url  (cdr archive))
  	 (dir (expand-file-name "archives" package-user-dir))
  	 (dir (expand-file-name archive-name dir))
! 	 (url (concat archive-url file))
!          (buffer (url-retrieve-synchronously url)))
      (with-current-buffer buffer
!       (package-handle-response url)
        (re-search-forward "^$" nil 'move)
        (forward-char)
        (delete-region (point-min) (point))
*** lisp/emacs-lisp/package-x.el	2010-08-09 18:05:56 +0000
--- lisp/emacs-lisp/package-x.el	2010-08-14 22:07:23 +0000
***************
*** 133,144 ****
  	     (pkg-buffer (current-buffer))
  
  	     ;; Download latest archive-contents.
! 	     (buffer (url-retrieve-synchronously
! 		      (concat archive-url "archive-contents"))))
  
  	;; Parse archive-contents.
  	(set-buffer buffer)
! 	(package-handle-response)
  	(re-search-forward "^$" nil 'move)
  	(forward-char)
  	(delete-region (point-min) (point))
--- 133,144 ----
  	     (pkg-buffer (current-buffer))
  
  	     ;; Download latest archive-contents.
! 	     (url (concat archive-url "archive-contents"))
! 	     (buffer (url-retrieve-synchronously url)))
  
  	;; Parse archive-contents.
  	(set-buffer buffer)
! 	(package-handle-response url)
  	(re-search-forward "^$" nil 'move)
  	(forward-char)
  	(delete-region (point-min) (point))