diff --git a/lisp/gnus/ChangeLog b/lisp/gnus/ChangeLog index e50bdb585750d344f06f62e1921ed12790a76336..d25caf70347527a67d5b674621de7698b5d1e767 100644 --- a/lisp/gnus/ChangeLog +++ b/lisp/gnus/ChangeLog @@ -1,3 +1,8 @@ +2010-06-22 Mark A. Hershberger + + * mm-url.el (mm-url-encode-multipart-form-data): New function to handle + the *other* type of HTML form submission. + 2010-06-15 Michael Albinus * auth-source.el (auth-source-pick): If choice does not contain a diff --git a/lisp/gnus/mm-url.el b/lisp/gnus/mm-url.el index c5a8d9f7fdcff15cb4ae24cfe523ba0185051824..c72f520d60ae251f8e07ae1f77b855167d6db24e 100644 --- a/lisp/gnus/mm-url.el +++ b/lisp/gnus/mm-url.el @@ -418,6 +418,48 @@ spaces. Die Die Die." (mm-url-form-encode-xwfu (cdr data)))) pairs "&")) +(defun mm-url-encode-multipart-form-data (pairs &optional boundary) + "Return PAIRS encoded in multipart/form-data." + ;; RFC1867 + + ;; Get a good boundary + (unless boundary + (setq boundary (mml-compute-boundary '()))) + + (concat + + ;; Start with the boundary + "--" boundary "\r\n" + + ;; Create name value pairs + (mapconcat + 'identity + ;; Delete any returned items that are empty + (delq nil + (mapcar (lambda (data) + (when (car data) + ;; For each pair + (concat + + ;; Encode the name + "Content-Disposition: form-data; name=\"" + (car data) "\"\r\n" + "Content-Type: text/plain; charset=utf-8\r\n" + "Content-Transfer-Encoding: binary\r\n\r\n" + + (cond ((stringp (cdr data)) + (cdr data)) + ((integerp (cdr data)) + (int-to-string (cdr data)))) + + "\r\n"))) + pairs)) + ;; use the boundary as a separator + (concat "--" boundary "\r\n")) + + ;; put a boundary at the end. + "--" boundary "--\r\n")) + (defun mm-url-fetch-form (url pairs) "Fetch a form from URL with PAIRS as the data using the POST method." (mm-url-load-url) diff --git a/lisp/url/ChangeLog b/lisp/url/ChangeLog index 374333150c81aaaa0d4c39d458db10a014fd29a3..4499ea5ff526b752542a8b34c6c9606d11e40e11 100644 --- a/lisp/url/ChangeLog +++ b/lisp/url/ChangeLog @@ -1,3 +1,9 @@ +2010-06-22 Mark A. Hershberger + + * url-parse.el (url-user-for-url, url-password-for-url): + Convenience functions that get usernames and passwords for urls + from auth-source functions. + 2010-06-12 Štěpán Němec (tiny change) * url-vars.el (url-privacy-level): Fix doc typo. (Bug#6406) diff --git a/lisp/url/url-parse.el b/lisp/url/url-parse.el index e68e0791558b1ca4791f7d4e34c486c9e5884358..20432dcf7e555c1545f650ab8400375d33cce3ab 100644 --- a/lisp/url/url-parse.el +++ b/lisp/url/url-parse.el @@ -25,6 +25,7 @@ ;;; Code: (require 'url-vars) +(require 'auth-source) (eval-when-compile (require 'cl)) (autoload 'url-scheme-get-property "url-methods") @@ -174,6 +175,25 @@ TYPE USER PASSWORD HOST PORTSPEC FILENAME TARGET ATTRIBUTES FULLNESS." (url-parse-make-urlobj prot user pass host port file refs attr full))))))) +(defmacro url-bit-for-url (method lookfor url) + `(let* ((urlobj (url-generic-parse-url url)) + (bit (funcall ,method urlobj)) + (methods (list 'url-recreate-url + 'url-host))) + (while (and (not bit) (> (length methods) 0)) + (setq bit + (auth-source-user-or-password + ,lookfor (funcall (pop methods) urlobj) (url-type urlobj)))) + bit)) + +(defun url-user-for-url (url) + "Attempt to use .authinfo to find a user for this URL." + (url-bit-for-url 'url-user "login" url)) + +(defun url-password-for-url (url) + "Attempt to use .authinfo to find a password for this URL." + (url-bit-for-url 'url-password "password" url)) + (provide 'url-parse) ;; arch-tag: f338325f-71ab-4bee-93cc-78fb9a03d403