From 04c23739823fecd98cbc06ad627b36e5bd8e482e Mon Sep 17 00:00:00 2001 From: "Mark A. Hershberger" Date: Tue, 22 Jun 2010 12:48:53 -0400 Subject: [PATCH] Add in some useful convenience functions for handling HTTP. --- lisp/gnus/ChangeLog | 5 +++++ lisp/gnus/mm-url.el | 42 ++++++++++++++++++++++++++++++++++++++++++ lisp/url/ChangeLog | 6 ++++++ lisp/url/url-parse.el | 20 ++++++++++++++++++++ 4 files changed, 73 insertions(+) diff --git a/lisp/gnus/ChangeLog b/lisp/gnus/ChangeLog index e50bdb58575..d25caf70347 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 c5a8d9f7fdc..c72f520d60a 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 374333150c8..4499ea5ff52 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 e68e0791558..20432dcf7e5 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 -- 2.39.2