[PATCH] package-x.el: package-upload-buffer-internal

[PATCH] package-x.el: package-upload-buffer-internal

[Jambunathan K]

[-- Attachment #1: Type: text/plain, Size: 1227 bytes --]


Summary:
-------

1. M-x package-upload-file currently downloads 'archive-contents' from a
   remote location and writes back the updated file to
   package-archive-upload-base. This seems inconsistent to me. The
   attached fix addresses this inconsistency.

2. A new knob 'package-update-news-on-upload' controls the update of
   news and rss feeds.

Note: 

1. package-x.el was manually downloaded from repo.or.cz a few hours
   ago. I don't have (and don't intend to) checkout emacs. Hope the
   patch applies cleanly.
2. My FSF papers (for orgmode) are in postal transit.

Jambunathan K.

Changelog:
---------

2010-10-28  Jambunathan K  <kjambunathan@gmail.com>

	* package-x.el (package-update-news-on-upload): New knob. Set it
	to nil if you are not interested in NEWS and RSS feeds.
	(package--archive-contents-from-url): New. Download
	archive-contents from archive-url, parse it and return the val.
	(package--archive-contents-from-file): New. Parse
	'archive-contents' and return the val.
	(package-upload-buffer-internal): Modified. Read archive-contents
	from package-archive-upload-base and not from archive-url. Use
	archive-url only for writing in to rss feeds. This is a departure
	from current behaviour.



[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: package-x.diff --]
[-- Type: text/x-patch, Size: 5386 bytes --]

--- package-x.el	2010-10-28 00:57:05.875000000 +0530
+++ package-x-modified.el	2010-10-28 01:06:51.078125000 +0530
@@ -40,6 +40,9 @@
 (defvar package-archive-upload-base nil
   "Base location for uploading to package archive.")
 
+(defvar package-update-news-on-upload t
+  "Should package upload also update NEWS and RSS feeds?.")
+
 (defun package--encode (string)
   "Encode a string by replacing some characters with XML entities."
   ;; We need a special case for translating "&" to "&amp;".
@@ -86,6 +89,39 @@
 	(unless old-buffer
 	  (kill-buffer (current-buffer)))))))
 
+(defun package--archive-contents-from-url (&optional archive-url) 
+  "Parse archive-contents file at ARCHIVE-URL.
+
+If ARCHIVE-URL is unspecified the \"gnu\" archive is used."
+  (unless archive-url
+    (or (setq archive-url (cdr (assoc "gnu" package-archives)))
+	(error "No destination URL")))
+
+  (let* ((buffer (url-retrieve-synchronously
+		  (concat archive-url "archive-contents"))))
+    (set-buffer buffer)
+    (package-handle-response)
+    (re-search-forward "^$" nil 'move)
+    (forward-char)
+    (delete-region (point-min) (point))
+    (prog1 (package-read-from-string
+	    (buffer-substring-no-properties (point-min) (point-max)))
+          (kill-buffer buffer))))
+
+(defun package--archive-contents-from-file (file)
+  "Parse the given archive-contents file."
+  (if (not (file-exists-p file))
+      ;; no existing archive-contents, possibly a new ELPA repo.
+      (list package-archive-version)
+    (let ((dont-kill (find-buffer-visiting file)))
+      (with-current-buffer (let ((find-file-visit-truename t))
+			     (find-file-noselect file))
+	(prog1
+	    (package-read-from-string
+	     (buffer-substring-no-properties (point-min) (point-max)))
+	  (unless dont-kill
+	    (kill-buffer (current-buffer))))))))
+    
 (defun package-maint-add-news-item (title description archive-url)
   "Add a news item to the ELPA web pages.
 TITLE is the title of the news item.
@@ -107,15 +143,17 @@ You need administrative access to ELPA t
 
 (defun package-upload-buffer-internal (pkg-info extension &optional archive-url)
   "Upload a package whose contents are in the current buffer.
+By default, package files and archive-contents are uploaded to
+the `default-directory'. Set `package-archive-upload-base' to
+override the default behaviour.
 PKG-INFO is the package info, see `package-buffer-info'.
 EXTENSION is the file extension, a string.  It can be either
 \"el\" or \"tar\".
 
-Optional arg ARCHIVE-URL is the URL of the destination archive.
-If nil, the \"gnu\" archive is used."
-  (unless archive-url
-    (or (setq archive-url (cdr (assoc "gnu" package-archives)))
-	(error "No destination URL")))
+Optional arg ARCHIVE-URL is the URL of the destination archive to
+be embedded in the RSS file. If nil, the \"gnu\" archive is
+used. This arg is effective only when
+`package-update-news-on-upload' is non-nil."
   (save-excursion
     (save-restriction
       (let* ((file-type (cond
@@ -132,20 +170,10 @@ If nil, the \"gnu\" archive is used."
 	     (commentary (aref pkg-info 4))
 	     (split-version (version-to-list pkg-version))
 	     (pkg-buffer (current-buffer))
+	     (upload-dir (or package-archive-upload-base default-directory)))
 
-	     ;; 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))
-	(let ((contents (package-read-from-string
-			 (buffer-substring-no-properties (point-min)
-							 (point-max))))
+	(let ((contents (package--archive-contents-from-file
+			 (concat upload-dir "archive-contents")))
 	      (new-desc (vector split-version requires desc file-type)))
 	  (if (> (car contents) package-archive-version)
 	      (error "Unrecognized archive version %d" (car contents)))
@@ -166,32 +194,35 @@ If nil, the \"gnu\" archive is used."
 		(print-length nil))
 	    (write-region (concat (pp-to-string contents) "\n")
 			  nil
-			  (concat package-archive-upload-base
-				  "archive-contents")))
+			  (concat upload-dir "archive-contents")))
 
 	  ;; If there is a commentary section, write it.
 	  (when commentary
 	    (write-region commentary nil
-			  (concat package-archive-upload-base
+			  (concat upload-dir
 				  (symbol-name pkg-name) "-readme.txt")))
 
 	  (set-buffer pkg-buffer)
-	  (kill-buffer buffer)
 	  (write-region (point-min) (point-max)
-			(concat package-archive-upload-base
+			(concat upload-dir
 				file-name "-" pkg-version
 				"." extension)
 			nil nil nil 'excl)
 
 	  ;; Write a news entry.
+	  (when package-update-news-on-upload
+	    (unless archive-url
+	      (or (setq archive-url (cdr (assoc "gnu" package-archives)))
+		  (error "No destination URL")))
+	    
 	  (package--update-news (concat file-name "." extension)
-				pkg-version desc archive-url)
+				  pkg-version desc archive-url))
 
 	  ;; special-case "package": write a second copy so that the
 	  ;; installer can easily find the latest version.
 	  (if (string= file-name "package")
 	      (write-region (point-min) (point-max)
-			    (concat package-archive-upload-base
+			    (concat upload-dir
 				    file-name "." extension)
 			    nil nil nil 'ask)))))))
 

Re: [PATCH] package-x.el: package-upload-buffer-internal

[Chong Yidong]

Jambunathan K <kjambunathan@gmail.com> writes:

> 1. M-x package-upload-file currently downloads 'archive-contents' from a
>    remote location and writes back the updated file to
>    package-archive-upload-base. This seems inconsistent to me. The
>    attached fix addresses this inconsistency.

Thanks for the patch, but could you explain why you think the current
behavior is inconsistent?  The reason it downloads archive-contents is
that the local copy might be out of date.  Before changing
archive-contents, it should be necessary to make sure you're working on
the most recent copy.

By the way, in the future, please post context diffs ("diff -c", or use
the diff utilities built into Emacs).  I find it difficult to read the
diff you sent.  Thanks.

Re: [PATCH] package-x.el: package-upload-buffer-internal

[Jambunathan K]

[-- Attachment #1: Type: text/plain, Size: 3244 bytes --]

Chong Yidong <cyd@stupidchicken.com> writes:

> Jambunathan K <kjambunathan@gmail.com> writes:
>
>> 1. M-x package-upload-file currently downloads 'archive-contents' from a
>>    remote location and writes back the updated file to
>>    package-archive-upload-base. This seems inconsistent to me. The
>>    attached fix addresses this inconsistency.
>

>
> By the way, in the future, please post context diffs ("diff -c", or use
> the diff utilities built into Emacs).  I find it difficult to read the
> diff you sent. 

Re-attaching the 'diff -c' output. Hope it is OK now.

> Thanks for the patch, but could you explain why you think the current
> behavior is inconsistent?  The reason it downloads archive-contents is
> that the local copy might be out of date.  

> Before changing archive-contents, it should be necessary to make sure
> you're working on the most recent copy.

What is a remote-site for the user is a "local-machine" for the package
maintainer/uploader.

The assumption I make is that 'package-archive-upload-base' points to
the 'pub' dir of the webserver. It is the 'archive-contents' in this dir
that the webserver is essentially going to serve. So 'archive-contents'
retrieved through the URL would be the same as that read from
'package-archive-base'.

The implicit assumption in your argument/package-x seems to be that
there are multiple agents that write to the web-server and the one
running package-upload-file is just one such agent [1].

The above distributed scenario is less likely to arise for
one-package-only repos like Orgmode. I think it is essential that be
package-x also account for simple local ELPA repos.

Specifically, the use-case scenario that I have in mind is:

1. make all
2. make pkg
3. make pkg-upload
   pkg-upload: pkg
	$(BATCH) $(BATCH_EXTRA)				        	\
	 --eval "(require 'package-x)"					\
	 --eval '(setq package-archive-upload-base $(PKG_UPLOAD_DIR))'	\
	 --eval '(setq package-update-news-on-upload nil)'		\
	 --eval '(package-upload-file "org-$(PKG_TAG).tar")'

all in the same local machine that acts both as a build-machine and
webserver.

I would like to bring your attention to little things that my patch
introduces:

1. Setting package-update-news-on-upload to nil would be light on the
   maintainer (i.e., two less files to contend with)

2. Permit non-existent 'archive-contents'. Common-case for first few
   months or for the new repos.

3. Having 'package-archive-upload-base' as nil is like standing on a
   shifting sand i.e., it is relative to whatever happens to be the
   'default-directory' right now.

   As I was working on this patch, I accidentally shifted to a new
   buffer (with a different 'default-directory') between writing of
   'archive-contents' and writing of the tar ball. I was little bit
   taken surprised to notice the two fragments going their own ways.

   Local variable 'upload-dir' guards against such unintended goof-ups.

Footnotes:
=========
[1] I am unable to comprehend the details of how master and agents
    interact with each other. I am also unable to explain how writing to
    'package-archive-upload-base' would get reflected in the
    webserver/master.

[2] Included as recipe for others.

Jambunathan K.

Attachments:


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: package-x.diff --]
[-- Type: text/x-patch, Size: 7013 bytes --]

*** package-x.el	2010-11-01 22:33:40.843750000 +0530
--- package-x-modified.el	2010-11-01 22:33:43.281250000 +0530
***************
*** 40,45 ****
--- 40,48 ----
  (defvar package-archive-upload-base nil
    "Base location for uploading to package archive.")
  
+ (defvar package-update-news-on-upload t
+   "Should package upload also update NEWS and RSS feeds?.")
+ 
  (defun package--encode (string)
    "Encode a string by replacing some characters with XML entities."
    ;; We need a special case for translating "&" to "&amp;".
***************
*** 86,91 ****
--- 89,127 ----
  	(unless old-buffer
  	  (kill-buffer (current-buffer)))))))
  
+ (defun package--archive-contents-from-url (&optional archive-url) 
+   "Parse archive-contents file at ARCHIVE-URL.
+ 
+ If ARCHIVE-URL is unspecified the \"gnu\" archive is used."
+   (unless archive-url
+     (or (setq archive-url (cdr (assoc "gnu" package-archives)))
+ 	(error "No destination URL")))
+ 
+   (let* ((buffer (url-retrieve-synchronously
+ 		  (concat archive-url "archive-contents"))))
+     (set-buffer buffer)
+     (package-handle-response)
+     (re-search-forward "^$" nil 'move)
+     (forward-char)
+     (delete-region (point-min) (point))
+     (prog1 (package-read-from-string
+ 	    (buffer-substring-no-properties (point-min) (point-max)))
+           (kill-buffer buffer))))
+ 
+ (defun package--archive-contents-from-file (file)
+   "Parse the given archive-contents file."
+   (if (not (file-exists-p file))
+       ;; no existing archive-contents, possibly a new ELPA repo.
+       (list package-archive-version)
+     (let ((dont-kill (find-buffer-visiting file)))
+       (with-current-buffer (let ((find-file-visit-truename t))
+ 			     (find-file-noselect file))
+ 	(prog1
+ 	    (package-read-from-string
+ 	     (buffer-substring-no-properties (point-min) (point-max)))
+ 	  (unless dont-kill
+ 	    (kill-buffer (current-buffer))))))))
+     
  (defun package-maint-add-news-item (title description archive-url)
    "Add a news item to the ELPA web pages.
  TITLE is the title of the news item.
***************
*** 107,121 ****
  
  (defun package-upload-buffer-internal (pkg-info extension &optional archive-url)
    "Upload a package whose contents are in the current buffer.
  PKG-INFO is the package info, see `package-buffer-info'.
  EXTENSION is the file extension, a string.  It can be either
  \"el\" or \"tar\".
  
! Optional arg ARCHIVE-URL is the URL of the destination archive.
! If nil, the \"gnu\" archive is used."
!   (unless archive-url
!     (or (setq archive-url (cdr (assoc "gnu" package-archives)))
! 	(error "No destination URL")))
    (save-excursion
      (save-restriction
        (let* ((file-type (cond
--- 143,159 ----
  
  (defun package-upload-buffer-internal (pkg-info extension &optional archive-url)
    "Upload a package whose contents are in the current buffer.
+ By default, package files and archive-contents are uploaded to
+ the `default-directory'. Set `package-archive-upload-base' to
+ override the default behaviour.
  PKG-INFO is the package info, see `package-buffer-info'.
  EXTENSION is the file extension, a string.  It can be either
  \"el\" or \"tar\".
  
! Optional arg ARCHIVE-URL is the URL of the destination archive to
! be embedded in the RSS file. If nil, the \"gnu\" archive is
! used. This arg is effective only when
! `package-update-news-on-upload' is non-nil."
    (save-excursion
      (save-restriction
        (let* ((file-type (cond
***************
*** 132,151 ****
  	     (commentary (aref pkg-info 4))
  	     (split-version (version-to-list pkg-version))
  	     (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))
! 	(let ((contents (package-read-from-string
! 			 (buffer-substring-no-properties (point-min)
! 							 (point-max))))
  	      (new-desc (vector split-version requires desc file-type)))
  	  (if (> (car contents) package-archive-version)
  	      (error "Unrecognized archive version %d" (car contents)))
--- 170,179 ----
  	     (commentary (aref pkg-info 4))
  	     (split-version (version-to-list pkg-version))
  	     (pkg-buffer (current-buffer))
+ 	     (upload-dir (or package-archive-upload-base default-directory)))
  
! 	(let ((contents (package--archive-contents-from-file
! 			 (concat upload-dir "archive-contents")))
  	      (new-desc (vector split-version requires desc file-type)))
  	  (if (> (car contents) package-archive-version)
  	      (error "Unrecognized archive version %d" (car contents)))
***************
*** 166,197 ****
  		(print-length nil))
  	    (write-region (concat (pp-to-string contents) "\n")
  			  nil
! 			  (concat package-archive-upload-base
! 				  "archive-contents")))
  
  	  ;; If there is a commentary section, write it.
  	  (when commentary
  	    (write-region commentary nil
! 			  (concat package-archive-upload-base
  				  (symbol-name pkg-name) "-readme.txt")))
  
  	  (set-buffer pkg-buffer)
- 	  (kill-buffer buffer)
  	  (write-region (point-min) (point-max)
! 			(concat package-archive-upload-base
  				file-name "-" pkg-version
  				"." extension)
  			nil nil nil 'excl)
  
  	  ;; Write a news entry.
  	  (package--update-news (concat file-name "." extension)
! 				pkg-version desc archive-url)
  
  	  ;; special-case "package": write a second copy so that the
  	  ;; installer can easily find the latest version.
  	  (if (string= file-name "package")
  	      (write-region (point-min) (point-max)
! 			    (concat package-archive-upload-base
  				    file-name "." extension)
  			    nil nil nil 'ask)))))))
  
--- 194,228 ----
  		(print-length nil))
  	    (write-region (concat (pp-to-string contents) "\n")
  			  nil
! 			  (concat upload-dir "archive-contents")))
  
  	  ;; If there is a commentary section, write it.
  	  (when commentary
  	    (write-region commentary nil
! 			  (concat upload-dir
  				  (symbol-name pkg-name) "-readme.txt")))
  
  	  (set-buffer pkg-buffer)
  	  (write-region (point-min) (point-max)
! 			(concat upload-dir
  				file-name "-" pkg-version
  				"." extension)
  			nil nil nil 'excl)
  
  	  ;; Write a news entry.
+ 	  (when package-update-news-on-upload
+ 	    (unless archive-url
+ 	      (or (setq archive-url (cdr (assoc "gnu" package-archives)))
+ 		  (error "No destination URL")))
+ 	    
  	  (package--update-news (concat file-name "." extension)
! 				  pkg-version desc archive-url))
  
  	  ;; special-case "package": write a second copy so that the
  	  ;; installer can easily find the latest version.
  	  (if (string= file-name "package")
  	      (write-region (point-min) (point-max)
! 			    (concat upload-dir
  				    file-name "." extension)
  			    nil nil nil 'ask)))))))
  

Re: [PATCH] package-x.el: package-upload-buffer-internal

[Stefan Monnier]

> By the way, in the future, please post context diffs ("diff -c", or use
> the diff utilities built into Emacs).  I find it difficult to read the
> diff you sent.  Thanks.

AFAICT his diff uses the standard unified context diff format (which
I happen to find usually more readable).  If you have trouble reading
it, you can convert it to plain context diff format with M-x
diff-unified->context.


        Stefan

Re: [PATCH] package-x.el: package-upload-buffer-internal

[Chong Yidong]

Jambunathan K <kjambunathan@gmail.com> writes:

> The assumption I make is that 'package-archive-upload-base' points to
> the 'pub' dir of the webserver. It is the 'archive-contents' in this dir
> that the webserver is essentially going to serve. So 'archive-contents'
> retrieved through the URL would be the same as that read from
> 'package-archive-base'.

But there's no harm in doing that, other than a tiny bit of wasted
effort, is there?

> I would like to bring your attention to little things that my patch
> introduces:

Yes, many of these are good improvements.  Let me know when your
copyright assignment is complete.

Re: [PATCH] package-x.el: package-upload-buffer-internal

[Jambunathan K]

Chong

Chong Yidong <cyd@stupidchicken.com> writes:
> Jambunathan K <kjambunathan@gmail.com> writes:
>
>> The assumption I make is that 'package-archive-upload-base' points to
>> the 'pub' dir of the webserver. It is the 'archive-contents' in this dir
>> that the webserver is essentially going to serve. So 'archive-contents'
>> retrieved through the URL would be the same as that read from
>> 'package-archive-base'.
>
> But there's no harm in doing that, other than a tiny bit of wasted
> effort, is there?
>

I take that the word 'that' here refers to 'the other thing than that
which "this" patch introduces' - which is to download from URL.

Yes, I wasn't fixing a bug. I was merely suggesting minor improvements.

Jambunathan K.

Re: [PATCH] package-x.el: package-upload-buffer-internal

[Jambunathan K]

Resent with no further edits. (Modified `From:' address)

Chong Yidong <cyd@stupidchicken.com> writes:
> Jambunathan K <kjambunathan@gmail.com> writes:
>
>> The assumption I make is that 'package-archive-upload-base' points to
>> the 'pub' dir of the webserver. It is the 'archive-contents' in this dir
>> that the webserver is essentially going to serve. So 'archive-contents'
>> retrieved through the URL would be the same as that read from
>> 'package-archive-base'.
>
> But there's no harm in doing that, other than a tiny bit of wasted
> effort, is there?
>
>> I would like to bring your attention to little things that my patch
>> introduces:
>
> Yes, many of these are good improvements.  Let me know when your
> copyright assignment is complete.

My copyright assignment is complete. Could you please push the patch
upstream and (if possible) confirm the same?

Jambunathan K.

Re: [PATCH] package-x.el: package-upload-buffer-internal

[Jambunathan K]

Chong Yidong <cyd@stupidchicken.com> writes:

> Jambunathan K <kjambunathan@gmail.com> writes:
>
>> The assumption I make is that 'package-archive-upload-base' points to
>> the 'pub' dir of the webserver. It is the 'archive-contents' in this dir
>> that the webserver is essentially going to serve. So 'archive-contents'
>> retrieved through the URL would be the same as that read from
>> 'package-archive-base'.
>
> But there's no harm in doing that, other than a tiny bit of wasted
> effort, is there?
>
>> I would like to bring your attention to little things that my patch
>> introduces:
>
> Yes, many of these are good improvements.  Let me know when your
> copyright assignment is complete.

My copyright assignment is complete. Could you please push the patch
upstream and (if possible) confirm the same?

Jambunathan K.