2004-05-16 Lars Magne Ingebrigtsen <larsi@gnus.org>
+ * message.el (message-idna-inside-rhs-p): Removed.
+ (message-idna-to-ascii-rhs-1): Use proper address parsing.
+
+ * gnus-art.el (gnus-emphasis-alist): Removed strikethru; too many
+ false positives.
+
+2004-05-16 Kim Minh Kaplan <kmkaplan-AwwS6Bc0PDVoiYX5Tdu9fQ@public.gmane.org>
+
+ * imap.el (imap-sasl-make-mechanisms): Use sasl.
+
+2004-05-16 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
* nneething.el (nneething-file-name): Don't create spurions
files.
(format format (car spec) (car (cdr spec)))
2 3 (intern (format "gnus-emphasis-%s" (nth 2 spec)))))
types)
- ("\\(\\s-\\|^\\)\\(-\\(\\(\\w\\|-[^-]\\)+\\)-\\)\\(\\s-\\|[?!.,;]\\)"
- 2 3 gnus-emphasis-strikethru)
("\\(\\s-\\|^\\)\\(_\\(\\(\\w\\|_[^_]\\)+\\)_\\)\\(\\s-\\|[?!.,;]\\)"
2 3 gnus-emphasis-underline)))
"*Alist that says how to fontify certain phrases.
(eval-and-compile
(autoload 'starttls-open-stream "starttls")
(autoload 'starttls-negotiate "starttls")
+ (autoload 'sasl-find-mechanism "sasl")
(autoload 'digest-md5-parse-digest-challenge "digest-md5")
(autoload 'digest-md5-digest-response "digest-md5")
(autoload 'digest-md5-digest-uri "digest-md5")
kerberos4
digest-md5
cram-md5
+ sasl
login
anonymous)
"Priority of authenticators to consider when authenticating to server.")
(defvar imap-authenticator-alist
'((gssapi imap-gssapi-auth-p imap-gssapi-auth)
(kerberos4 imap-kerberos4-auth-p imap-kerberos4-auth)
+ (sasl imap-sasl-auth-p imap-sasl-auth)
(cram-md5 imap-cram-md5-p imap-cram-md5-auth)
(login imap-login-p imap-login-auth)
(anonymous imap-anonymous-p imap-anonymous-auth)
(concat "LOGIN anonymous \"" (concat (user-login-name) "@"
(system-name)) "\"")))))
+(defun imap-sasl-make-mechanisms (buffer)
+ (let ((mecs '()))
+ (mapc (lambda (sym)
+ (let ((name (symbol-name sym)))
+ (if (and (> (length name) 5)
+ (string-equal "AUTH=" (substring name 0 5 )))
+ (setq mecs (cons (substring name 5) mecs)))))
+ (imap-capability nil buffer))
+ mecs))
+
+(defun imap-sasl-auth-p (buffer)
+ (and (condition-case ()
+ (require 'sasl)
+ (error nil))
+ (sasl-find-mechanism (imap-sasl-make-mechanisms buffer))))
+
+(defun imap-sasl-auth (buffer)
+ "Login to server using the SASL method."
+ (message "imap: Authenticating using SASL...")
+ (with-current-buffer buffer
+ (make-local-variable 'imap-username)
+ (make-local-variable 'imap-sasl-client)
+ (make-local-variable 'imap-sasl-step)
+ (let ((mechanism (sasl-find-mechanism (imap-sasl-make-mechanisms buffer)))
+ logged user)
+ (while (not logged)
+ (setq user (or imap-username
+ (read-from-minibuffer
+ (concat "IMAP username for " imap-server " using SASL "
+ (sasl-mechanism-name mechanism) ": ")
+ (or user imap-default-user))))
+ (when user
+ (setq imap-sasl-client (sasl-make-client mechanism user "imap2" imap-server)
+ imap-sasl-step (sasl-next-step imap-sasl-client nil))
+ (let ((tag (imap-send-command
+ (if (sasl-step-data imap-sasl-step)
+ (format "AUTHENTICATE %s %s"
+ (sasl-mechanism-name mechanism)
+ (sasl-step-data imap-sasl-step))
+ (format "AUTHENTICATE %s" (sasl-mechanism-name mechanism)))
+ buffer)))
+ (while (eq (imap-wait-for-tag tag) 'INCOMPLETE)
+ (sasl-step-set-data imap-sasl-step (base64-decode-string imap-continuation))
+ (setq imap-continuation nil
+ imap-sasl-step (sasl-next-step imap-sasl-client imap-sasl-step))
+ (imap-send-command-1 (if (sasl-step-data imap-sasl-step)
+ (base64-encode-string (sasl-step-data imap-sasl-step) t)
+ "")))
+ (if (imap-ok-p (imap-wait-for-tag tag))
+ (setq imap-username user
+ logged t)
+ (message "Login failed...")
+ (sit-for 1)))))
+ logged)))
+
(defun imap-digest-md5-p (buffer)
(and (imap-capability 'AUTH=DIGEST-MD5 buffer)
(condition-case ()
(delete-region (match-beginning 0) (1+ (std11-field-end)))))))
message-user-agent)
-(defun message-idna-inside-rhs-p ()
- "Return t iff point is inside a RHS (heuristically).
-Only works properly if header contains mailbox-list or address-list.
-I.e., calling it on a Subject: header is useless."
- (save-restriction
- (narrow-to-region (save-excursion (or (re-search-backward "^[^ \t]" nil t)
- (point-min)))
- (save-excursion (or (re-search-forward "^[^ \t]" nil t)
- (point-max))))
- (if (re-search-backward "[\\\n\r\t ]"
- (save-excursion (search-backward "@" nil t)) t)
- ;; whitespace between @ and point
- nil
- (let ((dquote 1) (paren 1))
- (while (save-excursion (re-search-backward "[^\\]\"" nil t dquote))
- (incf dquote))
- (while (save-excursion (re-search-backward "[^\\]\(" nil t paren))
- (incf paren))
- (and (= (% dquote 2) 1) (= (% paren 2) 1))))))
-
(defun message-idna-to-ascii-rhs-1 (header)
"Interactively potentially IDNA encode domain names in HEADER."
- (let (rhs ace start startpos endpos ovl)
- (goto-char (point-min))
- (while (re-search-forward (concat "^" header) nil t)
- (while (re-search-forward "@\\([^ \t\r\n>,]+\\)"
- (or (save-excursion
- (re-search-forward "^[^ \t]" nil t))
- (point-max))
- t)
- (setq rhs (match-string-no-properties 1)
- startpos (match-beginning 1)
- endpos (match-end 1))
- (when (save-match-data
- (and (message-idna-inside-rhs-p)
- (setq ace (idna-to-ascii rhs))
- (not (string= rhs ace))
- (if (eq message-use-idna 'ask)
- (unwind-protect
- (progn
- (setq ovl (message-make-overlay startpos
- endpos))
- (message-overlay-put ovl 'face 'highlight)
- (y-or-n-p
- (format "Replace with `%s'? " ace)))
- (message "")
- (message-delete-overlay ovl))
- message-use-idna)))
- (replace-match (concat "@" ace)))))))
+ (let ((field (message-fetch-field header))
+ rhs ace address)
+ (when field
+ (dolist (address (mail-header-parse-addresses field))
+ (setq address (car address)
+ rhs (cadr (split-string address "@"))
+ ace (idna-to-ascii rhs))
+ (when (and (not (equalp rhs ace))
+ (or (not (eq message-use-idna 'ask))
+ (y-or-n-p (format "Replace %s with %s? " rhs ace))))
+ (goto-char (point-min))
+ (while (re-search-forward (concat "^" header ":") nil t)
+ (message-narrow-to-field)
+ (while (search-forward (concat "@" rhs) nil t)
+ (replace-match (concat "@" ace) t t))
+ (goto-char (point-max))
+ (widen)))))))
(defun message-idna-to-ascii-rhs ()
"Possibly IDNA encode non-ASCII domain names in From:, To: and Cc: headers.
projects / elisp / gnus.git- / commitdiff