From b3450efe0cb2b7e6e648e8af4115635230164768 Mon Sep 17 00:00:00 2001 From: yamaoka Date: Sun, 16 May 2004 22:07:28 +0000 Subject: [PATCH] Synch to No Gnus 200405161556. --- lisp/ChangeLog | 12 ++++++++++ lisp/gnus-art.el | 2 -- lisp/imap.el | 58 +++++++++++++++++++++++++++++++++++++++++++++++++ lisp/message.el | 64 +++++++++++++++--------------------------------------- 4 files changed, 87 insertions(+), 49 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index b473678..79da6ae 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,5 +1,17 @@ 2004-05-16 Lars Magne Ingebrigtsen + * 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 + + * imap.el (imap-sasl-make-mechanisms): Use sasl. + +2004-05-16 Lars Magne Ingebrigtsen + * nneething.el (nneething-file-name): Don't create spurions files. diff --git a/lisp/gnus-art.el b/lisp/gnus-art.el index 0d5d4cb..60fc4f3 100644 --- a/lisp/gnus-art.el +++ b/lisp/gnus-art.el @@ -379,8 +379,6 @@ advertisements. For example: (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. diff --git a/lisp/imap.el b/lisp/imap.el index 56a7e67..6eb8d51 100644 --- a/lisp/imap.el +++ b/lisp/imap.el @@ -145,6 +145,7 @@ (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") @@ -295,6 +296,7 @@ stream.") kerberos4 digest-md5 cram-md5 + sasl login anonymous) "Priority of authenticators to consider when authenticating to server.") @@ -302,6 +304,7 @@ stream.") (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) @@ -902,6 +905,61 @@ Returns t if login was successful, nil otherwise." (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 () diff --git a/lisp/message.el b/lisp/message.el index 6634e39..b9a464d 100644 --- a/lisp/message.el +++ b/lisp/message.el @@ -5470,55 +5470,25 @@ subscribed address (and not the additional To and Cc header contents)." (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. -- 1.7.10.4