bug#21602: 25.0.50; coding system seg fault

[Richard Stallman]

[[[ To any NSA and FBI agents reading my email: please consider    ]]]
[[[ whether defending the US Constitution against all enemies,     ]]]
[[[ foreign or domestic, requires you to follow Snowden's example. ]]]

  > > When I try to send the following buffer with Mail mode,
  > > I get a seg fault within write_region as it tries to handle
  > > 'us-ascii' as the mime charset.

  > I tried to reproduce this, but it didn't fail for me.  There are too
  > many parameters involved in sending email, starting with your
  > mail-client package, so it's small wonder I couldn't reproduce this
  > easily.

I use Mail mode.  But the problem depends on my local mail setup.

I can reproduce the failure in emacs -Q with the code below.  The code
in my-send-1 is responsible for passing specifying the coding system,
but even if that value is wrong, write-region should not crash.


(setq mail-user-agent 'sendmail-user-agent)

  (setq send-mail-function 'my-send-it)

(defvar private-regexp
  "ffofoofofofofofo@")

(defun my-send-it ()
  (save-excursion
    (let (buffer-undo-list
          (case-fold-search t)
          list-to-undo)
      (if (save-excursion
            (goto-char (point-min))
            (re-search-forward "^to:")
            (let ((end (save-excursion (forward-line 1) (point))))
              (re-search-forward private-regexp end t)))
          (save-excursion
            (goto-char (point-min))
            (re-search-forward "^reply-to:")
            (let ((end (save-excursion (forward-line 1) (point))))
              (replace-string "rms@" "rms-private@" nil (point) end)))
        (save-excursion
          (goto-char (point-min))
          (unless (re-search-forward "^bcc: rms-outgoing@gnu.org\n" nil t)
            (re-search-forward "^reply-to:")
            (beginning-of-line)
            (insert "bcc: rms-outgoing@gnu.org\n"))
          (setq list-to-undo buffer-undo-list)))
      (if (save-excursion
            (goto-char (point-min))
            (re-search-forward "^reply-to:")
            (let ((end (save-excursion (forward-line 1) (point))))
              (re-search-forward "rms-private" end t)))
          (my-send-1 "out-")
        (my-send-1 "out-"))

      (while list-to-undo
        (let ((undo-in-progress t))
          (setq list-to-undo (primitive-undo 1 list-to-undo)))))))

(defun my-send-1 (base)
  (let* ((default-directory (expand-file-name "~/outgoing/"))
         (files (file-name-all-completions base default-directory))
         (versions (mapcar (function (lambda (name)
                                       (string-to-int (substring name (length 
base)))))
                           files))
         (coding-system-for-write
          (save-excursion
            (goto-char (point-min))
            (if (re-search-forward "^Content-Type:.*; *charset=\\([^;\n]+\\)"
                                   nil t)
                (intern (downcase (match-string 1)))
              coding-system-for-write))))
    (write-region (point-min) (point-max)
                  (format "%s%d" base
                          (if versions
                              (1+ (apply 'max versions))
                            1)))))


-- 
Dr Richard Stallman
President, Free Software Foundation (gnu.org, fsf.org)
Internet Hall-of-Famer (internethalloffame.org)
Skype: No way! See stallman.org/skype.html.