From 500e976d00845b5b91e5844dd5a206ee352b8836 Mon Sep 17 00:00:00 2001
From: Reiner Steib <Reiner.Steib@gmx.de>
Date: Sun, 28 Oct 2007 18:10:57 +0000
Subject: [PATCH] (message-bogus-address-regexp): New variable.
 (message-bogus-recipient-p): New function. (message-check-recipients): New
 command. (message-syntax-checks): Add `bogus-recipient'.
 (message-fix-before-sending): Add `bogus-recipient'.

---
 lisp/ChangeLog  |  5 +++++
 lisp/message.el | 59 ++++++++++++++++++++++++++++++++++++++++++++++---
 2 files changed, 61 insertions(+), 3 deletions(-)

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 73e8b1abb..015bfdc3d 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -2,6 +2,11 @@
 
 	* message.el (message-remove-blank-cited-lines): Fix if remove is
 	given.
+	(message-bogus-address-regexp): New variable.
+	(message-bogus-recipient-p): New function.
+	(message-check-recipients): New command.
+	(message-syntax-checks): Add `bogus-recipient'.
+	(message-fix-before-sending): Add `bogus-recipient'.
 
 	* gnus-art.el (gnus-button-mid-or-mail-heuristic-alist): Add "alpine".
 	(gnus-treat-emphasize, gnus-treat-body-boundary): Don't test
diff --git a/lisp/message.el b/lisp/message.el
index 2ccac7c97..b56a6a08c 100644
--- a/lisp/message.el
+++ b/lisp/message.el
@@ -188,8 +188,8 @@ To disable checking of long signatures, for instance, add
 
 Don't touch this variable unless you really know what you're doing.
 
-Checks include `approved', `continuation-headers', `control-chars',
-`empty', `existing-newsgroups', `from', `illegible-text',
+Checks include `approved', `bogus-recipient', `continuation-headers',
+`control-chars', `empty', `existing-newsgroups', `from', `illegible-text',
 `invisible-text', `long-header-lines', `long-lines', `message-id',
 `multiple-headers', `new-text', `newsgroups', `quoting-style',
 `repeated-newsgroups', `reply-to', `sender', `sendsys', `shoot',
@@ -4018,6 +4018,12 @@ not have PROP."
 	(setq start next)))
     (nreverse regions)))
 
+(defcustom message-bogus-address-regexp nil ;; "noreply\\|nospam\\|invalid"
+  "Regexp of potentially bogus mail addresses."
+  :version "23.0" ;; No Gnus
+  :group 'message-headers
+  :type 'regexp)
+
 (defun message-fix-before-sending ()
   "Do various things to make the message nice before sending it."
   ;; Make sure there's a newline at the end of the message.
@@ -4100,7 +4106,54 @@ not have PROP."
 	      (when (eq choice ?r)
 		(insert message-replacement-char))))
 	  (forward-char)
-	  (skip-chars-forward mm-7bit-chars))))))
+	  (skip-chars-forward mm-7bit-chars)))))
+  (message-check 'bogus-recipient
+    ;; Warn before composing or sending a mail to an invalid address.
+    (message-check-recipients)))
+
+(defun message-bogus-recipient-p (recipients)
+  "Check if a mail address in RECIPIENTS looks bogus.
+
+RECIPIENTS is a mail header.  Return a list of potentially bogus
+addresses.  If none is found, return nil.
+
+An addresses might be bogus if the domain part is not fully
+qualified, see `message-valid-fqdn-regexp', or if it matches
+`message-bogus-address-regexp'."
+  ;; FIXME: How about "foo@subdomain", when the MTA adds ".domain.tld"?
+  (let (found)
+    (mapc (lambda (address)
+	    (setq address (cadr address))
+	    (when
+		(or (not
+		     (or
+		      (not (string-match "@" address))
+		      (string-match
+		       (concat ".@.*\\("
+			       message-valid-fqdn-regexp "\\)\\'") address)))
+		    (and (stringp message-bogus-address-regexp)
+			 (string-match message-bogus-address-regexp address)))
+	      (push address found)))
+	  ;;
+	  (mail-extract-address-components recipients t))
+    found))
+
+(defun message-check-recipients ()
+  "Warn before composing or sending a mail to an invalid address.
+
+This function could be useful in `message-setup-hook'."
+  (interactive)
+  (save-restriction
+    (message-narrow-to-headers)
+    (dolist (hdr '("To" "Cc" "Bcc"))
+      (let ((addr (message-fetch-field hdr)))
+	(when (stringp addr)
+	  (dolist (bog (message-bogus-recipient-p addr))
+	    (and bog
+		 (not (y-or-n-p
+		       (format
+			"Address `%s' might be bogus.  Continue? " bog)))
+		 (error "Bogus address."))))))))
 
 (defun message-add-action (action &rest types)
   "Add ACTION to be performed when doing an exit of type TYPES."
-- 
2.34.1