moderation.el 5.03 KB
Newer Older
bernat's avatar
bernat committed
1
(require 'gnus-start)
2
(require 'gnus-agent)
bernat's avatar
bernat committed
3 4 5 6 7 8 9 10 11 12 13 14 15

(setq
 ; Fichier d'initialisation :
 gnus-init-file (nnheader-concat gnus-home-directory ".gnus-moderation")
 ; Fichier contenant les inscriptions
 gnus-startup-file ".newsrc-moderation"
 ; Par defaut, on est abonn  crans.*
 gnus-default-subscribed-newsgroups t
 ; On ne lit pas le .newsrc
 gnus-read-newsrc-file nil
 ; On ne le sauve pas
 gnus-save-newsrc-file nil
 ; Pas d'auto save
16 17 18
 gnus-use-dribble-file nil
 ; Pas d'agent
 gnus-agent nil)
bernat's avatar
bernat committed
19 20 21 22 23

; Comment souscrire  un nouveau groupe ?

(setq
 ; On utilise la methode ci-dessus pour s'inscrire aux nouveaux groupes
24
 gnus-subscribe-newsgroup-method 'gnus-subscribe-alphabetically
bernat's avatar
bernat committed
25
 ; On s'inscrit automatiquement  tous les groupes
26 27
 gnus-auto-subscribed-groups ".*"
 )
bernat's avatar
bernat committed
28 29 30 31 32 33 34 35 36 37

(require 'message)
(require 'mml)

; On ne peut annuler un message qui n'est pas dans un groupe CRANS
(defun message-is-yours-p ()
  (save-excursion
    (save-restriction
      (message-narrow-to-head-1)
      (let ((newsgroups (message-fetch-field "Newsgroups")))
38
	(if newsgroups
bernat's avatar
bernat committed
39 40 41 42 43 44 45 46 47 48
	    ; OK
	    t
	  (error "Ce message n'est pas dans un groupe CRANS"))))))

; On envoie un mail indiquant ce qui est annul
(defun message-cancel-news (&optional arg)
  "Cancel an article you posted."
  (interactive)
  (unless (message-news-p)
    (error "Il n'est pas possible d'annuler cet article"))
49 50
  (unless (not (eq (user-uid) 0))
    (error "Ce script ne se lance pas en tant que root"))
bernat's avatar
bernat committed
51 52 53 54 55 56 57 58 59 60
  (let (from newsgroups message-id distribution origbuf buf subject)
    (setq origbuf (buffer-name))
    (save-excursion
      ;; Get header info from original article.
      (save-restriction
	(message-narrow-to-head-1)
	(setq from (message-fetch-field "from")
	      newsgroups (message-fetch-field "newsgroups")
	      subject (message-fetch-field "subject")
	      message-id (message-fetch-field "message-id" t)
61 62
	      distribution (message-fetch-field "distribution")
	      approved (message-fetch-field "approved")))
bernat's avatar
bernat committed
63 64 65 66 67 68 69 70 71 72 73 74 75 76
      ;; Make sure that this article was written by the user.
      (unless (message-is-yours-p)
	(error "Impossible d'annuler cet article"))
      (when (yes-or-no-p "Voulez-vous vraiment annuler cet article ? ")
	;; Annulation du message
	(setq buf (set-buffer (get-buffer-create " *message cancel*")))
	(erase-buffer)
	(insert "Newsgroups: " newsgroups "\n"
		"From: moderateurs@crans.org\n"
		"Subject: cmsg cancel " message-id "\n"
		"Control: cancel " message-id "\n"
		(if distribution
		    (concat "Distribution: " distribution "\n")
		  "")
77 78 79
		(if approved
		    (concat "Approved: " approved "\n")
		  "")
bernat's avatar
bernat committed
80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122
		mail-header-separator "\n"
		message-cancel-message)

	
	(message "Annulation du message...")
	(if (let ((message-syntax-checks
		   'dont-check-for-anything-just-trust-me))
	      (funcall message-send-news-function))
	    (message "Annulation du message effectue."))
	(kill-buffer buf)

	;; Envoi du mail dans moderateurs
	(setq buf (set-buffer (get-buffer-create " *message cancel notification*")))
	(erase-buffer)
	(insert "From: " (message-make-from) "\n"
		"To: moderateurs@crans.org\n"
		"Subject: Annulation du message " message-id "\n"
		mail-header-separator "\n"
		"Annulation du message suivant : \n\n"
		"  message-id: " message-id "\n"
		"     subject: " subject "\n"
		"        from: " from "\n"
		"  newsgroups: " newsgroups "\n"
		"\n")
	; On attache le message original
	(mml-attach-buffer origbuf "message/rfc822" "Message annul")

	(message-send-via-mail nil)
	(kill-buffer buf)
	(message "Envoi de la notification ok.")))))

; Verifie si le message en cours a un supersedes
(defun crans-check-supersedes ()
  (save-excursion
    (save-restriction
      (message-narrow-to-head-1)
      (if (message-fetch-field "supersedes")
	  (let (buf message-id from subject newsgroups)
	    ;; On a un supersedes, on va dire que l'article original est
	    ;; dans *Article* et que le supersede est dans *supersede*
	    (save-excursion
	      (set-buffer "*Article*")
	      (save-restriction
123
		(message-narrow-to-headers)
bernat's avatar
bernat committed
124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152
		(setq from (message-fetch-field "from")
		      newsgroups (message-fetch-field "newsgroups")
		      subject (message-fetch-field "subject")
		      message-id (message-fetch-field "message-id" t))))
  
	    ;; Envoi du mail dans moderateurs
	    (setq buf (set-buffer (get-buffer-create " *message cancel notification*")))
	    (erase-buffer)
	    (insert "From: " (message-make-from) "\n"
		    "To: moderateurs@crans.org\n"
		    "Subject: Modification du message " message-id "\n"
		    mail-header-separator "\n"
		    "Modification du message suivant : \n\n"
		    "  message-id: " message-id "\n"
		    "     subject: " subject "\n"
		    "        from: " from "\n"
		    "  newsgroups: " newsgroups "\n"
		    "\n")
	    ;; On attache le message original
	    (mml-attach-buffer "*Article*" "message/rfc822" "Message original")
	    ;; Et le message modifi
	    (mml-attach-buffer "*supersede*" "message/rfc822" "Message modifi")

	    (message-send-via-mail nil)
	    (kill-buffer buf)
	    (message "Envoi de la notification ok."))))))

;; Mise en place du hook
(setq message-send-news-hook 'crans-check-supersedes)