Filter GitHub notification emails

Have GitHub send notifications to plugins+github@, and try to
distinguish actual user comments from mere status change reports.  Right
now, both types of notifications are forwarded to the devel@ list, but
in the future, we could choose to omit the status change emails.

While at it, the messages are also modified to make them more suitable
for being forwarded to a mailing list.

1 files changed, 256 insertions, 0 deletions

diff --git a/libexec/filter-github-emails b/libexec/filter-github-emails
new file mode 100755
index 0000000..95a4141
--- /dev/null
+++ b/libexec/filter-github-emails
@@ -0,0 +1,256 @@
+#!/usr/bin/perl -T
+#
+# Copyright (c) 2014 Monitoring Plugins Development Team
+#
+# Originally written by Holger Weiss <holger@zedat.fu-berlin.de>.
+#
+# This program is free software; you may redistribute it and/or modify it under
+# the same terms as Perl itself.
+#
+
+#
+# This script receives GitHub email notifications and tries to distinguish
+# actual user comments from mere status change reports, so that they can be
+# filtered in different ways.  While at it, the messages are also modified to
+# make them suitable for being forwarded to a mailing list.
+#
+# Note: If you edit this script, make sure to never use die() or exit().
+# Instead, call the following subroutine:
+#
+# - panic($format, @args);
+#       Log an error message, print original message to standard output, exit
+#       non-zero.  Note that panic() expects printf(3)-style arguments.  Don't
+#       use variables within the format string (unless you're sure they will
+#       never contain format specifications).  Add them to the @args instead.
+#
+# Exceptions raised by imported modules should be cought by our $SIG{__DIE__}
+# handler.
+#
+# Also, never write output to STDERR.  Instead, use one of the following
+# subroutines in order to write messages to syslog:
+#
+# - debug($format, @args);
+#       Write a debug message to syslog, printf(3)-style.
+# - info($format, @args);
+#       Write an informational message to syslog, printf(3)-style.
+# - notice($format, @args);
+#       Write a notice to syslog, printf(3)-style.
+# - warning($format, @args);
+#       Write a warning to syslog, printf(3)-style.
+# - error($format, @args);
+#       Write an error to syslog, printf(3)-style.
+# - critical($format, @args);
+#       Write a critical error to syslog, printf(3)-style.
+#
+
+use warnings;
+use strict;
+use Email::MIME;
+use File::Basename;
+use Sys::Syslog qw(:standard :macros);
+use Text::Wrap;
+
+use constant COMMENTS_TO =>
+    'Monitoring Plugins Development <devel@monitoring-plugins.org>';
+use constant STATUS_CHANGES_TO =>
+    'Monitoring Plugins Development <devel@monitoring-plugins.org>';
+use constant TIMEOUT => 15;
+
+$ENV{PATH} = '/usr/bin:/bin';
+$" = '';
+
+# Lines will have a length of no more than $columns - 1.
+$Text::Wrap::columns = 77;
+$Text::Wrap::huge = 'overflow';
+
+setlogmask(LOG_UPTO(LOG_INFO));
+openlog(basename($0), 'pid', 'mail');
+
+$SIG{__WARN__} = sub { panic('Caught warning: %s', $_[0] || '(null)')   };
+$SIG{__DIE__}  = sub { panic('Caught exception: %s', $_[0] || '(null)') };
+$SIG{ALRM}     = sub { panic('Timeout after %d seconds', TIMEOUT)       };
+$SIG{HUP}      = sub { panic('Caught SIGHUP')                           };
+$SIG{INT}      = sub { panic('Caught SIGINT')                           };
+$SIG{PIPE}     = sub { panic('Caught SIGPIPE')                          };
+$SIG{TERM}     = sub { panic('Caught SIGTERM')                          };
+$SIG{USR1}     = sub { panic('Caught SIGUSR1')                          };
+$SIG{USR2}     = sub { panic('Caught SIGUSR2')                          };
+
+alarm(TIMEOUT);
+
+my $MESSAGE_ID;
+my @MESSAGE = <>; # The complete email message.
+
+#
+# Log and exit.
+#
+
+sub _report {
+        my ($level, $format, @args) = @_;
+
+        chomp(@args);
+        syslog($level, "$format (%s)", @args, $MESSAGE_ID || 'null');
+}
+
+sub debug    { _report(LOG_DEBUG,   @_) }
+sub info     { _report(LOG_INFO,    @_) }
+sub notice   { _report(LOG_NOTICE,  @_) }
+sub warning  { _report(LOG_WARNING, @_) }
+sub error    { _report(LOG_ERR,     @_) }
+sub critical { _report(LOG_CRIT,    @_) }
+
+sub panic {
+        $SIG{$_} = 'DEFAULT' for keys %SIG;
+        critical(@_);
+        print @MESSAGE;
+        bye(1);
+}
+
+sub bye {
+        my $status = shift;
+
+        debug('Exiting with status %d', $status);
+        closelog;
+        exit($status);
+}
+
+#
+# Look up MIME parts.
+#
+
+sub get_part {
+        my ($email, $type) = @_;
+
+        debug('Searching for %s part in email', $type);
+
+        foreach my $part ($email->subparts) {
+                next if $part->subparts;
+                return $part if $part->content_type =~ /\Q$type\E/i;
+        }
+        panic('Cannot find %s part in email', $type);
+}
+
+#
+# Edit a message.
+#
+
+sub edit_header {
+        my ($header, $recipient, $description) = @_;
+
+        debug('Editing header');
+
+        $header->header_set('Lines');
+        $header->header_set('Content-Length');
+        $header->header_set('Reply-To'); # Remove GitHub's reply address.
+        $header->header_set('To' => $recipient);
+        $header->header_set('X-MP-Content' => $description);
+
+        return $header;
+}
+
+sub edit_text_body {
+        my $body = shift;
+        my ($s, $r);
+
+        debug('Editing text/plain body');
+
+        $body = fill('', '', $body); # While at it, wrap the text.
+
+        $s = '^--- Reply to this email directly or view it on GitHub:';
+        $r = "-- \nReply to this email on GitHub:";
+        $body =~ s/$s/$r/m;
+
+        return $body;
+}
+
+sub edit_html_body {
+        my $body = shift;
+        my ($s, $r);
+
+        debug('Editing text/html body');
+
+        $s = 'Reply to this email directly or ';
+        $r = '';
+        $body =~ s/$s/$r/;
+
+        $s = 'view it on GitHub';
+        $r = 'Reply to this email on GitHub';
+        $body =~ s/$s/$r/;
+
+        return $body;
+}
+
+#
+# Check message type.
+#
+
+sub is_github_mail {
+        my $email = shift;
+
+        return $email->subparts == 2
+            and defined($email->header('From'))
+            and defined($email->header('X-GitHub-Recipient'))
+            and index($email->header('From'), 'notifications@github.com') != -1
+            and $email->header('X-GitHub-Recipient') eq 'monitoring-user';
+}
+
+sub is_github_status_change {
+        my $email = shift;
+        my $body = get_part($email, 'text/plain')->body_str;
+
+        if ($body =~ tr/\n// == 5) {
+                return 1 if $body =~ /^(?:Closed|Reopened) #\d+\.$/m;
+        }
+        return 0;
+}
+
+#
+# Handle message type.
+#
+
+sub handle_github_mail {
+        my $email = shift;
+        my $text = get_part($email, 'text/plain');
+        my $html = get_part($email, 'text/html');
+        my $text_body = $text->body_str;
+        my $html_body = $html->body_str;
+
+        $text->body_str_set(edit_text_body($text_body));
+        $html->body_str_set(edit_html_body($html_body));
+        $email->parts_set([$text, $html]);
+
+        if (is_github_status_change($email)) {
+                info('Received a GitHub status change');
+                $email->header_obj_set(edit_header($email->header_obj,
+                    STATUS_CHANGES_TO, 'GitHub status change'));
+        } else {
+                info('Received a GitHub comment');
+                $email->header_obj_set(edit_header($email->header_obj,
+                    COMMENTS_TO, 'GitHub comment'));
+        }
+        print $email->as_string;
+}
+
+sub handle_non_github_mail {
+        my $email = shift;
+
+        notice('Received a non-GitHub message');
+        # Just spit out the email as-is.
+        print $email->as_string;
+}
+
+#
+# Action!
+#
+
+my $email = Email::MIME->new("@MESSAGE");
+
+$MESSAGE_ID = $email->header('Message-ID') || '(null)';
+$email->header_set('X-MP-Filter' => basename($0));
+
+if (is_github_mail($email)) {
+        handle_github_mail($email);
+} else {
+        handle_non_github_mail($email);
+}
+bye(0);