Re: v5.13: on cancel and supersedes dependency on message-make-sender

[Wayne Harris <wharris1@protonmail.com>]

Wayne Harris <wharris1@protonmail.com> writes:

> I can't currently cancel or supersede articles because
>
>   message-make-sender
>
> always tells Gnus I don't own the article.
>
> (defun message-make-sender ()
>   "Return the \"real\" user address.
> This function tries to ignore all user modifications, and
> give as trustworthy answer as possible."
>   (concat (user-login-name) "@" (system-name)))

Forgive me.  This is not the code I saw in my own GNU Emacs.  The
correct code I see is:

--8<---------------cut here---------------start------------->8---
(defun message-is-yours-p ()
  "Non-nil means current article is yours.
If you have added `cancel-messages' to `message-shoot-gnksa-feet', all articles
are yours except those that have Cancel-Lock header not belonging to you.
Instead of shooting GNKSA feet, you should modify `message-alternative-emails'
to match all of yours addresses."
  ;; Canlock-logic as suggested by Per Abrahamsen
  ;; <abraham@dina.kvl.dk>
  ;;
  ;; IF article has cancel-lock THEN
  ;;   IF we can verify it THEN
  ;;     issue cancel
  ;;   ELSE
  ;;     error: cancellock: article is not yours
  ;; ELSE
  ;;   Use old rules, comparing sender...
  (save-excursion
    (save-restriction
      (message-narrow-to-head-1)
      (if (and (message-fetch-field "Cancel-Lock")
	       (message-gnksa-enable-p 'canlock-verify))
	  (if (null (canlock-verify))
	      t
	    (error "Failed to verify Cancel-lock: This article is not yours"))
	(let (sender from)
	  (or
	   (message-gnksa-enable-p 'cancel-messages)
	   (and (setq sender (message-fetch-field "sender"))
		(string-equal (downcase sender)
			      (downcase (message-make-sender))))
	   ;; Email address in From field equals to our address
	   (and (setq from (message-fetch-field "from"))
		(string-equal
		 (downcase (car (mail-header-parse-address from)))
		 (downcase (car (mail-header-parse-address
				 (message-make-from))))))
	   ;; Email address in From field matches
	   ;; 'message-alternative-emails' regexp or function.
	   (and from
		message-alternative-emails
                (cond ((functionp message-alternative-emails)
                       (funcall message-alternative-emails
                                (mail-header-parse-address from)))
                      (t (string-match message-alternative-emails
                                       (car (mail-header-parse-address from))))))))))))
--8<---------------cut here---------------end--------------->8---

Despite it offering a nice strategy, it doesn't seem to work work for
me.  So, as a temporary fix, I disabled it in message-supersede.  I will
eventually look into it and see what might be happening.

--8<---------------cut here---------------start------------->8---
(defun message-supersede ()
  "Start composing a message to supersede the current message.
This is done simply by taking the old article and adding a Supersedes
header line with the old Message-ID."
  (interactive)
  (let ((cur (current-buffer)))
    ;; Check whether the user owns the article that is to be superseded.
    (unless t ;(message-is-yours-p)
      (error "This article is not yours"))
    ;; Get a normal message buffer.
    (message-pop-to-buffer (message-buffer-name "supersede"))
    (insert-buffer-substring cur)
    (mime-to-mml)
    (message-narrow-to-head-1)
    ;; Remove unwanted headers.
    (when message-ignored-supersedes-headers
      (message-remove-header message-ignored-supersedes-headers t))
    (goto-char (point-min))
    (if (not (re-search-forward "^Message-ID: " nil t))
	(error "No Message-ID in this article")
      (replace-match "Supersedes: " t t))
    (goto-char (point-max))
    (insert mail-header-separator)
    (widen)
    (forward-line 1)))
--8<---------------cut here---------------end--------------->8---