383 lines
11 KiB
Text
383 lines
11 KiB
Text
|
#!/usr/bin/perl
|
||
|
|
# This code was forked from the LiveJournal project owned and operated
|
||
|
|
# by Live Journal, Inc. The code has been modified and expanded by
|
||
|
|
# Dreamwidth Studios, LLC. These files were originally licensed under
|
||
|
|
# the terms of the license supplied by Live Journal, Inc, which can
|
||
|
|
# currently be found at:
|
||
|
|
#
|
||
|
|
# http://code.livejournal.org/trac/livejournal/browser/trunk/LICENSE-LiveJournal.txt
|
||
|
|
#
|
||
|
|
# In accordance with the original license, this code and all its
|
||
|
|
# modifications are provided under the GNU General Public License.
|
||
|
|
# A copy of that license can be found in the LICENSE file included as
|
||
|
|
# part of this distribution.
|
||
|
|
|
||
|
|
use strict;
|
||
|
|
BEGIN {
|
||
|
|
require "$ENV{LJHOME}/cgi-bin/ljlib.pl";
|
||
|
|
}
|
||
|
|
|
||
|
|
use LJ::Worker::TheSchwartz;
|
||
|
|
use DW::EmailPost;
|
||
|
|
use LJ::Support;
|
||
|
|
use LJ::Sysban;
|
||
|
|
|
||
|
|
schwartz_decl('LJ::Worker::IncomingEmail');
|
||
|
|
schwartz_work();
|
||
|
|
|
||
|
|
package TempDirObj;
|
||
|
|
use File::Path ();
|
||
|
|
|
||
|
|
sub new {
|
||
|
|
my ($class) = @_;
|
||
|
|
my $tmpdir = File::Temp::tempdir();
|
||
|
|
die "No tempdir made?" unless -d $tmpdir && -w $tmpdir;
|
||
|
|
return bless {
|
||
|
|
dir => $tmpdir,
|
||
|
|
}, $class;
|
||
|
|
}
|
||
|
|
|
||
|
|
sub dir { $_[0]{dir} }
|
||
|
|
|
||
|
|
sub DESTROY {
|
||
|
|
my $self = shift;
|
||
|
|
File::Path::rmtree($self->{dir}) if -d $self->{dir};
|
||
|
|
}
|
||
|
|
|
||
|
|
|
||
|
|
package LJ::Worker::IncomingEmail;
|
||
|
|
use strict;
|
||
|
|
use base 'TheSchwartz::Worker';
|
||
|
|
|
||
|
|
use MIME::Parser;
|
||
|
|
use File::Temp ();
|
||
|
|
my $last_job;
|
||
|
|
|
||
|
|
use DW::BlobStore;
|
||
|
|
|
||
|
|
sub max_retries { 5 }
|
||
|
|
sub retry_delay { 100 }
|
||
|
|
sub grab_for { 300 }
|
||
|
|
sub keep_exit_status_for { 86400 }
|
||
|
|
|
||
|
|
sub completed {
|
||
|
|
$last_job->completed;
|
||
|
|
return;
|
||
|
|
}
|
||
|
|
|
||
|
|
sub dequeue {
|
||
|
|
my $msg = shift;
|
||
|
|
$last_job->permanent_failure($msg);
|
||
|
|
return;
|
||
|
|
}
|
||
|
|
|
||
|
|
sub retry {
|
||
|
|
my $msg = shift;
|
||
|
|
$last_job->failed($msg);
|
||
|
|
return;
|
||
|
|
}
|
||
|
|
|
||
|
|
# examine message contents and decide what to do
|
||
|
|
# with it.
|
||
|
|
sub work {
|
||
|
|
my ($class, $job) = @_;
|
||
|
|
$last_job = $job;
|
||
|
|
my $arg = $job->arg;
|
||
|
|
|
||
|
|
my $tmpdiro = TempDirObj->new;
|
||
|
|
my $tmpdir = $tmpdiro->dir;
|
||
|
|
|
||
|
|
my $parser = MIME::Parser->new;
|
||
|
|
$parser->output_dir($tmpdir);
|
||
|
|
|
||
|
|
my $entity;
|
||
|
|
if ($arg =~ /^ie:.+$/) {
|
||
|
|
my $email = DW::BlobStore->retrieve( temp => $arg )
|
||
|
|
or return dequeue("Can't retrieve from BlobStore: $arg");
|
||
|
|
$entity = eval { $parser->parse_data( $$email ) };
|
||
|
|
} else {
|
||
|
|
$entity = eval { $parser->parse_data($arg) };
|
||
|
|
}
|
||
|
|
return dequeue("Can't parse MIME: $@") if $@;
|
||
|
|
|
||
|
|
my $head = $entity->head;
|
||
|
|
$head->unfold;
|
||
|
|
|
||
|
|
my $subject = $head->get('Subject');
|
||
|
|
chomp $subject;
|
||
|
|
$subject = LJ::trim( $subject );
|
||
|
|
|
||
|
|
# simple/effective spam/bounce/virus checks:
|
||
|
|
return dequeue("Bounce") if $head->get("Return-Path") =~ /^\s*<>\s*$/;
|
||
|
|
return dequeue("Spam") if subject_is_bogus($subject);
|
||
|
|
return dequeue("Virus found") if virus_check($entity);
|
||
|
|
return dequeue("Spam") if $subject && $subject =~ /^\[SPAM: \d+\.?\d*\]/;
|
||
|
|
|
||
|
|
# see if a hook is registered to handle this message
|
||
|
|
if (LJ::Hooks::are_hooks("incoming_email_handler")) {
|
||
|
|
|
||
|
|
my $errmsg = "";
|
||
|
|
my $retry = 0;
|
||
|
|
|
||
|
|
# incoming_email_handler hook will return a true value
|
||
|
|
# if it chose to handle this incoming email
|
||
|
|
my $rv = LJ::Hooks::run_hook("incoming_email_handler",
|
||
|
|
entity => $entity,
|
||
|
|
errmsg => \$errmsg,
|
||
|
|
retry => \$retry);
|
||
|
|
|
||
|
|
# success is signaled by a true $rv
|
||
|
|
if ($rv) {
|
||
|
|
|
||
|
|
# temporary retry case
|
||
|
|
if ($retry) {
|
||
|
|
return retry($errmsg);
|
||
|
|
}
|
||
|
|
|
||
|
|
# total failure case
|
||
|
|
if ($errmsg) {
|
||
|
|
return dequeue($errmsg);
|
||
|
|
}
|
||
|
|
|
||
|
|
return completed();
|
||
|
|
}
|
||
|
|
|
||
|
|
# hook didn't want to handle this email...
|
||
|
|
}
|
||
|
|
|
||
|
|
# see if it's a post-by-email
|
||
|
|
my $email_post = DW::EmailPost->get_handler( $entity );
|
||
|
|
if ( $email_post ) {
|
||
|
|
my ( $ok, $status_msg ) = $email_post->process;
|
||
|
|
|
||
|
|
# on success: $status_msg eq 'Post success"
|
||
|
|
# on failure: $status_msg is something else
|
||
|
|
# -- then we check $email_post->dequeue
|
||
|
|
return completed() if $ok;
|
||
|
|
|
||
|
|
# failure. do we retry?
|
||
|
|
return $email_post->dequeue ? dequeue( $status_msg ) : retry( $status_msg );
|
||
|
|
}
|
||
|
|
|
||
|
|
# stop more spam, based on body text checks
|
||
|
|
my $tent = DW::EmailPost->get_entity( $entity );
|
||
|
|
$tent ||= DW::EmailPost->get_entity( $entity, 'html' );
|
||
|
|
return dequeue("Can't find text or html entity") unless $tent;
|
||
|
|
my $body = $tent->bodyhandle->as_string;
|
||
|
|
$body = LJ::trim($body);
|
||
|
|
|
||
|
|
### spam
|
||
|
|
if ( $body =~ /I send you this file in order to have your advice/i
|
||
|
|
|| $body =~ /^Content-Type: application\/octet-stream/i
|
||
|
|
|| $body =~ /^(Please see|See) the attached file for details\.?$/i
|
||
|
|
|| $body =~ /^I apologize for this automatic reply to your email/i )
|
||
|
|
{
|
||
|
|
return dequeue("Spam");
|
||
|
|
}
|
||
|
|
|
||
|
|
# From this point on we know it's a support request of some type,
|
||
|
|
my $email2cat = LJ::Support::load_email_to_cat_map();
|
||
|
|
|
||
|
|
my $to;
|
||
|
|
my $toarg;
|
||
|
|
foreach my $a ( Mail::Address->parse( $head->get('To') ), Mail::Address->parse( $head->get('Cc') ) ) {
|
||
|
|
my $address = $a->address;
|
||
|
|
my $arg;
|
||
|
|
if ( $address =~ /^(.+)\+(.*)\@(.+)$/ ) {
|
||
|
|
( $address, $arg ) = ( lc "$1\@$3", $2 );
|
||
|
|
}
|
||
|
|
if ( defined $LJ::ALIAS_TO_SUPPORTCAT{$address} ) {
|
||
|
|
$address = $LJ::ALIAS_TO_SUPPORTCAT{$address};
|
||
|
|
}
|
||
|
|
if ( defined $email2cat->{$address} ) {
|
||
|
|
$to = $address;
|
||
|
|
$toarg = $arg;
|
||
|
|
}
|
||
|
|
}
|
||
|
|
|
||
|
|
return dequeue("Not deliverable to support system (no match To:)")
|
||
|
|
unless $to;
|
||
|
|
|
||
|
|
my $adf = ( Mail::Address->parse( $head->get('From') ) )[0];
|
||
|
|
return dequeue("Bogus From: header") unless $adf;
|
||
|
|
|
||
|
|
my $name = $adf->name;
|
||
|
|
my $from = $adf->address;
|
||
|
|
$subject ||= "(No Subject)";
|
||
|
|
|
||
|
|
# is this a reply to another post?
|
||
|
|
if ( $toarg =~ /^(\d+)z(.+)$/ ) {
|
||
|
|
my $spid = $1;
|
||
|
|
my $miniauth = $2;
|
||
|
|
my $sp = LJ::Support::load_request($spid);
|
||
|
|
|
||
|
|
LJ::Support::mini_auth($sp) eq $miniauth
|
||
|
|
or die "Invalid authentication?";
|
||
|
|
|
||
|
|
if ( LJ::sysban_check( 'support_email', $from ) ) {
|
||
|
|
my $msg = "Support request blocked based on email.";
|
||
|
|
LJ::Sysban::block( 0, $msg, { 'email' => $from } );
|
||
|
|
return dequeue($msg);
|
||
|
|
}
|
||
|
|
|
||
|
|
# make sure it's not locked
|
||
|
|
return dequeue("Request is locked, can't append comment.")
|
||
|
|
if LJ::Support::is_locked($sp);
|
||
|
|
|
||
|
|
# valid. need to strip out stuff now with authcodes:
|
||
|
|
$body =~ s!https?://.+/support/act\S+![snipped]!g;
|
||
|
|
$body =~ s!\+(\d)+z\w{1,10}\@!\@!g;
|
||
|
|
$body =~ s!&auth=\S+!!g;
|
||
|
|
|
||
|
|
## try to get rid of reply stuff.
|
||
|
|
# Outlook Express:
|
||
|
|
$body =~ s!(\S+.*?)-{4,10} Original Message -{4,10}.+!$1!s;
|
||
|
|
|
||
|
|
# Pine/Netscape
|
||
|
|
$body =~ s!(\S+.*?)\bOn [^\n]+ wrote:\n.+!$1!s;
|
||
|
|
|
||
|
|
# append the comment, re-open the request if necessary
|
||
|
|
my $splid = LJ::Support::append_request(
|
||
|
|
$sp,
|
||
|
|
{
|
||
|
|
'type' => 'comment',
|
||
|
|
'body' => $body,
|
||
|
|
}
|
||
|
|
)
|
||
|
|
or return dequeue("Error appending request?");
|
||
|
|
|
||
|
|
LJ::Support::add_email_address( $sp, $from );
|
||
|
|
|
||
|
|
LJ::Support::touch_request($spid);
|
||
|
|
|
||
|
|
return completed();
|
||
|
|
}
|
||
|
|
|
||
|
|
# Now see if we want to ignore this particular email and bounce it back with
|
||
|
|
# the contents from a file. Check $LJ::DENY_REQUEST_FROM_EMAIL first. Note
|
||
|
|
# that this will only bounce initial emails; if a user replies to an email
|
||
|
|
# from a request that's open, it'll be accepted above.
|
||
|
|
my ( $content_file, $content );
|
||
|
|
if ( %LJ::DENY_REQUEST_FROM_EMAIL && $LJ::DENY_REQUEST_FROM_EMAIL{$to} ) {
|
||
|
|
$content_file = $LJ::DENY_REQUEST_FROM_EMAIL{$to};
|
||
|
|
$content = LJ::load_include($content_file);
|
||
|
|
}
|
||
|
|
if ( $content_file && $content ) {
|
||
|
|
|
||
|
|
# construct mail to send to user
|
||
|
|
my $email = <<EMAIL_END;
|
||
|
|
$content
|
||
|
|
|
||
|
|
Your original message:
|
||
|
|
|
||
|
|
$body
|
||
|
|
EMAIL_END
|
||
|
|
|
||
|
|
# send the message
|
||
|
|
LJ::send_mail(
|
||
|
|
{
|
||
|
|
'to' => $from,
|
||
|
|
'from' => $LJ::BOGUS_EMAIL,
|
||
|
|
'subject' => "Your Email to $to",
|
||
|
|
'body' => $email,
|
||
|
|
'wrap' => 1,
|
||
|
|
}
|
||
|
|
);
|
||
|
|
|
||
|
|
# all done
|
||
|
|
return completed();
|
||
|
|
}
|
||
|
|
|
||
|
|
# make a new post.
|
||
|
|
my @errors;
|
||
|
|
|
||
|
|
# convert email body to utf-8
|
||
|
|
my $content_type = $head->get('Content-type:');
|
||
|
|
if ( $content_type =~ /\bcharset=[\'\"]?(\S+?)[\'\"]?[\s\;]/i ) {
|
||
|
|
my $charset = $1;
|
||
|
|
if ( defined $charset
|
||
|
|
&& $charset !~ /^UTF-?8$/i
|
||
|
|
&& Unicode::MapUTF8::utf8_supported_charset( $charset )
|
||
|
|
) {
|
||
|
|
$body = Unicode::MapUTF8::to_utf8(
|
||
|
|
{ -string => $body, -charset => $charset } );
|
||
|
|
}
|
||
|
|
}
|
||
|
|
|
||
|
|
my $spid = LJ::Support::file_request(
|
||
|
|
\@errors,
|
||
|
|
{
|
||
|
|
'spcatid' => $email2cat->{$to}->{'spcatid'},
|
||
|
|
'subject' => $subject,
|
||
|
|
'reqtype' => 'email',
|
||
|
|
'reqname' => $name,
|
||
|
|
'reqemail' => $from,
|
||
|
|
'body' => $body,
|
||
|
|
}
|
||
|
|
);
|
||
|
|
|
||
|
|
if (@errors) {
|
||
|
|
# FIXME: detect trasient vs. permanent errors (changes to
|
||
|
|
# file_request above, probably) and either dequeue or try
|
||
|
|
# later
|
||
|
|
return dequeue("Support errors: @errors");
|
||
|
|
}
|
||
|
|
else {
|
||
|
|
return completed();
|
||
|
|
}
|
||
|
|
}
|
||
|
|
|
||
|
|
# returns true on found virus
|
||
|
|
sub virus_check {
|
||
|
|
my $entity = shift;
|
||
|
|
return unless $entity;
|
||
|
|
|
||
|
|
my @exe = DW::EmailPost->get_entity( $entity, 'all' );
|
||
|
|
return unless scalar @exe;
|
||
|
|
|
||
|
|
# If an attachment's encoding begins with one of these strings,
|
||
|
|
# we want to completely drop the message.
|
||
|
|
# (Other 'clean' attachments are silently ignored, and the
|
||
|
|
# message is allowed.)
|
||
|
|
my @virus_sigs =
|
||
|
|
qw(
|
||
|
|
TVqQAAMAA TVpQAAIAA TVpAALQAc TVpyAXkAX TVrmAU4AA
|
||
|
|
TVrhARwAk TVoFAQUAA TVoAAAQAA TVoIARMAA TVouARsAA
|
||
|
|
TVrQAT8AA UEsDBBQAA UEsDBAoAAA
|
||
|
|
R0lGODlhaAA7APcAAP///+rp6puSp6GZrDUjUUc6Zn53mFJMdbGvvVtXh2xre8bF1x8cU4yLprOy
|
||
|
|
);
|
||
|
|
|
||
|
|
# get the length of the longest virus signature
|
||
|
|
my $maxlength =
|
||
|
|
length( ( sort { length $b <=> length $a } @virus_sigs )[0] );
|
||
|
|
$maxlength = 1024 if $maxlength >= 1024; # capped at 1k
|
||
|
|
|
||
|
|
foreach my $part (@exe) {
|
||
|
|
my $contents = $part->stringify_body;
|
||
|
|
$contents = substr $contents, 0, $maxlength;
|
||
|
|
|
||
|
|
foreach (@virus_sigs) {
|
||
|
|
return 1 if index( $contents, $_ ) == 0;
|
||
|
|
}
|
||
|
|
}
|
||
|
|
|
||
|
|
return;
|
||
|
|
}
|
||
|
|
|
||
|
|
sub subject_is_bogus {
|
||
|
|
my $subject = shift;
|
||
|
|
# ignore spam/vacation/auto-reply messages
|
||
|
|
return $subject =~ /auto.?(response|reply)/i
|
||
|
|
|| $subject =~ /^(Undelive|Mail System Error - |ScanMail Message: |\+\s*SPAM|Norton AntiVirus)/i
|
||
|
|
|| $subject =~ /^(Mail Delivery Problem|Mail delivery failed)/i
|
||
|
|
|| $subject =~ /^failure notice$/i
|
||
|
|
|| $subject =~ /\[BOUNCED SPAM\]/i
|
||
|
|
|| $subject =~ /^Symantec AVF /i
|
||
|
|
|| $subject =~ /Attachment block message/i
|
||
|
|
|| $subject =~ /Use this patch immediately/i
|
||
|
|
|| $subject =~ /^YOUR PAYPAL\.COM ACCOUNT EXPIRES/i
|
||
|
|
|| $subject =~ /^don\'t be late! ([\w\-]{1,25})$/i
|
||
|
|
|| $subject =~ /^your account ([\w\-]{1,25})$/i
|
||
|
|
|| $subject =~ /Message Undeliverable/i;
|
||
|
|
}
|