(gnus-article-refer-article): Be more permissive.

[gnus] / lisp / message.el

diff --git a/lisp/message.el b/lisp/message.el
index 0822e0a..a9faf5e 100644 (file)
--- a/lisp/message.el
+++ b/lisp/message.el
@@ -636,6 +636,15 @@ Doing so would be even more evil than leaving it out."
   :group 'message-sending
   :type 'boolean)
 
+(defcustom message-sendmail-envelope-from nil
+  "*Envelope-from when sending mail with sendmail.
+If this is nil, use `user-mail-address'.  If it is the symbol
+`header', use the From: header of the message."
+  :type '(choice (string :tag "From name")
+                (const :tag "Use From: header from message" header)
+                (const :tag "Use `user-mail-address'" nil))
+  :group 'message-sending)
+
 ;; qmail-related stuff
 (defcustom message-qmail-inject-program "/var/qmail/bin/qmail-inject"
   "Location of the qmail-inject program."
@@ -1273,6 +1282,12 @@ no, only reply back to the author."
   :group 'message-headers
   :type 'boolean)
 
+(defcustom message-user-fqdn nil
+  "*Domain part of Messsage-Ids."
+  :group 'message-headers
+  :link '(custom-manual "(message)News Headers")
+  :type 'string)
+
 ;;; Internal variables.
 
 (defvar message-sending-message "Sending...")
@@ -1381,6 +1396,19 @@ no, only reply back to the author."
 (defvar message-bogus-system-names "^localhost\\."
   "The regexp of bogus system names.")
 
+(defcustom message-valid-fqdn-regexp
+  (concat "[a-z0-9][-.a-z0-9]+\\." ;; [hostname.subdomain.]domain.
+         ;; valid TLDs:
+         "\\([a-z][a-z]" ;; two letter country TDLs
+         "\\|biz\\|com\\|edu\\|gov\\|int\\|mil\\|net\\|org"
+         "\\|aero\\|coop\\|info\\|name\\|museum"
+         "\\|arpa\\|pro\\|uucp\\|bitnet\\|bofh" ;; old style?
+         "\\)")
+  "Regular expression that matches a valid FQDN."
+  ;; see also: gnus-button-valid-fqdn-regexp
+  :group 'message-headers
+  :type 'regexp)
+
 (eval-and-compile
   (autoload 'message-setup-toolbar "messagexmas")
   (autoload 'mh-new-draft-name "mh-comp")
@@ -2270,6 +2298,11 @@ M-RET    `message-newline-and-reformat' (break the line and reformat)."
   (set (make-local-variable 'message-checksum) nil)
   (set (make-local-variable 'message-mime-part) 0)
   (message-setup-fill-variables)
+  (set
+   (make-local-variable 'paragraph-separate)
+   (format "\\(%s\\)\\|\\(%s\\)"
+          paragraph-separate
+          "<#!*/?\\(multipart\\|part\\|external\\|mml\\|secure\\)"))
   ;; Allow using comment commands to add/remove quoting.
   (set (make-local-variable 'comment-start) message-yank-prefix)
   (if (featurep 'xemacs)
@@ -3526,7 +3559,7 @@ If you always want Gnus to send messages in one piece, set
                        ;; But some systems are more broken with -f, so
                        ;; we'll let users override this.
                        (if (null message-sendmail-f-is-evil)
-                           (list "-f" (message-make-address)))
+                           (list "-f" (message-sendmail-envelope-from)))
                        ;; These mean "report errors by mail"
                        ;; and "deliver in background".
                        (if (null message-interactive) '("-oem" "-odb"))
@@ -4476,30 +4509,53 @@ give as trustworthy answer as possible."
 
 (defun message-user-mail-address ()
   "Return the pertinent part of `user-mail-address'."
-  (when user-mail-address
+  (when (and user-mail-address
+            (string-match "@.*\\." user-mail-address))
     (if (string-match " " user-mail-address)
        (nth 1 (mail-extract-address-components user-mail-address))
       user-mail-address)))
 
+(defun message-sendmail-envelope-from ()
+  "Return the envelope from."
+  (cond ((eq message-sendmail-envelope-from 'header)
+        (nth 1 (mail-extract-address-components
+                (message-fetch-field "from"))))
+       ((stringp message-sendmail-envelope-from)
+        message-sendmail-envelope-from)
+       (t
+        (message-make-address))))
+
 (defun message-make-fqdn ()
   "Return user's fully qualified domain name."
-  (let ((system-name (system-name))
-       (user-mail (message-user-mail-address)))
+  (let* ((system-name (system-name))
+        (user-mail (message-user-mail-address))
+        (user-domain
+         (if (and user-mail
+                  (string-match "@\\(.*\\)\\'" user-mail))
+             (match-string 1 user-mail))))
     (cond
-     ((and (string-match "[^.]\\.[^.]" system-name)
+     ((and message-user-fqdn
+          (stringp message-user-fqdn)
+          (string-match message-valid-fqdn-regexp message-user-fqdn)
+          (not (string-match message-bogus-system-names message-user-fqdn)))
+      message-user-fqdn)
+     ;; `message-user-fqdn' seems to be valid
+     ((and (string-match message-valid-fqdn-regexp system-name)
           (not (string-match message-bogus-system-names system-name)))
       ;; `system-name' returned the right result.
       system-name)
      ;; Try `mail-host-address'.
      ((and (boundp 'mail-host-address)
           (stringp mail-host-address)
-          (string-match "\\." mail-host-address))
+          (string-match message-valid-fqdn-regexp mail-host-address)
+          (not (string-match message-bogus-system-names mail-host-address)))
       mail-host-address)
      ;; We try `user-mail-address' as a backup.
-     ((and user-mail
-          (string-match "\\." user-mail)
-          (string-match "@\\(.*\\)\\'" user-mail))
-      (match-string 1 user-mail))
+     ((and user-domain
+          (stringp user-domain)
+          (string-match message-valid-fqdn-regexp user-domain)
+          (not (string-match message-bogus-system-names user-domain)))
+      user-domain)
      ;; Default to this bogus thing.
      (t
       (concat system-name ".i-did-not-set--mail-host-address--so-tickle-me")))))