diff --git a/news/moderation.el b/news/moderation.el new file mode 100644 index 00000000..1572306c --- /dev/null +++ b/news/moderation.el @@ -0,0 +1,149 @@ +(require 'gnus-start) + +(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 + gnus-use-dribble-file nil) + +; Comment souscrire à un nouveau groupe ? +(defun crans-gnus-subscribe-alphabetically (newgroup) + (if (string-match "^crans\..*" newgroup) + (gnus-subscribe-alphabetically newgroup) + (gnus-subscribe-zombies newgroup))) + +(setq + ; On utilise la methode ci-dessus pour s'inscrire aux nouveaux groupes + gnus-subscribe-newsgroup-method 'crans-gnus-subscribe-alphabetically + ; On s'inscrit automatiquement à tous les groupes + gnus-auto-subscribed-groups "^nntp" + ; Uniquement les groupes CRANS + gnus-options-subscribe "^crans\..*") + +(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"))) + (if (and newsgroups + (string-match "crans\.[a-z-]*" newsgroups)) + ; 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")) + (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) + distribution (message-fetch-field "distribution"))) + ;; 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") + "") + 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 effectuée.")) + (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 + (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)))) + + ;; 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)