path: root/libexec/filter-github-emails

#!/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);
}

#
# Wrap overlong lines.
#

sub rewrap {
	my $wrap = sub {
		my $line = shift;
		my $indent;

		if ($line =~ /^(?: {4}|\t)/) {
			return $line;
		} elsif (/^([> ]+)/) {
			$indent = $1;
		} else {
			$indent = '';
		}
		return wrap('', $indent, $line);
	};
	my @lines = split(/\n/, shift);
	my @wrapped = map { $wrap->($_) } @lines;

	debug('Rewrapping text');
	return join("\n", @wrapped);
}

#
# Write the email to STDOUT.
#
sub print_email {
	my $email = shift;
	my $text = $email->as_string;

	# Email::MIME sometimes prepends an empty line :-/
	$text =~ s/^[\r\n]+//;
	print $email->as_string;
}

#
# 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);

	# Strip the [monitoring-plugins] tag.
	my $subject = $header->header('Subject');
	$subject =~ s/^\[monitoring-plugins\] (.+)/$1/;
	$subject =~ s/^Re: \[monitoring-plugins\] (.+)/Re: $1/;
	$header->header_set('Subject' => $subject);

	return $header;
}

sub edit_text_body {
	my $body = shift;
	my ($s, $r);

	debug('Editing text/plain body');

	$body = rewrap($body); # While at it, wrap overlong lines.

	$s = "\n---\nReply to this email directly or view it on GitHub:";
	$r = "\n-- \nReply to this email on GitHub:";
	$body =~ s/$s/$r/;

	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 1 if $body =~ /^Closed #\d+ via [0-9a-f]{40}\.$/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($email);
}

sub handle_non_github_mail {
	my $email = shift;

	notice('Received a non-GitHub message');
	# Just spit out the email as-is.
	print_email($email);
}

#
# 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);