1 ;;; gnus-idna.el --- Internationalized domain names support for Gnus.
3 ;; Copyright (C) 2003 Free Software Foundation, Inc.
5 ;; Author: Simon Josefsson
6 ;; Keywords: news, mail
8 ;; This file is part of GNU Emacs.
10 ;; GNU Emacs is free software; you can redistribute it and/or modify
11 ;; it under the terms of the GNU General Public License as published by
12 ;; the Free Software Foundation; either version 2, or (at your option)
15 ;; GNU Emacs is distributed in the hope that it will be useful,
16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18 ;; GNU General Public License for more details.
20 ;; You should have received a copy of the GNU General Public License
21 ;; along with GNU Emacs; see the file COPYING. If not, write to the
22 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
23 ;; Boston, MA 02111-1307, USA.
27 ;; This package implement crude support for internationalized domain
30 ;; Theory of Operation:
32 ;; RFC 2822 RHS's inside the From:, To:, and CC: headers are encoded
33 ;; using IDNA ToASCII() when you send mail using Message. The hook
34 ;; used is message-send-hook.
36 ;; For incoming articles, when QP in headers are decoded (i.e., when
37 ;; gnus-article-decode-hook is invoked), it searches for "xn--"
38 ;; prefixes and decode them if they are found inside (heuristically
39 ;; determined) RHS in From:, To: and Cc:, using IDNA ToUnicode().
43 ;; You need to install GNU Libidn (0.1.11 or later) and make sure the
44 ;; idna.el installed by it is found by emacs.
46 ;; If you use an older Gnus, you may need to put the following in your
47 ;; init scripts too, but keep in mind that most older Gnuses either
48 ;; doesn't have these hooks or are buggy in other regards so it
49 ;; doesn't work anyway. (The window of Gnus versions that this works
50 ;; on is a few weeks during the Oort CVS in winter 2003.) Update to a
51 ;; recent Gnus instead, then you don't have to do anything.
53 ;; (add-hook 'message-send-hook 'message-idna-to-ascii-rhs)
54 ;; (add-hook 'gnus-article-decode-hook 'gnus-idna-to-unicode-rhs 'append)
58 ;; 2003-02-26 Initial release
60 ;; 2003-03-19 Cleanup. Fixes a bug that may corrupt outgoing mail if
61 ;; it contains From:, To: or Cc: headers in the body.
68 (autoload 'idna-to-ascii "idna")
69 (autoload 'idna-to-unicode "idna")
71 (defcustom message-use-idna 'ask
72 "Whether to encode non-ASCII in domain names into ASCII according to IDNA."
73 :type '(choice (const :tag "Ask" ask)
74 (const :tag "Never" nil)
75 (const :tag "Always" t)))
77 (defun message-idna-inside-rhs-p ()
78 "Return t iff point is inside a RHS (heuristically).
79 Only works properly if header contains mailbox-list or address-list.
80 I.e., calling it on a Subject: header is useless."
81 (if (re-search-backward
82 "[\\\n\r\t ]" (save-excursion (search-backward "@" nil t)) t)
83 ;; whitespace between @ and point
85 (let ((dquote 1) (paren 1))
86 (while (save-excursion (re-search-backward "[^\\]\"" nil t dquote))
88 (while (save-excursion (re-search-backward "[^\\]\(" nil t paren))
90 (and (= (% dquote 2) 1) (= (% paren 2) 1)))))
92 (defun message-idna-to-ascii-rhs-1 (header)
93 "Interactively potentially IDNA encode domain names in HEADER."
94 (let (rhs ace start end startpos endpos)
95 (goto-char (point-min))
96 (setq start (re-search-forward (concat "^" header) nil t)
97 end (or (save-excursion (re-search-forward "^[ \t]" nil t))
100 (while (re-search-forward "@\\([^ \t\r\n>]+\\)" end t)
101 (setq rhs (match-string-no-properties 1)
102 startpos (match-beginning 1)
103 endpos (match-end 1))
104 (when (save-match-data
105 (and (message-idna-inside-rhs-p)
106 (setq ace (idna-to-ascii rhs))
107 (not (string= rhs ace))
108 (if (eq message-use-idna 'ask)
111 (replace-highlight startpos endpos)
113 (format "Replace with `%s'? " ace)))
115 (replace-dehighlight))
117 (replace-match (concat "@" ace)))))))
120 (defun message-idna-to-ascii-rhs ()
121 "Possibly IDNA encode non-ASCII domain names in From:, To: and Cc: headers.
122 See `message-idna-encode'."
124 (when (condition-case nil (require 'idna) (file-error))
127 (message-narrow-to-head)
128 (message-idna-to-ascii-rhs-1 "From")
129 (message-idna-to-ascii-rhs-1 "To")
130 (message-idna-to-ascii-rhs-1 "Cc")))))
133 (defun gnus-idna-to-unicode-rhs ()
134 "Decode IDNA strings in RHS in From:, To: and Cc: headers in current buffer."
135 (when (condition-case nil (require 'idna) (file-error))
136 (let ((inhibit-point-motion-hooks t)
138 (article-narrow-to-head)
139 (goto-char (point-min))
140 (while (re-search-forward "\\(xn--.*\\)[ \t\n\r,>]" nil t)
142 (when (save-match-data
143 (and (setq ace (match-string 1))
144 (save-excursion (and (re-search-backward "^[^ \t]" nil t)
145 (looking-at "From\\|To\\|Cc")))
146 (save-excursion (backward-char)
147 (message-idna-inside-rhs-p))
148 (setq unicode (idna-to-unicode ace))))
149 (unless (string= ace unicode)
150 (replace-match unicode nil nil nil 1))))))))
154 ;; gnus-idna.el ends here