bug#21602: 25.0.50; coding system seg fault

[Richard Stallman <rms@gnu.org>]

[[[ 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.