← Back to branch summary

~ubuntu-branches/ubuntu/utopic/mailscanner/utopic

« back to all changes in this revision

Viewing changes to lib/MailScanner/Message.pm

  • Committer: Bazaar Package Importer
  • Author(s): Matthias Klose
  • Date: 2005-10-05 01:10:34 UTC
  • mfrom: (1.1.2 upstream) (2.1.1 sarge)
  • Revision ID: james.westby@ubuntu.com-20051005011034-4cl0s3axruqty11m
Tags: 4.46.2-3
http://bugs.debian.org/332020
Pre-Depend on debconf (>= 0.5) | debconf-2.0 (closes: #332020).

Show diffs side-by-side

added added

removed removed

Lines of Context:
lib/MailScanner/Message.pm
2
2
#   MailScanner - SMTP E-Mail Virus Scanner
3
3
#   Copyright (C) 2002  Julian Field
4
4
#
5
 
#   $Id: Message.pm,v 1.126.2.184 2004/12/22 17:22:02 jkf Exp $
 
5
#   $Id: Message.pm,v 1.126.2.255 2005/09/05 15:55:39 jkf Exp $
6
6
#
7
7
#   This program is free software; you can redistribute it and/or modify
8
8
#   it under the terms of the GNU General Public License as published by
41
41
use MIME::Decoder::UU;
42
42
use MIME::Decoder::BinHex;
43
43
use MIME::WordDecoder;
44
 
use POSIX qw(setsid);
 
44
use POSIX qw(:signal_h setsid);
45
45
use HTML::TokeParser;
46
46
use HTML::Parser;
47
47
use Archive::Zip qw( :ERROR_CODES );
55
55
use vars qw($VERSION);
56
56
 
57
57
### The package version, both in 1.23 style *and* usable by MakeMaker:
58
 
$VERSION = substr q$Revision: 1.126.2.184 $, 10;
 
58
$VERSION = substr q$Revision: 1.126.2.255 $, 10;
59
59
 
60
60
# Attributes are
61
61
#
81
81
# $scanme               set by NeedsScanning (from MsgBatch constructor)
82
82
# $workarea             set by new
83
83
# @archiveplaces        set by new (addresses and dirs)
 
84
# @quarantineplaces     set by Quarantine.pm
84
85
# $spamwhitelisted      set by IsSpam
85
86
# $spamblacklisted      set by IsSpam
86
87
# $isspam               set by IsSpam
155
156
#                              virus-scanned so we can remove it again if
156
157
#                              necessary. But it doesn't need repairing, as we
157
158
#                              won't be delivering it anyway.
 
159
# $datenumber           set by new
 
160
# $datestring           set by new
 
161
# $messagedisarmed      set by DisarmHTMLTree
 
162
# @disarmedtags                All the HTML tags (incl. phishing) that we found
 
163
#                              and disarmed or highlighted.
 
164
# $quarantinedinfectionsset by QuarantineInfections, has this message already
 
165
#                              been quarantined, so doesn't need quarantining
 
166
#                              in QuarantineModifiedBodies.
158
167
#
159
168
 
160
169
# Constructor.
171
180
  #print STDERR "Creating message $id\n";
172
181
 
173
182
  $this->{id} = $id;
174
 
  @{$this->{archiveplaces}} = (); # Hope this syntax is right!
175
 
  @{$this->{spamarchive}}   = (); # Hope this syntax is right!
 
183
  @{$this->{archiveplaces}}    = ();
 
184
  @{$this->{spamarchive}}      = ();
 
185
  @{$this->{quarantineplaces}} = ();
176
186
 
177
187
  # Create somewhere to store the message
178
188
  $this->{store} = new MailScanner::SMDiskStore($id, $queuedirname);
202
212
  $this->{otherinfected} = 0;
203
213
  $this->{stillwarn}     = 0;
204
214
 
 
215
  # Set the date string and number
 
216
  $this->{datestring} = scalar localtime;
 
217
  my($day, $month, $year, $date);
 
218
  ($day, $month, $year) = (localtime)[3,4,5];
 
219
  $date = sprintf("%04d%02d%02d", $year+1900, $month+1, $day);
 
220
  $this->{datenumber} = $date;
 
221
 
205
222
  # Work out where to archive/copy this message.
206
223
  # Could do all the archiving in a different separate place.
207
224
  $archiveplaces = MailScanner::Config::Value('archivemail', $this);
 
225
  if ($archiveplaces =~ /_DATE_/) {
 
226
    # Only do the work for the date substitution if we really have to
 
227
    $archiveplaces =~ s/_DATE_/$date/g;
 
228
    #print STDERR "Archive location is $archiveplaces\n";
 
229
  }
208
230
  @{$this->{archiveplaces}} = ((defined $archiveplaces)?split(" ", $archiveplaces):());
209
231
 
 
232
  # Decide if we want to scan this message at all
 
233
  $this->{scanmail} = MailScanner::Config::Value('scanmail', $this);
 
234
  $this->{scanmail} = 1 if $this->{scanmail} =~ /1/;
 
235
 
210
236
  bless $this, $type;
211
237
  return $this;
212
238
}
290
316
# the message.
291
317
sub IsSpam {
292
318
  my $this = shift;
293
 
  my($includesaheader, $iswhitelisted);
 
319
  my($includesaheader, $iswhitelisted, $usegsscanner);
294
320
 
295
321
  my $spamheader    = "";
296
322
  my $rblspamheader = "";
 
323
  my $gsreport      = "";
297
324
  my $saspamheader  = "";
298
325
  my $RBLsaysspam   = 0;
299
326
  my $rblcounter    = 0;
300
327
  my $LogSpam = MailScanner::Config::Value('logspam');
301
328
  my $LogNonSpam = MailScanner::Config::Value('lognonspam');
302
329
  my $LocalSpamText = MailScanner::Config::LanguageValue($this, 'spam');
 
330
  my $LocalNotSpamText = MailScanner::Config::LanguageValue($this, 'notspam');
303
331
 
304
332
  # Construct a pretty list of all the unique domain names for logging
305
333
  my(%todomain, $todomain);
335
363
 
336
364
  # Work out if they always want the SA header
337
365
  $includesaheader = MailScanner::Config::Value('includespamheader', $this);
 
366
  # If they want the GS scanner then we must carry on too
 
367
  $usegsscanner = MailScanner::Config::Value('gsscanner', $this);
338
368
 
339
369
  # Do the whitelist check before the blacklist check.
340
370
  # If anyone whitelists it, then everyone gets the message.
353
383
      $iswhitelisted = 1;
354
384
      $this->{spamwhitelisted} = 1;
355
385
      # whitelisted and doesn't want SA header so get out
356
 
      return 0 unless $includesaheader;
 
386
      return 0 unless $includesaheader || $usegsscanner;
357
387
    }
358
388
  } else {
359
389
    # Had too many recipients, ignoring the whitelist
365
395
  }
366
396
 
367
397
  # If it's a blacklisted address, don't bother doing any checks at all
368
 
  if (MailScanner::Config::Value('spamblacklist', $this)) {
 
398
  if (!$iswhitelisted && MailScanner::Config::Value('spamblacklist', $this)) {
369
399
    $this->{spamblacklisted} = 1;
370
400
    $this->{isspam} = 1;
371
401
    $this->{ishigh} = 1
381
411
    return 1;
382
412
  }
383
413
 
 
414
  my $whitelistreport = '';
 
415
  if ($iswhitelisted) {
 
416
    $whitelistreport = ' (' .
 
417
                  MailScanner::Config::LanguageValue($this, 'whitelisted') .
 
418
                  ')';
 
419
  }
 
420
 
384
421
  if (!$iswhitelisted) {
385
422
    # Not whitelisted, so do the RBL checks
386
 
    #$rblspamheader     = MailScanner::RBLs::Checks($this);
387
423
    ($rblcounter, $rblspamheader) = MailScanner::RBLs::Checks($this);
388
 
    $RBLsaysspam       = 1 if $rblcounter;
389
 
    #$RBLsaysspam       = 1 if $rblspamheader;
 
424
    my $rblthreshold = MailScanner::Config::Value('normalrbls', $this);
 
425
    my $highrblthreshold = MailScanner::Config::Value('highrbls', $this);
 
426
    $rblthreshold = 1 if $rblthreshold <= 1;
 
427
    $highrblthreshold = 1 if $highrblthreshold <= 1;
 
428
    $RBLsaysspam       = 1 if $rblcounter >= $rblthreshold;
390
429
    # Add leading "spam, " if RBL says it is spam. This will be at the
391
430
    # front of the spam report.
392
 
    $rblspamheader     = $LocalSpamText . ', ' . $rblspamheader if $rblcounter;
393
 
    $this->{isspam}    = 1 if $rblcounter;
394
 
    $this->{isrblspam} = 1 if $rblcounter;
395
 
    $this->{ishigh}    = 1 if $rblcounter >= MailScanner::Config::Value(
396
 
                                             'highrbls', $this);
397
 
    #print STDERR "RBL report is \"$rblspamheader\"\n";
398
 
    #print STDERR "RBLCounter = $rblcounter\n";
399
 
    #print STDERR "HighRBLs   = " .
400
 
    #             MailScanner::Config::Value('highrbls', $this) . "\n";
 
431
    $this->{isspam}    = 1 if $RBLsaysspam;
 
432
    $this->{isrblspam} = 1 if $RBLsaysspam;
 
433
    $this->{ishigh}    = 1 if $rblcounter >= $highrblthreshold;
 
434
  }
 
435
  # rblspamheader is useful start to spamreport if RBLsaysspam.
 
436
 
 
437
  # Do the Custom Spam Checker
 
438
  my($gsscore, $gsreport);
 
439
  #print STDERR "In Message.pm about to look at gsscanner\n";
 
440
  if ($usegsscanner) {
 
441
    #print STDERR "In Message.pm about to run gsscanner\n";
 
442
    ($gsscore, $gsreport) = MailScanner::GenericSpam::Checks($this);
 
443
    #print STDERR "In Message.pm we got $gsscore, $gsreport\n";
 
444
    $this->{gshits} = $gsscore;
 
445
    $this->{gsreport} = $gsreport;
 
446
    $this->{sascore} = $gsscore; # Add the score
 
447
    MailScanner::Log::InfoLog("Custom Spam Scanner for message %s from %s " .
 
448
                              "(%s) to %s report is %s %s",
 
449
                              $this->{id}, $this->{clientip},
 
450
                              $this->{from}, $todomain, $gsscore, $gsreport)
 
451
      if $LogSpam && ($gsscore!=0 || $gsreport ne "");
401
452
  }
402
453
 
403
454
  # Don't do the SA checks if they have said no.
404
455
  unless (MailScanner::Config::Value('usespamassassin', $this)) {
405
456
    $this->{spamwhitelisted} = $iswhitelisted;
406
 
    $this->{spamreport}      = $rblspamheader;
 
457
    $this->{isspam} = 1
 
458
      if $gsscore+0.0 >=
 
459
         MailScanner::Config::Value('reqspamassassinscore',$this)+0.0;
 
460
    $this->{ishigh} = 1
 
461
      if $gsscore+0.0 >=
 
462
         MailScanner::Config::Value('highspamassassinscore',$this)+0.0;
407
463
    MailScanner::Log::InfoLog("Message %s from %s (%s) to %s is %s",
408
464
                              $this->{id}, $this->{clientip},
409
465
                              $this->{from}, $todomain, $rblspamheader)
410
466
      if $RBLsaysspam && $LogSpam;
411
 
    return $RBLsaysspam;
 
467
    # Replace start of report if it wasn't spam from rbl but now is.
 
468
    $this->{spamreport} = ($this->{isspam})?$LocalSpamText:$LocalNotSpamText;
 
469
    $this->{spamreport} .= $whitelistreport;
 
470
    $this->{spamreport} .= ', ' if $this->{spamreport};
 
471
    $this->{spamreport} .= $rblspamheader if $rblspamheader;
 
472
    $this->{spamreport} .= ', ' if $this->{spamreport} && $rblspamheader;
 
473
    $this->{spamreport} .= $gsscore+0.0 if $gsscore!=0;
 
474
    $this->{spamreport} .= ', ' if $this->{spamreport} && $gsscore!=0;
 
475
    $this->{spamreport} .= $gsreport if $gsreport ne "";
 
476
    $this->{spamreport} = $this->ReflowHeader(
 
477
                  MailScanner::Config::Value('spamheader',$this),
 
478
                  $this->{spamreport});
 
479
    return $this->{isspam};
412
480
  }
413
481
 
414
482
  # If it's spam and they dont want to check SA as well
415
483
  if ($this->{isspam} &&
416
484
      !MailScanner::Config::Value('checksaifonspamlist', $this)) {
417
485
    $this->{spamwhitelisted} = $iswhitelisted;
418
 
    $this->{spamreport}      = $rblspamheader;
419
486
    MailScanner::Log::InfoLog("Message %s from %s (%s) to %s is %s",
420
487
                              $this->{id}, $this->{clientip},
421
488
                              $this->{from}, $todomain, $rblspamheader)
422
489
      if $RBLsaysspam && $LogSpam;
 
490
    # Replace start of report if it wasn't spam from rbl but now is.
 
491
    $this->{spamreport} = ($this->{isspam})?$LocalSpamText:$LocalNotSpamText;
 
492
    $this->{spamreport} .= $whitelistreport;
 
493
    $this->{spamreport} .= ', ' if $this->{spamreport};
 
494
    $this->{spamreport} .= $rblspamheader if $rblspamheader;
 
495
    $this->{spamreport} .= ', ' if $this->{spamreport} && $rblspamheader;
 
496
    $this->{spamreport} .= $gsscore+0.0 if $gsscore!=0;
 
497
    $this->{spamreport} .= ', ' if $this->{spamreport} && $gsscore!=0;
 
498
    $this->{spamreport} .= $gsreport if $gsreport ne "";
 
499
    $this->{spamreport} = $this->ReflowHeader(
 
500
                  MailScanner::Config::Value('spamheader',$this),
 
501
                  $this->{spamreport});
423
502
    return $RBLsaysspam;
424
503
  }
425
504
 
432
511
  my $salongreport = "";
433
512
  ($SAsaysspam, $SAHighScoring, $saheader, $sascore, $salongreport)
434
513
    = MailScanner::SA::Checks($this);
435
 
  $this->{sascore} = $sascore; # Save the actual figure for use later...
 
514
  $this->{sascore} += $sascore; # Save the actual figure for use later...
436
515
  # Trim all the leading rubbish off the long SA report and turn it back
437
516
  # into a multi-line string, then store it in the message properties.
438
517
  $salongreport =~ s/^.* pts rule name/ pts rule name/;
459
538
  if ($this->{isspam}) {
460
539
    #print STDERR "It is spam\nInclude SA = $includesaheader\n";
461
540
    #print STDERR "SAHeader = $saheader\n";
462
 
    $spamheader = $rblspamheader;
463
541
    # If it's SA spam as well, or they always want the SA header
464
542
    if ($SAsaysspam || $includesaheader) {
465
543
      #print STDERR "Spam or Add SA Header\n";
466
 
      $spamheader = $LocalSpamText unless $spamheader;
467
 
      $spamheader .= ', ' if $spamheader && $saheader;
468
 
      $spamheader .= $saheader;
469
544
      $this->{ishigh} = 1 if $SAHighScoring;
 
545
      $this->{spamreport} = ($this->{isspam})?$LocalSpamText:$LocalNotSpamText;
 
546
      $this->{spamreport} .= $whitelistreport;
 
547
      $this->{spamreport} .= ', ' if $this->{spamreport};
 
548
      $this->{spamreport} .= $rblspamheader if $rblspamheader;
 
549
      $this->{spamreport} .= ', ' if $this->{spamreport} && $rblspamheader;
 
550
      $this->{spamreport} .= $gsscore+0.0 if $gsscore!=0;
 
551
      $this->{spamreport} .= ', ' if $this->{spamreport} && $gsscore!=0;
 
552
      $this->{spamreport} .= $gsreport if $gsreport ne "";
 
553
      $this->{spamreport} .= ', ' if $this->{spamreport} && $gsreport;
 
554
      $this->{spamreport} .= $saheader if $saheader ne "";
470
555
    }
471
556
  } else {
472
557
    # It's not spam...
473
558
    #print STDERR "It's not spam\n";
474
559
    #print STDERR "SAHeader = $saheader\n";
475
 
    $spamheader = MailScanner::Config::LanguageValue($this, 'notspam');
476
 
    if ($iswhitelisted) {
477
 
      $spamheader .= ' (' .
478
 
                    MailScanner::Config::LanguageValue($this, 'whitelisted') .
479
 
                    ')';
480
 
    }
481
 
    # so RBL report must be blank as you can't force inclusion of that.
482
 
    # So just include SA report.
483
 
    $spamheader .= ", $saheader";
484
 
  }
485
 
 
486
 
  # Now just reflow and log the results
487
 
  if ($spamheader ne "") {
488
 
    $spamheader = $this->ReflowHeader(
489
 
                  MailScanner::Config::Value('spamheader',$this), $spamheader);
490
 
    $this->{spamreport} = $spamheader;
 
560
    $this->{spamreport} = ($this->{isspam})?$LocalSpamText:$LocalNotSpamText;
 
561
    $this->{spamreport} .= $whitelistreport;
 
562
    $this->{spamreport} .= ', ' if $this->{spamreport};
 
563
    $this->{spamreport} .= $rblspamheader if $rblspamheader;
 
564
    $this->{spamreport} .= ', ' if $this->{spamreport} && $rblspamheader;
 
565
    $this->{spamreport} .= $gsscore+0.0 if $gsscore!=0;
 
566
    $this->{spamreport} .= ', ' if $this->{spamreport} && $gsscore!=0;
 
567
    $this->{spamreport} .= $gsreport if $gsreport ne "";
 
568
    $this->{spamreport} .= ', ' if $this->{spamreport} && $gsreport;
 
569
    $this->{spamreport} .= $saheader if $saheader ne "";
491
570
  }
492
571
 
493
572
  # Do the spam logging here so we can log high-scoring spam too
494
573
  if (($LogSpam && $this->{isspam}) || ($LogNonSpam && !$this->{isspam})) {
495
 
    my $ReportText = $spamheader;
 
574
    my $ReportText = $this->{spamreport};
496
575
    $ReportText =~ s/\s+/ /sg;
497
576
    MailScanner::Log::InfoLog("Message %s from %s (%s) to %s is %s",
498
577
                              $this->{id}, $this->{clientip},
499
578
                              $this->{from}, $todomain, $ReportText);
500
579
  }
501
580
 
 
581
  # Now just reflow and log the results
 
582
  if ($this->{spamreport} ne "") {
 
583
    $this->{spamreport} = $this->ReflowHeader(
 
584
                  MailScanner::Config::Value('spamheader',$this),
 
585
                  $this->{spamreport});
 
586
  }
 
587
 
502
588
  return $this->{isspam};
503
589
}
504
590
    
560
646
  # deliver spam like normal mail.
561
647
  return unless @actions;
562
648
 
 
649
  # If they have just specified a filename, then something is wrong
 
650
  if ($#actions==0 && $actions[0] =~ /\//) {
 
651
    MailScanner::Log::WarnLog('Your spam actions "%s" looks like a filename.' .
 
652
        ' If this is a ruleset filename, it must end in .rule or .rules',
 
653
        $actions[0]);
 
654
    $actions[0] = 'deliver';
 
655
  }
 
656
 
563
657
  #print STDERR "Message: HandleHamSpam has actions " . join(',',@actions) .
564
658
  #             "\n";
565
659
 
590
684
    # Message is going to original recipient and/or extra recipients
591
685
    #
592
686
 
 
687
    MailScanner::Log::InfoLog("Spam Actions: message %s actions are %s",
 
688
                              $this->{id}, join(',', keys %actions))
 
689
      if $HamSpam eq 'spam' && MailScanner::Config::Value('logspam');
 
690
 
 
691
    # Delete the original recipient if they are only forwarding it
 
692
    $global::MS->{mta}->DeleteRecipients($this) if !$actions{'deliver'};
 
693
 
593
694
    # Delete action is over-ridden as we are sending it somewhere
594
695
    delete $actions{'delete'};
595
696
 
596
 
    MailScanner::Log::InfoLog("Spam Actions: message %s actions are %s",
597
 
                              $this->{id}, join(',', keys %actions))
598
 
      if $HamSpam eq 'spam' && MailScanner::Config::Value('logspam');
599
 
 
600
 
    # Delete the original recipient if they are only forwarding it
601
 
    $global::MS->{mta}->DeleteRecipients($this) if !$actions{'deliver'};
602
 
 
603
697
    # Message still exists, so it will be delivered to its new recipients
604
698
  } else {
605
699
    #
613
707
    # Mark the message so it won't get cleaned up or delivered, but just dropped
614
708
    #print STDERR "Setting DontDeliver for " . $this->{id} . "\n";
615
709
    $this->{dontdeliver} = 1;
 
710
    # Optimisation courtesy of Yavor.Trapkov@wipo.int
 
711
    $this->{deleted} = 1 if (keys %actions) == 1 && $actions{'delete'};
616
712
    ## Mark the message as deleted, so it won't get delivered
617
713
    #$this->{deleted} = 1;
618
714
  }
650
746
    $gid = $global::MS->{quar}->{gid};
651
747
    $changeowner = $global::MS->{quar}->{changeowner};
652
748
    $dir = MailScanner::Config::Value('quarantinedir', $this);
653
 
    $dir2 = $dir . '/' .  MailScanner::Quarantine::TodayDir();
 
749
    #$dir2 = $dir . '/' .  MailScanner::Quarantine::TodayDir();
 
750
    $dir2 = $dir . '/' .  $this->{datenumber};
654
751
    $spamdir = $dir2 . '/' . $HamSpam;
655
752
    #print STDERR "dir = $dir\ndir2 = $dir2\nspamdir = $spamdir\n";
656
753
    umask $global::MS->{quar}->{dirumask};
703
800
 
704
801
  my($from,$to,$subject,$date,$spamreport,$longspamreport,$hostname);
705
802
  my($emailmsg, $line, $messagefh, $filename, $localpostmaster, $id);
 
803
  my($postmastername);
706
804
 
707
805
  $from = $this->{from};
708
806
 
733
831
  $id = $this->{id};
734
832
  #$to = join(', ', @{$this->{to}});
735
833
  $localpostmaster = MailScanner::Config::Value('localpostmaster', $this);
 
834
  $postmastername  = MailScanner::Config::LanguageValue($this, 'mailscanner');
736
835
  $hostname = MailScanner::Config::Value('hostname', $this);
737
836
  $subject = $this->{subject};
738
 
  $date = scalar localtime;
 
837
  $date = $this->{datestring}; # scalar localtime;
739
838
  $spamreport = $this->{spamreport};
740
839
  $longspamreport = $this->{salongreport};
741
840
  #print STDERR "longspamreport = \"$longspamreport\"\n";
830
929
                                        'X-Mailer'  => undef,
831
930
                                        Data        => \@original));
832
931
  
 
932
  # Prune all the dead branches off the tree
 
933
  PruneEntityTree($bounce);
833
934
  # Stringify the message and send it -- this could be VERY large!
834
935
  my $bouncetext = $bounce->stringify;
835
936
  #print STDERR "Spam bounce message is this:\n$bouncetext";
853
954
 
854
955
  my($from,$to,$subject,$date,$spamreport,$hostname,$day,$month,$year);
855
956
  my($emailmsg, $line, $messagefh, $filename, $localpostmaster, $id);
 
957
  my($postmastername);
856
958
 
857
959
  $from = $this->{from};
858
960
 
882
984
  # Setup other variables they can use in the message template
883
985
  $id = $this->{id};
884
986
  $localpostmaster = MailScanner::Config::Value('localpostmaster', $this);
 
987
  $postmastername  = MailScanner::Config::LanguageValue($this, 'mailscanner');
885
988
  $hostname = MailScanner::Config::Value('hostname', $this);
886
989
  $subject = $this->{subject};
887
 
  $date = scalar localtime;
 
990
  $date = $this->{datestring}; # scalar localtime;
888
991
  $spamreport = $this->{spamreport};
889
992
  # And let them put the date number in there too
890
 
  ($day, $month, $year) = (localtime)[3,4,5];
891
 
  $month++;
892
 
  $year += 1900;
893
 
  my $datenumber = sprintf("%04d%02d%02d", $year, $month, $day);
 
993
  #($day, $month, $year) = (localtime)[3,4,5];
 
994
  #$month++;
 
995
  #$year += 1900;
 
996
  #my $datenumber = sprintf("%04d%02d%02d", $year, $month, $day);
 
997
  my $datenumber = $this->{datenumber};
894
998
 
895
999
 
896
1000
  my($to, %tolist);
930
1034
}
931
1035
 
932
1036
 
 
1037
# Deliver a message that doesn't want to be touched at all in any way.
 
1038
# Take an out queue dir.
 
1039
sub DeliverUntouched {
 
1040
  my $this = shift;
 
1041
  my($OutQ) = @_;
 
1042
 
 
1043
  return if $this->{deleted};
 
1044
 
 
1045
  #my $OutQ = MailScanner::Config::Value('outqueuedir', $this);
 
1046
  my $store = $this->{store};
 
1047
 
 
1048
  # Link the queue data file from in to out
 
1049
  $store->LinkData($OutQ);
 
1050
 
 
1051
  # Add the headers onto the metadata in the message store
 
1052
  $global::MS->{mta}->AddHeadersToQf($this);
 
1053
 
 
1054
  # Add the secret archive recipients
 
1055
  my($extra, @extras);
 
1056
  foreach $extra (@{$this->{archiveplaces}}) {
 
1057
    # Email archive recipients include a '@'
 
1058
    next if $extra =~ /^\//;
 
1059
    next unless $extra =~ /@/;
 
1060
    push @extras, $extra;
 
1061
  }
 
1062
  $global::MS->{mta}->AddRecipients($this, @extras) if @extras;
 
1063
 
 
1064
  # Write the new qf file, delete originals and unlock the message
 
1065
  $store->WriteHeader($this, $OutQ);
 
1066
  unless ($this->{gonefromdisk}) {
 
1067
    $store->DeleteUnlock();
 
1068
    $this->{gonefromdisk} = 1;
 
1069
  }
 
1070
 
 
1071
  # Note this does not kick the MTA into life here any more
 
1072
}
933
1073
 
934
1074
# Deliver a message that doesn't need scanning at all
935
1075
# Takes an out queue dir.
948
1088
  # Add the headers onto the metadata in the message store
949
1089
  $global::MS->{mta}->AddHeadersToQf($this);
950
1090
 
 
1091
  # Remove duplicate subject: lines
 
1092
  $global::MS->{mta}->UniqHeader($this, 'Subject:');
 
1093
 
951
1094
  # Add the information/help X- header
952
1095
  my $infoheader = MailScanner::Config::Value('infoheader', $this);
953
1096
  if ($infoheader) {
961
1104
                 MailScanner::Config::Value('unscannedheader', $this), ', ');
962
1105
  }
963
1106
 
 
1107
  # Remove any headers we don't want in the message
 
1108
  my(@removeme, $remove);
 
1109
  @removeme = split(/[,\s]+/, MailScanner::Config::Value('removeheaders', $this));
 
1110
  foreach $remove (@removeme) {
 
1111
    # Add a : if there isn't one already, it's needed for DeleteHeader()
 
1112
    $remove .= ':' unless $remove =~ /:$/;
 
1113
    $global::MS->{mta}->DeleteHeader($this, $remove);
 
1114
  }
 
1115
 
964
1116
  # Leave old content-length: headers as we aren't changing body.
965
1117
 
966
1118
  # Add the MCP headers if necessary
988
1140
  $minstars = MailScanner::Config::Value('minstars', $this);
989
1141
  $starcount = $minstars if $this->{isrblspam} && $minstars &&
990
1142
                            $starcount<$minstars;
 
1143
  if (MailScanner::Config::Value('spamscorenotstars', $this)) {
 
1144
    $stars = $scoretext; # int($starcount);
 
1145
  } else {
 
1146
    $starcount = 60 if $starcount>60;
 
1147
    $stars = MailScanner::Config::Value('spamstarscharacter') x $starcount;
 
1148
  }
991
1149
  if (MailScanner::Config::Value('spamstars', $this) =~ /1/ && $starcount>0) {
992
 
    if (MailScanner::Config::Value('spamscorenotstars', $this)) {
993
 
      $stars = $scoretext; # int($starcount);
994
 
    } else {
995
 
      $starcount = 60 if $starcount>60;
996
 
      $stars = MailScanner::Config::Value('spamstarscharacter') x $starcount;
997
 
    }
998
1150
    $global::MS->{mta}->AddMultipleHeader($this, 'spamstarsheader',
999
1151
                                          $stars, ', ');
1000
1152
  }
1006
1158
  $global::MS->{mta}->ReplaceHeader($this, 'Subject:', $this->{safesubject})
1007
1159
    if $this->{subjectwasunsafe};
1008
1160
 
 
1161
  # Modify the subject line for Disarming
 
1162
  my $disarmtag = MailScanner::Config::Value('disarmsubjecttext',$this);
 
1163
  if ($this->{messagedisarmed} &&
 
1164
      MailScanner::Config::Value('disarmprependsubject',$this) =~ /1/ &&
 
1165
      !$global::MS->{mta}->TextStartsHeader($this, 'Subject:', $disarmtag)) {
 
1166
    $global::MS->{mta}->PrependHeader($this, 'Subject:', $disarmtag, ' ');
 
1167
  }
 
1168
    
1009
1169
  # Modify the subject line for spam
1010
1170
  # if it's spam AND they want to modify the subject line AND it's not
1011
1171
  # already been modified by another of your MailScanners.
1012
1172
  my $spamtag = MailScanner::Config::Value('spamsubjecttext', $this);
1013
1173
  $spamtag =~ s/_SCORE_/$scoretext/;
 
1174
  $spamtag =~ s/_STARS_/$stars/i;
1014
1175
  if ($this->{isspam} && !$this->{ishigh} &&
1015
1176
      MailScanner::Config::Value('spamprependsubject',$this) &&
1016
1177
      !$global::MS->{mta}->TextStartsHeader($this, 'Subject:', $spamtag)) {
1019
1180
  # If it is high-scoring spam, then add a different bit of text
1020
1181
  $spamtag = MailScanner::Config::Value('highspamsubjecttext', $this);
1021
1182
  $spamtag =~ s/_SCORE_/$scoretext/;
 
1183
  $spamtag =~ s/_STARS_/$stars/i;
1022
1184
  if ($this->{isspam} && $this->{ishigh} &&
1023
1185
      MailScanner::Config::Value('highspamprependsubject',$this) &&
1024
1186
      !$global::MS->{mta}->TextStartsHeader($this, 'Subject:', $spamtag)) {
1035
1197
  $scoretext = sprintf($scorefmt, $this->{mcpsascore}+0);
1036
1198
  my $mcptag = MailScanner::Config::Value('mcpsubjecttext', $this);
1037
1199
  $mcptag =~ s/_SCORE_/$scoretext/;
 
1200
  $mcptag =~ s/_STARS_/$stars/i;
1038
1201
  if ($this->{ismcp} && !$this->{ishighmcp} &&
1039
1202
      MailScanner::Config::Value('mcpprependsubject',$this) &&
1040
1203
      !$global::MS->{mta}->TextStartsHeader($this, 'Subject:', $mcptag)) {
1043
1206
  # If it is high-scoring MCP, then add a different bit of text
1044
1207
  $mcptag = MailScanner::Config::Value('highmcpsubjecttext', $this);
1045
1208
  $mcptag =~ s/_SCORE_/$scoretext/;
 
1209
  $mcptag =~ s/_STARS_/$stars/i;
1046
1210
  if ($this->{ismcp} && $this->{ishighmcp} &&
1047
1211
      MailScanner::Config::Value('highmcpprependsubject',$this) &&
1048
1212
      !$global::MS->{mta}->TextStartsHeader($this, 'Subject:', $mcptag)) {
1160
1324
  #  if $maxparts>0 && MIME::Entity::MailScannerCounter()>=$maxparts;
1161
1325
  if (!$entity) {
1162
1326
    #print STDERR "Found an error!\n";
1163
 
    $pipe->close();
 
1327
    $pipe->close() if $pipe; # Don't close a pipe that failed to exist
1164
1328
    waitpid $pid, 0;
 
1329
    unless ($this->{dpath}) {
 
1330
      # It probably ran out of disk space, drop this message from the batch
 
1331
      MailScanner::Log::WarnLog("Failed to create message structures for %s" .
 
1332
        ", dropping it from the batch", $this->{id});
 
1333
      my @toclear = ( $this->{id} );
 
1334
      $workarea->ClearIds(\@toclear); # Delete attachments we might have made
 
1335
      $this->DropFromBatch();
 
1336
      return;                                                         
 
1337
    }
 
1338
 
1165
1339
    MailScanner::Log::WarnLog("Cannot parse " . $this->{headerspath} . " and " .
1166
1340
                 $this->{dpath} . ", $@");
1167
1341
    $this->{entity} = $entity; # In case it failed due to too many attachments
1237
1411
  # -------------------------------
1238
1412
  # If the MIME boundary exists and is "" then remove the entire message.
1239
1413
  # The top level must be multipart/mixed
1240
 
  if ($entity->is_multipart && $entity->head) {
1241
 
    my $boundary = $entity->head->multipart_boundary;
1242
 
    #print STDERR "Boundary is \"$boundary\"\n";
1243
 
    if ($boundary eq "" || $boundary eq "\"\"" || $boundary =~ /^\s/) {
1244
 
      my $cantparse = MailScanner::Config::LanguageValue($this, 'cantanalyze');
1245
 
      $this->{allreports}{""} .= "$mailscannername: $cantparse\n";
1246
 
      $this->{alltypes}{""} .= 'c';
1247
 
      $this->{otherinfected}++;
1248
 
      #print STDERR "Found error\n";
 
1414
  if ($entity->head) {
 
1415
    if ($entity->is_multipart || $entity->head->mime_type =~ /^multipart/i) {
 
1416
      my $boundary = $entity->head->multipart_boundary;
 
1417
      #print STDERR "Boundary is \"$boundary\"\n";
 
1418
      if ($boundary eq "" || $boundary eq "\"\"" || $boundary =~ /^\s/) {
 
1419
        my $cantparse = MailScanner::Config::LanguageValue($this,
 
1420
                                                           'cantanalyze');
 
1421
        $this->{allreports}{""} .= "$mailscannername: $cantparse\n";
 
1422
        $this->{alltypes}{""} .= 'c';
 
1423
        $this->{otherinfected}++;
 
1424
        #print STDERR "Found error\n";
 
1425
      }
1249
1426
    }
1250
1427
  }
1251
1428
 
1277
1454
    if $workarea->{changeowner};
1278
1455
}
1279
1456
 
 
1457
# Quietly drop a message from the batch. Used when we run out of disk
 
1458
# space.
 
1459
sub DropFromBatch {
 
1460
  my($message) = @_;
 
1461
  $message->{deleted} = 1;
 
1462
  $message->{gonefromdisk} = 1; # Don't try to delete the original
 
1463
  $message->{store}->Unlock(); # Unlock it so other processes can pick it up
 
1464
}
 
1465
 
1280
1466
# Try to recursively unpack tar (with or without gzip) files and zip files.
1281
1467
# Extracts to a given maximum unpacking depth.
1282
1468
sub ExplodePartAndArchives {
1288
1474
  my($size, $level, $ziperror, $tarerror, $silentviruses, $noisyviruses);
1289
1475
  my($allziperrors, $alltarerrors, $textlevel, $failisokay);
1290
1476
  my($linenum, $foundheader, $prevline, $line, $position, $prevpos, $nextpos);
1291
 
  my($cyclecounter);
 
1477
  my($cyclecounter, $rarerror);
1292
1478
 
1293
1479
  $dir = new DirHandle;
1294
1480
  $file = new FileHandle;
1322
1508
      next if $part eq '.' || $part eq '..';
1323
1509
      # Skip the entire loop if it's not what we are looking for
1324
1510
      # JKF I really haven't the faintest idea why I wrote the next line :-)
1325
 
      #next unless $part =~ /(^msg.*txt$)|(\.(tar\.g?z|taz|tgz|tz|zip|exe)$)/i;
 
1511
      #next unless $part =~
 
1512
      #  /(^msg.*txt$)|(\.(tar\.g?z|taz|tgz|tz|zip|exe|rar)$)/i;
1326
1513
 
1327
1514
      $size = -s "$explodeinto/$part";
1328
1515
      #print STDERR "Checking $part $size bytes\n";
1442
1629
      if ($buffer =~ /^MZ/) {
1443
1630
        $failisokay = 1;
1444
1631
      }
1445
 
      next unless $buffer eq "PK\003\004" || $failisokay;
1446
 
      #print STDERR "Found a zip file\n" ;
 
1632
      next unless $buffer eq "PK\003\004" ||
 
1633
                  $buffer eq "Rar!"       ||
 
1634
                  $part =~ /\.rar$/       ||
 
1635
                  $failisokay;
 
1636
      #print STDERR "Found a zip or rar file\n" ;
1447
1637
      next unless MailScanner::Config::Value('findarchivesbycontent', $this) ||
1448
 
                  $part =~ /\.(tar\.g?z|taz|tgz|tz|zip|exe)$/i;
 
1638
                  $part =~ /\.(tar\.g?z|taz|tgz|tz|zip|exe|rar)$/i;
1449
1639
      $foundnewfiles = 1;
1450
1640
      #print STDERR "Unpacking $part at level $level\n";
1451
1641
 
1455
1645
      $ziperror = $this->UnpackZip($part, $explodeinto, $allowpasswords,
1456
1646
                                   $onlycheckencryption);
1457
1647
      #print STDERR "* * * * * * * Unpackzip $part returned $ziperror\n";
1458
 
      # If unpacking as a zip failed, try it as a tar
 
1648
      # If unpacking as a zip failed, try it as a rar
 
1649
      $rarerror = "";
 
1650
      if ($part =~ /\.rar$/i || $buffer eq "Rar!" or $buffer =~ /^MZ[P]?/) {
 
1651
        $rarerror = $this->UnpackRar($part, $explodeinto, $allowpasswords,
 
1652
                                     $onlycheckencryption);
 
1653
      }
1459
1654
      $tarerror = "";
1460
1655
      $tarerror = 0 # $this->UnpackTar($part, $explodeinto, $allowpasswords)
1461
1656
        if $ziperror || $part =~ /(tar\.g?z|tgz)$/i;
1462
1657
      #print STDERR "In inner: \"$part\"\n";
1463
 
      if ($ziperror eq "password") {
 
1658
      if ($ziperror eq "password" || $rarerror eq "password") {
1464
1659
        MailScanner::Log::WarnLog("Password-protected archive (%s) in %s",
1465
1660
                                  $part, $this->{id});
1466
1661
        $this->{allreports}{$part} .= "$msname: $passwordedmesg\n";
1467
1662
        $this->{alltypes}{$part} .= 'c';
 
1663
        $this->{passwordprotected} = 1;
1468
1664
        $this->{otherinfected} = 1;
1469
1665
        $this->{cantdisinfect} = 1; # Don't even think about disinfecting this!
1470
1666
        $this->{silent}=1 if $silentviruses =~ / Zip-Password | All-Viruses /i;
1471
1667
        $this->{noisy} =1 if $noisyviruses  =~ / Zip-Password /i;
1472
 
      } elsif ($ziperror && $tarerror && !$failisokay) {
 
1668
      } elsif ($ziperror && $tarerror && $rarerror && !$failisokay) {
1473
1669
        MailScanner::Log::WarnLog("Unreadable archive (%s) in %s",
1474
1670
                                  $part, $this->{id});
1475
1671
        $this->{allreports}{$part} .= "$msname: $couldnotreadmesg\n";
1495
1691
  }
1496
1692
}
1497
1693
 
 
1694
# Unpack a rar file into the named directory.
 
1695
# Return 1 if an error occurred, else 0.
 
1696
# Return 0 on success.
 
1697
# Return "password" if a member was password-protected.
 
1698
# Very much like UnpackZip except it uses the external "unrar" command.
 
1699
sub UnpackRar {
 
1700
  my($this, $zipname, $explodeinto, $allowpasswords, $onlycheckencryption) = @_;
 
1701
 
 
1702
  my($zip, @members, $member, $name, $fh, $safename, $memb, $check, $junk,
 
1703
     $unrar,$IsEncrypted, $PipeTimeOut, $PipeReturn,$NameTwo, $HasErrors,
 
1704
     $member2, $Stuff, $BeginInfo, $EndInfo, $ParseLine, $what);
 
1705
 
 
1706
  # Timeout value for unrar is currently the same as that of the file
 
1707
  # command + 20. Julian, when you add the filetimeout to the config file
 
1708
  # perhaps you should think about adding a maxcommandexecutetime setting
 
1709
  # as well
 
1710
  $PipeTimeOut = MailScanner::Config::Value('unrartimeout');
 
1711
  $unrar = MailScanner::Config::Value('unrarcommand');
 
1712
  return 1 unless $unrar && -x $unrar;
 
1713
 
 
1714
  #MailScanner::Log::WarnLog("UnPackRar Testing : %s", $zipname);
 
1715
 
 
1716
  # This part lists the archive contents and makes the list of
 
1717
  # file names within. "This is a list verbose option"
 
1718
  $memb = SafePipe("$unrar v '$explodeinto/$zipname' 2>/dev/null",
 
1719
                   $PipeTimeOut);
 
1720
 
 
1721
  $junk = "";
 
1722
  $Stuff = "";
 
1723
  $BeginInfo = 0;
 
1724
  $EndInfo = 0;
 
1725
  $ParseLine = 1;
 
1726
  $memb =~ s/\r//gs;
 
1727
  my @test = split /\n/, $memb;
 
1728
  $memb = '';
 
1729
 
 
1730
  # Have to parse the output from the 'v' command and parse the information
 
1731
  # between the ----------------------------- lines
 
1732
  foreach $what (@test) {
 
1733
    # Have we already hit the beginng and now find another ------ string?
 
1734
    # If so then we are at the end
 
1735
    $EndInfo = 1 if $what =~ /-{40,}$/ && $BeginInfo;
 
1736
  
 
1737
    # if we are after the begning but haven't reached the end,
 
1738
    # then process this line
 
1739
    if ($BeginInfo && !$EndInfo) {
 
1740
      # If we are on line one then it's the file name with full path
 
1741
      # otherwise we are on the info line containing the attributes
 
1742
      if ($ParseLine eq 1) {
 
1743
        $junk = $what;
 
1744
        $junk =~ s/^\s+|\s+$//g;
 
1745
        chomp($junk);
 
1746
        $ParseLine = 2;
 
1747
      } else {
 
1748
        $Stuff = $what;
 
1749
        $Stuff =~ s/^\s+|\s+$//g;
 
1750
        # Need to remove redundant spaces from our info line and
 
1751
        # split it into it's components
 
1752
        chomp($Stuff);
 
1753
        $Stuff =~ s/\s{2,}/ /g;
 
1754
        my ($RSize,$RPacked,$RRatio,$RDate,$RTime,$RAttrib,$RCrc,$RMeth,$RVer)
 
1755
           = split /\s/, $Stuff;
 
1756
        # If RAttrib doesn't begin with d then it's a file and we
 
1757
        # add it to our $memb string, otherwise we ignore the directory
 
1758
        # only entries
 
1759
        #MailScanner::Log::WarnLog("UnPackRar InfoLine :%s:", $Stuff);
 
1760
        #MailScanner::Log::WarnLog("UnPackRar Looking at ATTRIB :->%s<-:",
 
1761
        #                          $RAttrib);
 
1762
        $memb .= "$junk\n" if $RAttrib !~ /^d|^.D/;
 
1763
        $junk = '';
 
1764
        $Stuff = '';
 
1765
        $ParseLine = 1;
 
1766
      }
 
1767
    }
 
1768
    # If we have a line full of ---- and $BeginInfo is not set then
 
1769
    # we are at the first and we need to set $BeginInfo so next pass
 
1770
    # begins processing file information
 
1771
    if ($what =~ /-{40,}$/ && ! $BeginInfo) {
 
1772
      $BeginInfo = 1;
 
1773
    }
 
1774
  }
 
1775
 
 
1776
  # Remove returns from the output string, exit if the archive is empty
 
1777
  # or the output is empty
 
1778
 
 
1779
  $memb =~ s/\r//gs;
 
1780
  return 1 if $memb ne '' &&
 
1781
              $memb =~ /(No files to extract|^COMMAND_TIMED_OUT$)/si;
 
1782
 
 
1783
  return 0 if $memb eq ''; # JKF If no members it probably wasn't a Rar self-ext
 
1784
  #MailScanner::Log::DebugLog("Unrar : Archive Testing Completed On : %s",
 
1785
  #                           $memb);
 
1786
 
 
1787
  @members = split /\n/, $memb;
 
1788
  $fh = new FileHandle;
 
1789
 
 
1790
  foreach $member2 (@members) {
 
1791
    $IsEncrypted = 0;
 
1792
    $HasErrors = 0;
 
1793
    #MailScanner::Log::InfoLog("Checking member %s",$member2);
 
1794
    # Test the current file name to see if it's password protected
 
1795
    # and capture the output. If the command times out, then return
 
1796
 
 
1797
    next if $member2 eq "";
 
1798
    $member = quotemeta $member2;
 
1799
    #print STDERR "Member is ***$member***\n";
 
1800
    $check = SafePipe(
 
1801
      "$unrar  t -p- -idp '$explodeinto/$zipname' $member 2>&1",
 
1802
      $PipeTimeOut);
 
1803
    #print STDERR "Point 1\n";
 
1804
    return 1 if $check =~ /^COMMAND_TIMED_OUT$/;
 
1805
 
 
1806
    # Check for any error with this file. Format is FileName - Error string
 
1807
    if ($check =~ /$member\s+-\s/i){
 
1808
      MailScanner::Log::WarnLog("Unrar: Error in file: %s -> %s",
 
1809
                                $zipname,$member);
 
1810
      $HasErrors = 1;
 
1811
    }
 
1812
 
 
1813
    $check =~ s/\n/:/gsi;
 
1814
    #MailScanner::Log::WarnLog("Got : %s", $check);
 
1815
 
 
1816
    # If we get the string Encrypted then we have found a password
 
1817
    # protected archive and we handle it the same as zips are handled
 
1818
 
 
1819
    if ($check =~ /\bEncrypted file:\s.+\(password incorrect/si) {
 
1820
      $IsEncrypted = 1;
 
1821
      MailScanner::Log::WarnLog("Password Protected RAR Found");
 
1822
      #print STDERR "Checking member " . $member . "\n";
 
1823
      #print STDERR "******** Encryption = " . $IsEncrypted . "\n";
 
1824
      return "password" if !$allowpasswords && $IsEncrypted;
 
1825
    }
 
1826
 
 
1827
 
 
1828
    # If they don't want to extract, but only check for encryption,
 
1829
    # then skip the rest of this as we don't actually want the files
 
1830
    # checked against the file name/type rules
 
1831
    next if $onlycheckencryption;
 
1832
 
 
1833
    $name = $member2;
 
1834
    #print STDERR "UnPackRar : Making Safe Name from $name\n";
 
1835
 
 
1836
    # There is no facility to change the output name for a rar file
 
1837
    # but we can rename rename the files inside the archive
 
1838
    # prefer to use $NameTwo because there is no path attached
 
1839
    # $safename is guaranteed not to exist, but NameTwo gives us the
 
1840
    # filename without any directory information, which we use later.
 
1841
    $safename = $this->MakeNameSafe($name,$explodeinto);
 
1842
    $NameTwo = $safename;
 
1843
    $NameTwo = $1 if $NameTwo =~ /([^\/]+)$/;
 
1844
    #MailScanner::Log::InfoLog("UnPackRar: Member : %s", $member);
 
1845
    #print STDERR "UnPackRar : Safe Name is $safename\n";
 
1846
 
 
1847
    #MailScanner::Log::InfoLog("UnPackRar: SafeName : %s", $safename);
 
1848
    $this->{file2parent}{$name} = $zipname;
 
1849
    $this->{file2parent}{$safename} = $zipname;
 
1850
    $this->{file2safefile}{$name} = $safename;
 
1851
    $this->{safefile2file}{$safename} = $name;
 
1852
    #print STDERR "Archive member \"$name\" is now \"$safename\"\n";
 
1853
 
 
1854
    #$this->{file2entity}{$name} = $this->{entity};
 
1855
    $this->{file2safefile}{$name} = $zipname;
 
1856
    #$this->{safefile2file}{$safename} = $zipname;
 
1857
 
 
1858
    $safename = "$explodeinto/$safename";
 
1859
 
 
1860
    $PipeReturn = '';
 
1861
    $? = 0;
 
1862
    if (!$IsEncrypted && !$HasErrors) {
 
1863
      #print STDERR "Expanding ***$member***\ninto ***$NameTwo***\n";
 
1864
      $PipeReturn = SafePipe(
 
1865
                   "$unrar p -y -inul -p- -idp '$explodeinto/$zipname' $member > \"$NameTwo\"",
 
1866
                   $PipeTimeOut);
 
1867
      unless ("$?" == 0 && $PipeReturn ne 'COMMAND_TIMED_OUT'){
 
1868
        # The rename operation failed!, so skip the extraction of a
 
1869
        # potentially bad file name.
 
1870
        # JKF Temporary testing code
 
1871
        #MailScanner::Log::WarnLog("UnPackRar: RC: %s PipeReturn : ",$?,$PipeReturn);
 
1872
        MailScanner::Log::WarnLog("UnPackRar: Could not rename or use " .
 
1873
            "safe name in Extract, NOT Unpacking file %s", $safename);
 
1874
        next;
 
1875
      }
 
1876
      #MailScanner::Log::InfoLog("UnPackRar: Done...., got %d and %s", $?, $PipeReturn);
 
1877
    }
 
1878
    #MailScanner::Log::WarnLog("RC = %s : Encrypt = %s : PipeReturn = %s",
 
1879
    #                          $?,$IsEncrypted,$PipeReturn );
 
1880
    unless ("$?" == 0 && !$HasErrors && !$IsEncrypted &&
 
1881
            $PipeReturn ne 'COMMAND_TIMED_OUT') {
 
1882
 
 
1883
      # If we got an error, or this file is encrypted create a zero-length
 
1884
      # file so the filename tests will still work.
 
1885
      MailScanner::Log::WarnLog("Unrar : Encrypted Or Extract Error Creating" .
 
1886
                                " 0 length %s",$NameTwo);
 
1887
      $fh->open(">$safename") && $fh->close();
 
1888
    }
 
1889
  }
 
1890
  return 0;
 
1891
}
 
1892
 
 
1893
# Modified Julian's code from SweepOther.pm
 
1894
# Changed to allow execution of any given command line with a time
 
1895
# control. This could replace any call to system or use of backticks
 
1896
#
 
1897
# $Cmd         = command line to execute
 
1898
# $timeout     = max time in seconds to allow execution
 
1899
#
 
1900
sub SafePipe {
 
1901
  my ($Cmd, $TimeOut) = @_;
 
1902
 
 
1903
  my($Kid, $pid, $TimedOut, $Str);
 
1904
  $Kid  = new FileHandle;
 
1905
  $TimedOut = 0;
 
1906
 
 
1907
  #print STDERR "SafePipe : Command : $Cmd\n";
 
1908
  #print STDERR "SafePipe : TimeOut : $TimeOut\n";
 
1909
 
 
1910
  $? = 0; # Make sure there's no junk left in here
 
1911
 
 
1912
  eval {
 
1913
    die "Can't fork: $!" unless defined($pid = open($Kid, '-|'));
 
1914
    if ($pid) {
 
1915
      # In the parent
 
1916
 
 
1917
      # Set up a signal handler and set the alarm time to the timeout
 
1918
      # value passed to the function
 
1919
 
 
1920
      local $SIG{ALRM} = sub { $TimedOut = 1; die "Command Timed Out" };
 
1921
      alarm $TimeOut;
 
1922
 
 
1923
      # while the command is running we will collect it's output
 
1924
      # in the $Str variable. We don't process it in any way here so
 
1925
      # whatever called us will get back exactly what they would have
 
1926
      # gotten with a system() or backtick call
 
1927
 
 
1928
      #MailScanner::Log::DebugLog("SafePipe : Processing %s", $Cmd);
 
1929
 
 
1930
      while(<$Kid>) {
 
1931
        $Str .= $_;
 
1932
        #print STDERR "SafePipe : Processing line \"$_\"\n";
 
1933
      }
 
1934
 
 
1935
      #MailScanner::Log::DebugLog("SafePipe : Completed $Cmd");
 
1936
      #print STDERR "SafePipe : Returned $PipeReturnCode\n";
 
1937
 
 
1938
      $pid = 0; # 2.54
 
1939
      alarm 0;
 
1940
      # Workaround for bug in perl shipped with Solaris 9,
 
1941
      # it doesn't unblock the SIGALRM after handling it.
 
1942
      eval {
 
1943
        my $unblockset = POSIX::SigSet->new(SIGALRM);
 
1944
        sigprocmask(SIG_UNBLOCK, $unblockset)
 
1945
          or die "Could not unblock alarm: $!\n";
 
1946
      };
 
1947
    } else {
 
1948
      # In the child
 
1949
      POSIX::setsid();
 
1950
 
 
1951
      # Execute the command via an exec call, bear in mind this will only
 
1952
      # capture STDIN so if you need STDERR, or both you have to handle, for
 
1953
      # example, 2>&1 as part of the command line just as you would with
 
1954
      # system() or backticks
 
1955
      #
 
1956
      #the line following the
 
1957
      # call should *never* be reached unless the call it's self fails
 
1958
      #print STDERR "SafePipe in child exec $Cmd\n";
 
1959
 
 
1960
      my @args = ( "$Cmd" );
 
1961
      #exec $Cmd or print STDERR "SafePipe :  failed to execute $Cmd\n";
 
1962
 
 
1963
      open STDIN, "< /dev/null";
 
1964
 
 
1965
      exec @args
 
1966
        or MailScanner::Log::WarnLog("SafePipe :  failed to execute %s", $Cmd);
 
1967
      #MailScanner::Log::DebugLog("SafePipe in Message.pm : exec failed " .
 
1968
      #                           "for $Cmd");
 
1969
      exit 1;
 
1970
    }
 
1971
  };
 
1972
  alarm 0; # 2.53
 
1973
 
 
1974
  #MailScanner::Log::DebugLog("SafePipe in Message.pm : Completed $Cmd");
 
1975
  #MailScanner::Log::WarnLog("Returned Code : %d", $?);
 
1976
  # Catch failures other than the alarm
 
1977
  MailScanner::Log::WarnLog("SafePipe in Message.pm : $Cmd failed with real error: $@")
 
1978
    if $@ and $@ !~ /Command Timed Out/;
 
1979
 
 
1980
  #print STDERR "SafePipe : pid = $pid and \@ = $@\n";
 
1981
 
 
1982
  # In which case any failures must be the alarm
 
1983
  if ($@ or $pid>0) {
 
1984
    # Kill the running child process
 
1985
    my($i);
 
1986
    kill -15, $pid;
 
1987
    # Wait for up to 5 seconds for it to die
 
1988
    for ($i=0; $i<5; $i++) {
 
1989
      sleep 1;
 
1990
      waitpid($pid, &POSIX::WNOHANG);
 
1991
      ($pid=0),last unless kill(0, $pid);
 
1992
      kill -15, $pid;
 
1993
    }
 
1994
    # And if it didn't respond to 11 nice kills, we kill -9 it
 
1995
    if ($pid) {
 
1996
      kill -9, $pid;
 
1997
      waitpid $pid, 0; # 2.53
 
1998
    }
 
1999
  }
 
2000
 
 
2001
  # If the command timed out return the string below, otherwise
 
2002
  # return the command output in $Str
 
2003
  return $Str unless $TimedOut;
 
2004
 
 
2005
  MailScanner::Log::WarnLog("Safepipe in Message.pm : %s timed out!", $Cmd);
 
2006
  return "COMMAND_TIMED_OUT";
 
2007
}
 
2008
 
 
2009
 
1498
2010
# Unpack a zip file into the named directory.
1499
2011
# Return 1 if an error occurred, else 0.
1500
2012
# Return 0 on success.
1592
2104
    $ext  =~ s/\s+$//;
1593
2105
    $root = substr($root, 0, ($self->{MPF_TrimRoot} || 14));
1594
2106
    $ext  = substr($ext,  0, ($self->{MPF_TrimExt}  ||  3));
1595
 
    $ext =~ /^\w+$/ or $ext = "dat";
 
2107
    $ext =~ /^\w+$|^$/ or $ext = "dat";
1596
2108
    my $trunc = $root . ($ext ? ".$ext" : '');
1597
2109
    if (!$self->IsNameEvil($trunc, $dir)) {
1598
2110
        #$self->debug("looks like I can use the truncated last path element");
1909
2421
  while (($file, $text) = each %{$this->{namereports}}) {
1910
2422
    #print STDERR "Adding file \"$file\" report \"$text\"\n";
1911
2423
    # Next line not needed as we prepend the $Name anyway
1912
 
    #$text =~ s/\n(.)/\n$Name:  $1/g if $Name; # Make sure name is at the front of this
 
2424
    #$text =~ s/\n(.)/\n$Name: NEWSTABLE $1/g if $Name; # Make sure name is at the front of this
1913
2425
    #print STDERR "report is now \"$text\"\n";
1914
2426
    $this->{allreports}{$file} .= $Name . $text;
1915
2427
    $reports{$file} .= $Name . $text;
1936
2448
  while(($key, $value) = each %reports) {
1937
2449
    $parent = $this->{file2parent}{$key};
1938
2450
    #print STDERR "Looking at report for $key (son of $parent)\n";
1939
 
    if (defined $parent && exists($this->{safefile2file}{$parent})) {
 
2451
    #if (defined $parent && exists($this->{safefile2file}{$parent})) {
 
2452
    #  #print STDERR "Found parent of $key is $parent\n";
 
2453
    #  $foundparent{$key} = 1;
 
2454
    #  $this->{allreports}{$parent} .= $value;
 
2455
    #  $this->{alltypes}{$parent}   .= $types{$key};
 
2456
    #} else {
 
2457
    #  #print STDERR "Promoting report for $key\n";
 
2458
    #  delete $this->{allreports}{$key};
 
2459
    #  delete $this->{alltypes}{$key};
 
2460
    #  $this->{allreports}{""} .= $value;
 
2461
    #  $this->{alltypes}{""} .= $types{$key};
 
2462
    #}
 
2463
    if (defined $parent && exists($this->{safefile2file}{$parent}) &&
 
2464
        $parent ne "") {
1940
2465
      #print STDERR "Found parent of $key is $parent\n";
1941
2466
      $foundparent{$key} = 1;
1942
2467
      $this->{allreports}{$parent} .= $value;
1943
2468
      $this->{alltypes}{$parent}   .= $types{$key};
 
2469
    } else {
 
2470
      #print STDERR "Promoting report for $key\n";
 
2471
      if($parent eq "" and exists($this->{safefile2file}{$key})) {
 
2472
        $foundparent{$key} = 1;
 
2473
        delete $this->{allreports}{$key};
 
2474
        delete $this->{alltypes}{$key};
 
2475
        $this->{allreports}{$key} .= $value;
 
2476
        $this->{alltypes}{$key}   .= $types{$key};
 
2477
      } else {
 
2478
        delete $this->{allreports}{$key};
 
2479
        delete $this->{alltypes}{$key};
 
2480
        $this->{allreports}{""} .= $value;
 
2481
        $this->{alltypes}{""} .= $types{$key};
 
2482
      }
1944
2483
    }
1945
2484
  }
1946
2485
  # And delete the records for members we have found.
1952
2491
 
1953
2492
  # Now look for the reports we can't match anywhere and make them
1954
2493
  # map to the entire message.
1955
 
  while(($key, $value) = each %reports) {
1956
 
    if (defined $foundparent{$key} && !exists($this->{safefile2file}{$key})) {
1957
 
      #print STDERR "Promoting report for $key\n";
1958
 
      delete $this->{allreports}{$key};
1959
 
      delete $this->{alltypes}{$key};
1960
 
      $this->{allreports}{""} .= $value;
1961
 
      $this->{alltypes}{""} .= $types{$key};
1962
 
    }
1963
 
  }
 
2494
  #while(($key, $value) = each %reports) {
 
2495
  #  if (!defined $foundparent{$key} || !exists($this->{safefile2file}{$key})) {
 
2496
  #    #print STDERR "Promoting report for $key\n";
 
2497
  #    delete $this->{allreports}{$key};
 
2498
  #    delete $this->{alltypes}{$key};
 
2499
  #    $this->{allreports}{""} .= $value;
 
2500
  #    $this->{alltypes}{""} .= $types{$key};
 
2501
  #  }
 
2502
  #}
1964
2503
 
1965
2504
  #print STDERR "Finished combining reports\n";
1966
2505
  #$this->PrintInfections();
1989
2528
  my $storeme = 0;
1990
2529
  $storeme = 1
1991
2530
    if MailScanner::Config::Value('quarantineinfections', $this) =~ /1/;
 
2531
  # Cancel the storage if it is silent and no-one wants it quarantined
 
2532
  $storeme = 0 if $this->{silent} && !$this->{noisy} &&
 
2533
                  MailScanner::Config::Value('quarantinesilent', $this) !~ /1/;
1992
2534
 
1993
2535
  # Construct a string of all the reports, which is used if there is
1994
2536
  # cleaning needing doing on the whole message
2021
2563
      #print STDERR "It's a whole body infection, entity = ".$this->{entity}."\n";
2022
2564
      $entity = $this->{entity};
2023
2565
    } else {
 
2566
      #print STDERR "It's just 1 file, which is $file\n";
2024
2567
      if ($tnefentity) {
2025
2568
        $entity = $tnefentity;
2026
2569
      } else {
2106
2649
    # Nothing needs to be cleaned though.
2107
2650
    next if $ModificationOnly;
2108
2651
 
 
2652
    # If it's a silent virus, then only generate the report if anyone
 
2653
    # wants a copy of it in the quarantine. Or else it won't be quarantined
 
2654
    # but they will still get a copy of the report.
 
2655
    #print STDERR "\n\nSilent = " . $this->{silent} . " and Noisy = " . $this->{noisy} . "\n";
 
2656
    $filename = "" if $this->{silent} && !$this->{noisy} &&
 
2657
                      !MailScanner::Config::Value('deliversilent', $this); # &&
 
2658
    #             MailScanner::Config::Value('quarantinesilent', $this) !~ /1/;
 
2659
 
2109
2660
    # Do the actual attachment replacement
2110
2661
    #print STDERR "File = \"$file\"\nthis = \"$this\"\n";
2111
2662
    #print STDERR "Entity to clean is $entity\n" .
2191
2742
    $Warning = $this->ConstructWarning(
2192
2743
                 MailScanner::Config::LanguageValue($this, 'theentiremessage'),
2193
2744
                 $report, $this->{id}, $reportname);
 
2745
    #print STDERR "Warning message is $Warning\n";
2194
2746
    #031118 if ($this->{entity} eq $entity) {
2195
2747
    if ($entity->bodyhandle) {
2196
2748
      #print STDERR "Really doing the whole message\n";
2225
2777
        if $temp;
2226
2778
      return;
2227
2779
    } else {
2228
 
      ## When replacing the whole body of message/partial messages,
2229
 
      ## don't forget to fix the root mime header.
2230
 
      #$entity->head->mime_attr("Content-type" => "multipart/mixed")
2231
 
      #  if $entity->head->mime_attr("content-type") =~ /message\/partial/i;
2232
 
      #print STDERR "In CleanEntity, replacing entire message\n";
2233
 
      $parts[0] = build MIME::Entity
 
2780
      # If the message is multipart but the boundary is "" then it won't
 
2781
      # have any parts() which makes it impossible to overwrite without
 
2782
      # first forcing it to throw away all the structure by becoming
 
2783
      # single-part.
 
2784
      $entity->make_singlepart
 
2785
        if $entity->is_multipart && $entity->head &&
 
2786
           $entity->head->multipart_boundary eq "";
 
2787
 
 
2788
      $parts[0] = MIME::Entity->build(
2234
2789
                        Type => 'text/plain',
2235
2790
                        Filename => $warningfile,
2236
2791
                        Disposition => 'inline',
2237
2792
                        Data => $Warning,
2238
2793
                        Encoding => 'quoted-printable',
2239
2794
                        Charset => $charset,
2240
 
                        Top => 0;
2241
 
      #print STDERR "Mime type is " . $entity->mime_type() . "\n";
2242
 
      #my $sss = $entity->is_multipart();
2243
 
      #print STDERR "Currently is " . $sss . "\n";
2244
 
      #print STDERR "Is defined\n" if defined($sss);
2245
 
      #print STDERR "Type now is " . $entity->head->mime_attr('content-type')
2246
 
      #             . "\n";
2247
 
  
2248
 
      #print STDERR "Status is " . $entity->make_multipart() . "\n"
 
2795
                        Top => 0);
2249
2796
      $entity->make_multipart()
2250
2797
        if $entity->head && $entity->head->mime_attr('content-type') eq "";
2251
2798
      $entity->parts(\@parts);
2284
2831
  #print STDERR "About to constructwarning from $report\n";
2285
2832
  $Warning = $this->ConstructWarning($this->{entity2file}{$entity},
2286
2833
                                     $report, $this->{id}, $reportname);
2287
 
  $Disposition = MailScanner::Config::Value('warningisattachment',$this)
2288
 
                 ?'attachment':'inline';
2289
 
  $parts[$infectednum] = build MIME::Entity
2290
 
                           Type => 'text/plain',
2291
 
                           Filename => $warningfile,
2292
 
                           Disposition => $Disposition,
2293
 
                           Data => $Warning,
2294
 
                           Encoding => 'quoted-printable',
2295
 
                           Charset => $charset,
2296
 
                           Top => 0;
 
2834
  #print STDERR "Reportname is \"$reportname\"\n";
 
2835
  #print STDERR "Warning is \"$Warning\"\n";
 
2836
  # If the warning is now 0 bytes, don't add it, just remove the virus
 
2837
  if ($Warning ne "") {
 
2838
    $Disposition = MailScanner::Config::Value('warningisattachment',$this)
 
2839
                   ?'attachment':'inline';
 
2840
    $parts[$infectednum] = build MIME::Entity
 
2841
                             Type => 'text/plain',
 
2842
                             Filename => $warningfile,
 
2843
                             Disposition => $Disposition,
 
2844
                             Data => $Warning,
 
2845
                             Encoding => 'quoted-printable',
 
2846
                             Charset => $charset,
 
2847
                             Top => 0;
 
2848
  } else {
 
2849
    # We are just deleting the part, not replacing it
 
2850
    # @parts = splice @parts, $infectednum, 1;
 
2851
    $parts[$infectednum] = undef; # We prune the tree just during delivery
 
2852
  }
2297
2853
  $parent->parts(\@parts);
2298
2854
 
2299
2855
  # And make the parent a multipart/mixed if it's a multipart/alternative
2316
2872
  my $this = shift;
2317
2873
  my($attachmententity, $scannersaid, $id, $reportname) = @_;
2318
2874
 
2319
 
  my $date = scalar localtime;
 
2875
  # If there is no report file then we create no warning
 
2876
  return "" unless $reportname;
 
2877
 
 
2878
  my $date = $this->{datestring}; # scalar localtime;
2320
2879
  my $textfh = new FileHandle;
2321
2880
  my $dir = $global::MS->{work}{dir}; # Get the working directory
2322
2881
  my $localpostmaster = MailScanner::Config::Value('localpostmaster', $this);
 
2882
  my $postmastername  = MailScanner::Config::LanguageValue($this, 'mailscanner');
2323
2883
 
2324
2884
  #print STDERR "ConstructWarning for $attachmententity. Scanner said \"" .
2325
2885
  #             "$scannersaid\", message id $id, file = $reportname\n";
2343
2903
  #my $date = scalar localtime; Already defined above
2344
2904
  my $report = $scannersaid;
2345
2905
  my $hostname = MailScanner::Config::Value('hostname',$this);
 
2906
  my $linkhostname = lc($hostname);
 
2907
  $linkhostname =~ tr/a-z0-9_-//dc;
2346
2908
  my $quarantinedir = MailScanner::Config::Value('quarantinedir', $this);
2347
2909
 
2348
2910
  # And let them put the date number in there too
2349
2911
  my($day, $month, $year);
2350
 
  ($day, $month, $year) = (localtime)[3,4,5];
2351
 
  $month++;
2352
 
  $year += 1900;
2353
 
  my $datenumber = sprintf("%04d%02d%02d", $year, $month, $day);
 
2912
  #($day, $month, $year) = (localtime)[3,4,5];
 
2913
  #$month++;
 
2914
  #$year += 1900;
 
2915
  #my $datenumber = sprintf("%04d%02d%02d", $year, $month, $day);
 
2916
  my $datenumber = $this->{datenumber};
2354
2917
 
2355
2918
#  # Do we want to hide the directory and message id from the report path?
2356
2919
#  if (MailScanner::Config::Value('hideworkdir', $this)) {
2474
3037
 
2475
3038
  # Work out the list of all the infected attachments, including
2476
3039
  # reports applying to the whole message
2477
 
  my($attach, $text, %infected, $filename, $from, $subject);
 
3040
  my($attach, $text, %infected, $filename, $from, $subject, $id);
2478
3041
  while (($attach, $text) = each %{$this->{allreports}}) {
2479
3042
    # It affects the entire message if the entity of this file matches
2480
3043
    # the entity of the entire message.
2492
3055
    $infected{MailScanner::Config::LanguageValue($this, 'notnamed')} = 1;
2493
3056
  }
2494
3057
  $filename = join(', ', keys %infected);
 
3058
  $id = $this->{id};
2495
3059
  $from = $this->{from};
2496
3060
  $subject = $this->{subject};
2497
3061
 
2715
3279
    $this->DeliverModifiedBody('cleanheader');
2716
3280
  } else {
2717
3281
    #print STDERR "Body not modified\n";
2718
 
    $this->DeliverUnmodifiedBody('cleanheader');
 
3282
    if (MailScanner::Config::Value('virusscan', $this) =~ /1/) {
 
3283
      #print STDERR "Message is scanned and clean\n";
 
3284
      $this->DeliverUnmodifiedBody('cleanheader');
 
3285
    } else {
 
3286
      #print STDERR "Message is unscanned\n";
 
3287
      $this->DeliverUnmodifiedBody('unscannedheader');
 
3288
    }
2719
3289
  }
2720
3290
}
2721
3291
 
2729
3299
 
2730
3300
  return if $this->{deleted}; # This should never happen
2731
3301
 
 
3302
  # Prune the entity tree to remove all undef values
 
3303
  PruneEntityTree($this->{entity},$this->{entity2file},$this->{file2entity});
 
3304
 
2732
3305
  #print STDERR "Delivering Unmodified Body message\n";
2733
3306
 
2734
3307
  my $OutQ = MailScanner::Config::Value('outqueuedir', $this);
2743
3316
  #$global::MS->{mta}->AddHeadersToQf($this, $this->{entity}->stringify_header);
2744
3317
  $global::MS->{mta}->AddHeadersToQf($this);
2745
3318
 
 
3319
  # Remove duplicate subject: lines
 
3320
  $global::MS->{mta}->UniqHeader($this, 'Subject:');
 
3321
 
2746
3322
  # Add the information/help X- header
2747
3323
  my $infoheader = MailScanner::Config::Value('infoheader', $this);
2748
3324
  if ($infoheader) {
2782
3358
  $minstars = MailScanner::Config::Value('minstars', $this);
2783
3359
  $starcount = $minstars if $this->{isrblspam} && $minstars &&
2784
3360
                            $starcount<$minstars;
 
3361
  if (MailScanner::Config::Value('spamscorenotstars', $this)) {
 
3362
    $stars = $scoretext; # int($starcount);
 
3363
  } else {
 
3364
    $starcount = 60 if $starcount>60;
 
3365
    $stars = MailScanner::Config::Value('spamstarscharacter') x $starcount;
 
3366
  }
2785
3367
  if (MailScanner::Config::Value('spamstars', $this) =~ /1/ && $starcount>0) {
2786
 
    if (MailScanner::Config::Value('spamscorenotstars', $this)) {
2787
 
      $stars = $scoretext; # int($starcount);
2788
 
    } else {
2789
 
      $starcount = 60 if $starcount>60;
2790
 
      $stars = MailScanner::Config::Value('spamstarscharacter') x $starcount;
2791
 
    }
2792
3368
    $global::MS->{mta}->AddMultipleHeader($this, 'spamstarsheader',
2793
3369
                                          $stars, ', ');
2794
3370
  }
2800
3376
  $global::MS->{mta}->ReplaceHeader($this, 'Subject:', $this->{safesubject})
2801
3377
    if $this->{subjectwasunsafe};
2802
3378
 
 
3379
  # Modify the subject line for Disarming
 
3380
  my $subjectchanged = 0;
 
3381
  my $disarmtag = MailScanner::Config::Value('disarmsubjecttext',$this);
 
3382
  my $phishingtag = MailScanner::Config::Value('phishingsubjecttag', $this);
 
3383
  if ($this->{messagedisarmed}) {
 
3384
    #print STDERR "Found messagedisarmed = " . join(',',@{$this->{disarmedtags}}) . "\n";
 
3385
    if(MailScanner::Config::Value('disarmprependsubject',$this) =~ /1/ &&
 
3386
       !$global::MS->{mta}->TextStartsHeader($this, 'Subject:', $disarmtag)) {
 
3387
     $global::MS->{mta}->PrependHeader($this, 'Subject:', $disarmtag, ' ');
 
3388
     $subjectchanged = 1;
 
3389
    }
 
3390
    if (grep /phishing/i, @{$this->{disarmedtags}}) {
 
3391
      #print STDERR "Found a phishing disarmedtags\n";
 
3392
      # We found it had a phishing link in it. Are we tagging phishing Subject?
 
3393
      if (MailScanner::Config::Value('tagphishingsubject',$this) =~ /1/ &&
 
3394
          !$global::MS->{mta}->TextStartsHeader($this, 'Subject:', $phishingtag)
 
3395
) {
 
3396
        $global::MS->{mta}->PrependHeader($this, 'Subject:', $phishingtag, ' ');
 
3397
        $subjectchanged = 1;
 
3398
      }
 
3399
    }
 
3400
  }
 
3401
 
2803
3402
  # Modify the subject line for spam
2804
3403
  # if it's spam AND they want to modify the subject line AND it's not
2805
3404
  # already been modified by another of your MailScanners.
2806
 
  my $subjectchanged = 0;
2807
3405
  my $spamtag = MailScanner::Config::Value('spamsubjecttext', $this);
2808
3406
  $spamtag =~ s/_SCORE_/$scoretext/;
 
3407
  $spamtag =~ s/_STARS_/$stars/i;
2809
3408
  if ($this->{isspam} && !$this->{ishigh} &&
2810
3409
      MailScanner::Config::Value('spamprependsubject',$this) &&
2811
3410
      !$global::MS->{mta}->TextStartsHeader($this, 'Subject:', $spamtag)) {
2815
3414
  # If it is high-scoring spam, then add a different bit of text
2816
3415
  $spamtag = MailScanner::Config::Value('highspamsubjecttext', $this);
2817
3416
  $spamtag =~ s/_SCORE_/$scoretext/;
 
3417
  $spamtag =~ s/_STARS_/$stars/i;
2818
3418
  if ($this->{isspam} && $this->{ishigh} &&
2819
3419
      MailScanner::Config::Value('highspamprependsubject',$this) &&
2820
3420
      !$global::MS->{mta}->TextStartsHeader($this, 'Subject:', $spamtag)) {
2836
3436
      MailScanner::Config::Value('mcpprependsubject',$this) &&
2837
3437
      !$global::MS->{mta}->TextStartsHeader($this, 'Subject:', $mcptag)) {
2838
3438
    $global::MS->{mta}->PrependHeader($this, 'Subject:', $mcptag, ' ');
 
3439
    $subjectchanged = 1;
2839
3440
  }
2840
3441
  # If it is high-scoring MCP, then add a different bit of text
2841
3442
  $mcptag = MailScanner::Config::Value('highmcpsubjecttext', $this);
2844
3445
      MailScanner::Config::Value('highmcpprependsubject',$this) &&
2845
3446
      !$global::MS->{mta}->TextStartsHeader($this, 'Subject:', $mcptag)) {
2846
3447
    $global::MS->{mta}->PrependHeader($this, 'Subject:', $mcptag, ' ');
 
3448
    $subjectchanged = 1;
2847
3449
  }
2848
3450
 
2849
3451
  # Modify the subject line for scanning -- but only do it if the
2853
3455
  if ($modifscan eq 'start' && !$subjectchanged &&
2854
3456
      !$global::MS->{mta}->TextStartsHeader($this, 'Subject:', $scantag)) {
2855
3457
    $global::MS->{mta}->PrependHeader($this, 'Subject:', $scantag, ' ');
 
3458
    $subjectchanged = 1;
2856
3459
  } elsif ($modifscan eq 'end' && !$subjectchanged &&
2857
3460
      !$global::MS->{mta}->TextEndsHeader($this, 'Subject:', $scantag)) {
2858
3461
    $global::MS->{mta}->AppendHeader($this, 'Subject:', $scantag, ' ');
 
3462
    $subjectchanged = 1;
2859
3463
  }
2860
3464
 
2861
3465
  # Remove any headers we don't want in the message
2925
3529
    return;
2926
3530
  }
2927
3531
 
 
3532
  # Prune the entity tree to remove all undef values
 
3533
  #PruneEntityTree($this->{entity},$this->{entity2file},$this->{file2entity});
 
3534
  PruneEntityTree($entity,$this->{entity2file},$this->{file2entity});
 
3535
 
2928
3536
  my $OutQ = MailScanner::Config::Value('outqueuedir', $this);
2929
3537
 
2930
3538
  # Write the new body file
2931
3539
  #print STDERR "Writing the MIME body of $this, " . $this->{id} . "\n";
2932
3540
  $store->WriteMIMEBody($this->{id}, $entity, $OutQ);
 
3541
  #print STDERR "Written the MIME body\n";
2933
3542
 
2934
3543
  # Set up the output envelope with its (possibly modified) headers
2935
3544
  $global::MS->{mta}->AddHeadersToQf($this, $this->{entity}->stringify_header);
2936
3545
 
 
3546
  # Remove duplicate subject: lines
 
3547
  $global::MS->{mta}->UniqHeader($this, 'Subject:');
 
3548
 
2937
3549
  # Add the information/help X- header
2938
3550
  my $infoheader = MailScanner::Config::Value('infoheader', $this);
2939
3551
  if ($infoheader) {
2944
3556
  # Add the clean/dirty header
2945
3557
  #print STDERR "Adding clean/dirty header $headervalue\n";
2946
3558
  $global::MS->{mta}->AddMultipleHeader($this, 'mailheader',
2947
 
               MailScanner::Config::Value($headervalue, $this), ', ');
 
3559
               MailScanner::Config::Value($headervalue, $this), ', ');
2948
3560
 
2949
3561
  # Delete all content length headers as the body has been modified.
2950
3562
  $global::MS->{mta}->DeleteHeader($this, 'Content-length:');
2951
3563
 
2952
3564
  # Add the MCP header if necessary
2953
3565
  $global::MS->{mta}->AddMultipleHeader($this, 'mcpheader',
2954
 
                                        $this->{mcpreport}, ', ')
 
3566
                                        $this->{mcpreport}, ', ')
2955
3567
    if $this->{ismcp} ||
2956
3568
       MailScanner::Config::Value('includemcpheader', $this);
2957
3569
 
2960
3572
  #                              MailScanner::Config::Value('spamheader',$this),
2961
3573
  #                              $this->{spamreport})
2962
3574
  $global::MS->{mta}->AddMultipleHeader($this, 'spamheader',
2963
 
                                        $this->{spamreport}, ', ')
 
3575
                                        $this->{spamreport}, ', ')
2964
3576
    if $this->{isspam} ||
2965
3577
       MailScanner::Config::Value('includespamheader', $this);
2966
3578
 
2974
3586
  $scoretext = sprintf($scorefmt, $this->{sascore}+0);
2975
3587
  $minstars = MailScanner::Config::Value('minstars', $this);
2976
3588
  $starcount = $minstars if $this->{isrblspam} && $minstars &&
2977
 
                            $starcount<$minstars;
 
3589
                            $starcount<$minstars;
 
3590
  if (MailScanner::Config::Value('spamscorenotstars', $this)) {
 
3591
    $stars = $scoretext; # int($starcount);
 
3592
  } else {
 
3593
    $starcount = 60 if $starcount>60;
 
3594
    $stars = MailScanner::Config::Value('spamstarscharacter') x $starcount;
 
3595
  }
2978
3596
  if (MailScanner::Config::Value('spamstars', $this) =~ /1/ && $starcount>0) {
2979
 
    if (MailScanner::Config::Value('spamscorenotstars', $this)) {
2980
 
      $stars = $scoretext; # int($starcount);
2981
 
    } else {
2982
 
      $starcount = 60 if $starcount>60;
2983
 
      $stars = MailScanner::Config::Value('spamstarscharacter') x $starcount;
2984
 
    }
2985
3597
    $global::MS->{mta}->AddMultipleHeader($this, 'spamstarsheader',
2986
 
                                          $stars, ', ');
 
3598
                                          $stars, ', ');
2987
3599
  }
2988
3600
 
2989
3601
  # Add the Envelope to and from headers
3025
3637
    my $virustag = MailScanner::Config::Value('virussubjecttext', $this);
3026
3638
    #print STDERR "I am infected\n" if $this->{infected};
3027
3639
    if ($this->{infected} &&
3028
 
        MailScanner::Config::Value('virusprependsubject',$this) &&
3029
 
        !$global::MS->{mta}->TextStartsHeader($this, 'Subject:', $virustag)) {
 
3640
        MailScanner::Config::Value('virusprependsubject',$this) &&
 
3641
        !$global::MS->{mta}->TextStartsHeader($this, 'Subject:', $virustag)) {
3030
3642
      $global::MS->{mta}->PrependHeader($this, 'Subject:', $virustag, ' ');
3031
3643
      $subjectchanged = 1;
3032
3644
    }
3033
3645
  }
3034
3646
 
 
3647
  # Modify the subject line for Disarming
 
3648
  my $disarmtag = MailScanner::Config::Value('disarmsubjecttext',$this);
 
3649
  my $phishingtag = MailScanner::Config::Value('phishingsubjecttag', $this);
 
3650
  if ($this->{messagedisarmed}) { 
 
3651
    #print STDERR "Found messagedisarmed = " . join(',',@{$this->{disarmedtags}}) . "\n";
 
3652
    if(MailScanner::Config::Value('disarmprependsubject',$this) =~ /1/ &&
 
3653
       !$global::MS->{mta}->TextStartsHeader($this, 'Subject:', $disarmtag)) {
 
3654
     $global::MS->{mta}->PrependHeader($this, 'Subject:', $disarmtag, ' ');
 
3655
     $subjectchanged = 1;
 
3656
    }
 
3657
    if (grep /phishing/i, @{$this->{disarmedtags}}) {
 
3658
      #print STDERR "Found phishing disarmedtags2\n";
 
3659
      # We found it had a phishing link in it. Are we tagging phishing Subject?
 
3660
      if (MailScanner::Config::Value('tagphishingsubject',$this) =~ /1/ &&
 
3661
          !$global::MS->{mta}->TextStartsHeader($this, 'Subject:', $phishingtag)) {
 
3662
        $global::MS->{mta}->PrependHeader($this, 'Subject:', $phishingtag, ' ');
 
3663
        $subjectchanged = 1;
 
3664
      }
 
3665
    }
 
3666
  }
 
3667
 
 
3668
 
3035
3669
  # Modify the subject line for spam
3036
3670
  # if it's spam AND they want to modify the subject line AND it's not
3037
3671
  # already been modified by another of your MailScanners.
3038
3672
  my $spamtag = MailScanner::Config::Value('spamsubjecttext', $this);
3039
3673
  $spamtag =~ s/_SCORE_/$scoretext/;
 
3674
  $spamtag =~ s/_STARS_/$stars/i;
3040
3675
  if ($this->{isspam} && !$this->{ishigh} &&
3041
 
      MailScanner::Config::Value('spamprependsubject',$this) &&
3042
 
      !$global::MS->{mta}->TextStartsHeader($this, 'Subject:', $spamtag)) {
 
3676
              MailScanner::Config::Value('spamprependsubject',$this) &&
 
3677
              !$global::MS->{mta}->TextStartsHeader($this, 'Subject:', $spamtag)) {
3043
3678
    $global::MS->{mta}->PrependHeader($this, 'Subject:', $spamtag, ' ');
3044
3679
    $subjectchanged = 1;
3045
3680
  }
3046
3681
  # If it is high-scoring spam, then add a different bit of text
3047
3682
  $spamtag = MailScanner::Config::Value('highspamsubjecttext', $this);
3048
3683
  $spamtag =~ s/_SCORE_/$scoretext/;
 
3684
  $spamtag =~ s/_STARS_/$stars/i;
3049
3685
  if ($this->{isspam} && $this->{ishigh} &&
3050
3686
      MailScanner::Config::Value('highspamprependsubject',$this) &&
3051
3687
      !$global::MS->{mta}->TextStartsHeader($this, 'Subject:', $spamtag)) {
3067
3703
      MailScanner::Config::Value('mcpprependsubject',$this) &&
3068
3704
      !$global::MS->{mta}->TextStartsHeader($this, 'Subject:', $mcptag)) {
3069
3705
    $global::MS->{mta}->PrependHeader($this, 'Subject:', $mcptag, ' ');
 
3706
    $subjectchanged = 1;
3070
3707
  }
3071
3708
  # If it is high-scoring MCP, then add a different bit of text
3072
3709
  $mcptag = MailScanner::Config::Value('highmcpsubjecttext', $this);
3075
3712
      MailScanner::Config::Value('highmcpprependsubject',$this) &&
3076
3713
      !$global::MS->{mta}->TextStartsHeader($this, 'Subject:', $mcptag)) {
3077
3714
    $global::MS->{mta}->PrependHeader($this, 'Subject:', $mcptag, ' ');
 
3715
    $subjectchanged = 1;
3078
3716
  }
3079
3717
 
3080
3718
  # Modify the subject line for scanning -- but only do it if the
3131
3769
}
3132
3770
 
3133
3771
 
 
3772
# Prune all the undef branches out of an entity tree
 
3773
sub PruneEntityTree {
 
3774
  my ($entity,$entity2file,$file2entity) = @_;
 
3775
 
 
3776
  #print STDERR "Pruning $entity\n";
 
3777
  return undef unless $entity;
 
3778
  return $entity unless $entity->parts;
 
3779
 
 
3780
  my(@newparts, $part, $newpart, $counter);
 
3781
 
 
3782
  # Do a pre-traversal depth-first search of the tree
 
3783
  #print STDERR "Looking at $entity\n";
 
3784
  foreach $part ($entity->parts) {
 
3785
    #$counter++;
 
3786
    #print STDERR "$counter Going down to $part\n";
 
3787
    next unless $part;
 
3788
    #print STDERR "Non null $part\n";
 
3789
    $newpart = PruneEntityTree($part,$entity2file,$file2entity);
 
3790
    #$newpart = $newpart?PruneEntityTree($part,$entity2file,$file2entity):$part;
 
3791
    #print STDERR "Replacement is $newpart\n";
 
3792
    if ($newpart) {
 
3793
      #print STDERR "Adding replacement $newpart\n";
 
3794
      push @newparts, $newpart;
 
3795
      #print STDERR "Newparts = " . join(',',@newparts) . "\n";
 
3796
    #} else {
 
3797
    #  my $file = $entity2file->{$newpart} if $entity2file;
 
3798
    #  delete $entity2file->{$newpart} if $entity2file && $file;
 
3799
    #  delete $file2entity->{$file} if $file2entity && $file;
 
3800
    }
 
3801
    #print STDERR "Coming up, added $newpart\n";
 
3802
  }
 
3803
 
 
3804
  #print STDERR "About to return\n";
 
3805
  # Keep all the parts we found, prune as much as we can
 
3806
  if (@newparts) {
 
3807
    #print STDERR "Returning entity $entity with " . join(',',@newparts) . "\n";
 
3808
    $entity->parts(\@newparts);
 
3809
    return $entity;
 
3810
  } else {
 
3811
    #print STDERR "Returning undef\n";
 
3812
    return undef;
 
3813
  }
 
3814
}
 
3815
 
 
3816
 
3134
3817
# Delete a message from the incoming queue
3135
3818
sub DeleteMessage {
3136
3819
  my $this = shift;
3170
3853
  my(@noisyin) = split(" ",MailScanner::Config::Value('noisyviruses', $this));
3171
3854
  my($noisy, $noisyin, @noisy, $nregexp);
3172
3855
 
 
3856
  #print "-1 Silentin = \"" . join(',',@silentin) . "\"\n";
 
3857
  #print "-1 Noisy in = \"" . join(',',@noisyin) . "\"\n";
 
3858
 
3173
3859
  # Get out quickly if there's nothing to do
3174
3860
  return unless @silentin || @noisyin;
3175
3861
 
3215
3901
  }
3216
3902
  $this->{noisy}  = 1 if $nregexp && grep /$nregexp/i,
3217
3903
                                          values %{$this->{allreports}};
 
3904
  #print STDERR "0 regexp = $nregexp and search = \"" . join('","',values %{$this->{allreports}}) . "\"\n";
 
3905
 
 
3906
  #print STDERR "1 FindSilentInfection: Found it!\n" if $this->{silent};
 
3907
  #print STDERR "1 FindNoisyInfection: Found it!\n" if $this->{noisy};
3218
3908
 
3219
3909
  return unless MailScanner::Config::Value('logsilentviruses', $this);
3220
3910
 
3224
3914
  MailScanner::Log::InfoLog("Viruses marked as silent: %s", $logstring)
3225
3915
    if $logstring;
3226
3916
 
3227
 
  #print STDERR "FindSilentInfection: Found it!\n" if $this->{silent};
3228
 
  #print STDERR "FindNoisyInfection: Found it!\n" if $this->{noisy};
 
3917
  #print STDERR "2 FindSilentInfection: Found it!\n" if $this->{silent};
 
3918
  #print STDERR "2 FindNoisyInfection: Found it!\n" if $this->{noisy};
3229
3919
}
3230
3920
 
3231
3921
 
3247
3937
  my $this = shift;
3248
3938
 
3249
3939
  my($from,$to,$subject,$date,$allreports,$alltypes,$report,$type);
3250
 
  my($entityreports, @everyreport, $entitytypes, @everytype);
 
3940
  my($entityreports, @everyreportin, $entitytypes, @everytype);
3251
3941
  my($emailmsg, $line, $messagefh, $msgname, $localpostmaster, $id);
3252
 
  my($hostname);
 
3942
  my($hostname, $postmastername);
3253
3943
 
3254
3944
  # Do we want to send the sender a warning at all?
3255
3945
  # If nosenderprecedence is set to non-blank and contains this
3281
3971
  $id = $this->{id};
3282
3972
  #$to = join(', ', @{$this->{to}});
3283
3973
  $localpostmaster = MailScanner::Config::Value('localpostmaster', $this);
 
3974
  $postmastername  = MailScanner::Config::LanguageValue($this, 'mailscanner');
3284
3975
  $hostname = MailScanner::Config::Value('hostname', $this);
3285
3976
  $subject = $this->{subject};
3286
 
  $date = scalar localtime;
 
3977
  $date = $this->{datestring}; # scalar localtime;
3287
3978
 
3288
3979
  my($to, %tolist);
3289
3980
  foreach $to (@{$this->{to}}) {
3293
3984
 
3294
3985
  $allreports    = $this->{allreports};
3295
3986
  $entityreports = $this->{entityreports};
3296
 
  push @everyreport, values %$allreports;
3297
 
  push @everyreport, values %$entityreports;
 
3987
  push @everyreportin, values %$allreports;
 
3988
  push @everyreportin, values %$entityreports;
3298
3989
  my $reportword = MailScanner::Config::LanguageValue($this, "report");
3299
 
  $report = join($reportword . ': ', @everyreport);
 
3990
  my($reportline, @everyreport);
 
3991
  foreach $reportline (@everyreportin) {
 
3992
    push @everyreport, map { ((/^$reportword: /m)?$_:"$reportword: $_") . "\n" }
 
3993
                           split(/\n/, $reportline);
 
3994
  }
 
3995
  #print STDERR "Reports are \"" . join('", "', @everyreport) . "\"\n";
 
3996
  #$report = join('', @everyreport);
 
3997
  my %seen = ();
 
3998
  $report = join('', grep { ! $seen{$_} ++ } @everyreport);
 
3999
  #print STDERR "***Report to sender is***\n$report***END***\n";
3300
4000
  
3301
4001
  $alltypes    = $this->{alltypes};
3302
4002
  $entitytypes = $this->{entitytypes};
3408
4108
  my $from = $this->{from};
3409
4109
  #my $to   = join(', ', @{$this->{to}});
3410
4110
  my $subj = $this->{subject};
 
4111
  my $ip   = $this->{clientip};
3411
4112
  my $rept = join("    $reportword: ", @everyrept);
3412
 
  my $ip   = $this->{clientip};
 
4113
  #print STDERR "Rept is\n$rept\n";
 
4114
 
 
4115
  # Build list of unique archive and quarantine storage locations
 
4116
  my @quarantines = grep /\//, @{$this->{archiveplaces}};
 
4117
  push @quarantines, grep /\//, @{$this->{quarantineplaces}};
 
4118
  my($quarantine, %quarantinelist);
 
4119
  foreach $quarantine (@quarantines) {
 
4120
    $quarantinelist{$quarantine} = 1;
 
4121
  }
 
4122
  $quarantine = join(', ', sort keys %quarantinelist);
3413
4123
 
3414
4124
  # Build unique list of recipients. Avoids Postfix problem which has
3415
4125
  # separate lists of real recipients and original recipients.
3436
4146
            " Recipient: $to\n" .
3437
4147
            "   Subject: $subj\n" .
3438
4148
            " MessageID: $id\n" .
 
4149
            "Quarantine: $quarantine\n" .
3439
4150
            "$reportword: $rept\n";
3440
4151
 
3441
4152
  if (MailScanner::Config::Value('noticefullheaders', $this)) {
3492
4203
  my(@files) = @_;
3493
4204
 
3494
4205
  my($MaxSubjectLength, $from, $to, $subject, $newsubject, $top);
3495
 
  my($localpostmaster);
 
4206
  my($localpostmaster, $postmastername);
3496
4207
  $MaxSubjectLength  = 25;
3497
4208
  $from = $this->{from};
3498
4209
  #$to   = join(', ', @{$this->{to}});
3504
4215
 
3505
4216
  $subject = $this->{subject};
3506
4217
  $localpostmaster = MailScanner::Config::Value('localpostmaster', $this);
 
4218
  $postmastername  = MailScanner::Config::LanguageValue($this, 'mailscanner');
3507
4219
 
3508
4220
  $newsubject = MailScanner::Config::LanguageValue($this, 'disinfected') .
3509
4221
                ": " . substr($subject, 0, $MaxSubjectLength);
3514
4226
 
3515
4227
  # Create the top-level MIME entity, just the headers
3516
4228
  $top = MIME::Entity->build(Type       => 'multipart/mixed',
3517
 
                             From       => "MailScanner <$localpostmaster>",
 
4229
                             From       => "$postmastername <$localpostmaster>",
3518
4230
                             To         => $to,
3519
4231
                             Subject    => $newsubject,
3520
4232
                             'X-Mailer' => 'MailScanner',
3566
4278
  my($dir, $todaydir, $target, $didanything);
3567
4279
  $didanything = 0;
3568
4280
 
3569
 
  $todaydir = MailScanner::Quarantine::TodayDir();
 
4281
  $todaydir = $this->{datenumber}; #MailScanner::Quarantine::TodayDir();
3570
4282
 
3571
4283
  foreach $dir (@{$this->{archiveplaces}}) {
3572
4284
    #print STDERR "Archive to $dir\n";
3671
4383
 
3672
4384
# Disarm some of the HTML tags in this message.
3673
4385
my($DisarmFormTag, $DisarmScriptTag, $DisarmCodebaseTag, $DisarmIframeTag,
3674
 
   $DisarmWebBug, $DisarmPhishing, $DisarmPhishingFound);
 
4386
   $DisarmWebBug, $DisarmPhishing, $DisarmNumbers, $DisarmHTMLChangedMessage,
 
4387
   $DisarmWebBugFound, $DisarmPhishingFound, $PhishingSubjectTag,
 
4388
   $PhishingHighlight);
3675
4389
sub DisarmHTML {
3676
4390
  my $this = shift;
3677
4391
 
3678
4392
  #print STDERR "Tags to convert are " . $this->{tagstoconvert} . "\n";
3679
4393
 
3680
4394
  # Set the disarm booleans for this message
 
4395
  $DisarmFormTag     = 0;
 
4396
  $DisarmScriptTag   = 0;
 
4397
  $DisarmCodebaseTag = 0;
 
4398
  $DisarmCodebaseTag = 0;
 
4399
  $DisarmIframeTag   = 0;
 
4400
  $DisarmWebBug      = 0;
 
4401
  $DisarmPhishing    = 0;
 
4402
  $DisarmNumbers     = 0;
 
4403
  $DisarmWebBugFound = 0;
 
4404
  $PhishingSubjectTag= 0;
 
4405
  $PhishingHighlight = 0;
3681
4406
  $DisarmFormTag     = 1 if $this->{tagstoconvert} =~ /form/i;
3682
4407
  $DisarmScriptTag   = 1 if $this->{tagstoconvert} =~ /script/i;
3683
4408
  $DisarmCodebaseTag = 1 if $this->{tagstoconvert} =~ /codebase/i;
3684
4409
  $DisarmCodebaseTag = 1 if $this->{tagstoconvert} =~ /data/i;
3685
4410
  $DisarmIframeTag   = 1 if $this->{tagstoconvert} =~ /iframe/i;
3686
4411
  $DisarmWebBug      = 1 if $this->{tagstoconvert} =~ /webbug/i;
 
4412
  $PhishingSubjectTag= 1
 
4413
    if MailScanner::Config::Value('tagphishingsubject', $this) =~ /1/;
 
4414
  #print STDERR "PhishingSubjectTag = $PhishingSubjectTag\n";
 
4415
  $PhishingHighlight = 1
 
4416
    if MailScanner::Config::Value('phishinghighlight', this) =~ /1/;
 
4417
  #print STDERR "PhishingHighlight = $PhishingHighlight\n";
 
4418
  $DisarmPhishingFound = 0;
 
4419
  $DisarmHTMLChangedMessage = 0;
3687
4420
  if (MailScanner::Config::Value('findphishing', $this) =~ /1/) {
3688
4421
    $DisarmPhishing = 1;
3689
 
    $DisarmPhishingFound = 0;
 
4422
    $DisarmNumbers = 1
 
4423
      if MailScanner::Config::Value('phishingnumbers', $this) =~ /1/;
3690
4424
  }
3691
4425
 
3692
 
  $this->DisarmHTMLTree($this->{entity});
 
4426
  my($counter, @disarmedtags);
 
4427
  ($counter, @disarmedtags) = $this->DisarmHTMLTree($this->{entity});
 
4428
  #print STDERR "disarmedtags = ". join(', ', @disarmedtags) . "\n";
 
4429
 
 
4430
  # If the HTML checks found a real problem or there really was a phishing
 
4431
  # attack, only then should we log anything.
 
4432
  @disarmedtags = ('phishing') if $DisarmPhishingFound && !@disarmedtags;
 
4433
  #print STDERR "Found DisarmPhishingFound\n" if $DisarmPhishingFound;
 
4434
  MailScanner::Log::InfoLog('Content Checks: Detected and have disarmed ' .
 
4435
                            join(', ', @disarmedtags) . ' tags in ' .
 
4436
                            'HTML message in %s from %s',
 
4437
                            $this->{id}, $this->{from})
 
4438
    if $DisarmHTMLChangedMessage || $DisarmPhishingFound;
3693
4439
 
3694
4440
  # And save the results from the phishing trip
3695
4441
  if ($DisarmPhishingFound) {
3696
4442
    # Do we want this or not? I say no. $this->{otherinfected} = 1;
3697
 
    $this->{bodymodified}  = 1;
3698
 
  }
 
4443
    $this->{bodymodified} = 1;
 
4444
  }
 
4445
  if ($DisarmHTMLChangedMessage) {
 
4446
    #print STDERR "Disarm Changed the message\n";
 
4447
    $this->{bodymodified} = 1;
 
4448
    $this->{messagedisarmed} = 1;
 
4449
  } else {
 
4450
    $this->{messagedisarmed} = 0;
 
4451
  }
 
4452
  # Store all the tags we disarmed
 
4453
  #print STDERR "Storing " . join(',', @disarmedtags) . "\n";
 
4454
  @{$this->{disarmedtags}} = @disarmedtags;
3699
4455
}
3700
4456
 
3701
4457
 
3795
4551
  my($messagefh, $filename, $emailmsg, $line, $charset);
3796
4552
  my($id, $to, $from, $localpostmaster, $hostname, $subject, $date);
3797
4553
  my($fullspamreport, $briefspamreport, $longspamreport, $sascore);
 
4554
  my($postmastername);
3798
4555
 
3799
4556
  # For now, if there is no entity structure at all then just return,
3800
4557
  # we cannot encapsulate a message without it.
3805
4562
  # everything anyway.
3806
4563
  # Workaround: Instead of using "Virus Scanning = no", use
3807
4564
  # "Virus Scanners = none" and a set of filename rules that pass all files.
3808
 
  $entity = $this->{entity} or return;
 
4565
  return unless $this->{entity};
3809
4566
 
3810
4567
  # Construct the RFC822 attachment
3811
 
  $mimeversion = $entity->head->get('mime-version');
 
4568
  $mimeversion = $this->{entity}->head->get('mime-version');
 
4569
  # Prune all the dead branches off the tree
 
4570
  PruneEntityTree($this->{entity},$this->{entity2file},$this->{file2entity});
 
4571
  $entity = $this->{entity};
3812
4572
  $rfc822 = $entity->stringify;
3813
4573
 
3814
4574
  # Setup variables they can use in the spam report that is inserted at
3823
4583
 
3824
4584
  $from = $this->{from};
3825
4585
  $localpostmaster = MailScanner::Config::Value('localpostmaster', $this);
 
4586
  $postmastername  = MailScanner::Config::LanguageValue($this, 'mailscanner');
3826
4587
  $hostname = MailScanner::Config::Value('hostname', $this);
3827
4588
  $subject = $this->{subject};
3828
 
  $date = scalar localtime;
 
4589
  $date = $this->{datestring}; # scalar localtime;
3829
4590
  $fullspamreport = $this->{spamreport};
3830
4591
  $longspamreport = $this->{salongreport};
3831
4592
  $sascore = $this->{sascore};
3899
4660
sub DisarmHTMLTree {
3900
4661
  my($this, $entity) = @_;
3901
4662
 
3902
 
  my $counter; # Have we modified this message at all?
 
4663
  my $counter = 0; # Have we modified this message at all?
 
4664
  my @disarmed; # List of tags we have disarmed
3903
4665
 
3904
4666
  #print STDERR "Disarming HTML Tree\n";
3905
4667
 
3909
4671
  if ($entity->head->mime_attr('content-disposition') !~ /attachment/i &&
3910
4672
      $entity->head->mime_attr('content-type')        =~ /text\/html/i) {
3911
4673
    #print STDERR "Found text/html message at entity $entity\n";
3912
 
    $this->DisarmHTMLEntity($entity);
3913
 
    MailScanner::Log::InfoLog('Content Checks: Detected and will disarm ' .
3914
 
                              'HTML message in %s', $this->{id});
3915
 
    $this->{bodymodified} = 1; # No infection but we changed the MIIME tree
3916
 
    #$this->{otherreports}{""} .= "Converted HTML to plain text\n";
3917
 
    #$this->{othertypes}{""} .= "m"; # Modified body, but no infection
3918
 
    #$this->{otherinfected}++;
3919
 
    $counter++;
 
4674
    @disarmed = $this->DisarmHTMLEntity($entity);
 
4675
    #print STDERR "Disarmed = " . join(', ',@disarmed) . "\n";
 
4676
    if (@disarmed) {
 
4677
      $this->{bodymodified} = 1;
 
4678
      $DisarmHTMLChangedMessage = 1;
 
4679
      $counter++;
 
4680
    }
3920
4681
  }
3921
4682
 
3922
4683
  # Now try the same on all the parts
3923
 
  my(@parts, $part);
 
4684
  my(@parts, $part, $newcounter, @newtags);
3924
4685
  @parts = $entity->parts;
3925
4686
  foreach $part (@parts) {
3926
 
    $counter += $this->DisarmHTMLTree($part);
 
4687
    ($newcounter, @newtags) = $this->DisarmHTMLTree($part);
 
4688
    $counter += $newcounter;
 
4689
    @disarmed = (@disarmed, @newtags);
3927
4690
  }
3928
4691
 
3929
 
  return $counter;
 
4692
  #print STDERR "Returning " . join(', ', @disarmed) . " from DisarmHTMLTree\n";
 
4693
  return ($counter, @disarmed);
3930
4694
}
3931
4695
 
3932
4696
 
3971
4735
}
3972
4736
 
3973
4737
# HTML::Parset callback function for normal text
3974
 
my($DisarmLinkText, $DisarmLinkURL, $DisarmInsideLink);
 
4738
my(%DisarmDoneSomething, $DisarmLinkText, $DisarmLinkURL, $DisarmAreaURL,
 
4739
   $DisarmInsideLink, $DisarmBaseURL);
3975
4740
 
3976
4741
# Convert 1 MIME entity from html to dis-armed HTML using HTML::Parser.
3977
4742
sub DisarmHTMLEntity {
3985
4750
  # is inherited from old messages
3986
4751
  $DisarmLinkText   = "";
3987
4752
  $DisarmLinkURL    = "";
3988
 
  $DisarmInsideLink = "";
 
4753
  $DisarmInsideLink = 0;
 
4754
  $DisarmBaseURL    = "";
 
4755
  $DisarmAreaURL    = "";
 
4756
  %DisarmDoneSomething = ();
3989
4757
 
3990
4758
  # Replace the filename with a new one
3991
4759
  $oldname = $entity->bodyhandle->path();
3998
4766
  unless ($outfh->open(">$newname")) {
3999
4767
    MailScanner::Log::WarnLog('Could not create disarmed HTML file %s',
4000
4768
                              $newname);
4001
 
    return;
 
4769
    return keys %DisarmDoneSomething;
4002
4770
  }
4003
4771
 
4004
4772
  # Set default output filehandle so we generate the new HTML
4019
4787
    HTML::Parser->new(api_version => 3,
4020
4788
      start_h     => [\&DisarmTagCallback,    "tagname, text, attr, attrseq"],
4021
4789
      end_h       => [\&DisarmEndtagCallback, "tagname, text, '" . $this->{id} . "'"],
4022
 
      #end_h       => [\&DisarmEndtagCallback, "tagname, text"],
4023
4790
      default_h   => [ sub { print @_; },     "text"],
4024
4791
                   )
4025
4792
      ->parse_file($oldname)
4029
4796
 
4030
4797
  select $oldfh;
4031
4798
  $outfh->close();
 
4799
 
 
4800
  # Tell the caller if we did anything
 
4801
  #print STDERR "Keys are " . join(', ', keys %DisarmDoneSomething) . "\n";
 
4802
  return keys %DisarmDoneSomething;
4032
4803
}
4033
4804
 
4034
4805
# HTML::Parser callback for text so we can collect the contents of links
4037
4808
 
4038
4809
  unless ($DisarmInsideLink) {
4039
4810
    print $text;
 
4811
    #print STDERR "DisarmText just printed \"$text\"\n";
4040
4812
    return;
4041
4813
  }
4042
4814
 
4043
4815
  # We are inside a link.
4044
4816
  # Save the original text, we well might need it.
4045
4817
  $DisarmLinkText .= $text;
 
4818
  #print STDERR "DisarmText just added \"$text\"\n";
4046
4819
}
4047
4820
 
4048
4821
# HTML::Parser callback function for start tags
4057
4830
    #print "It's a form\n";
4058
4831
    $text = substr $text, 1;
4059
4832
    $output .= "<BR><MailScannerForm$$ " . $text;
 
4833
    $DisarmDoneSomething{'form'} = 1;
4060
4834
  } elsif ($tagname eq 'input' && $DisarmFormTag) {
4061
4835
    #print "It's an input button\n";
4062
4836
    $attr->{'type'} = "reset";
4066
4840
      $output .= ' ' . $_ . '="' . $attr->{$_} . '"';
4067
4841
    }
4068
4842
    $output .= '>';
 
4843
    $DisarmDoneSomething{'form input'} = 1;
4069
4844
  } elsif ($tagname eq 'button' && $DisarmFormTag) {
4070
4845
    #print "It's a button\n";
4071
4846
    $attr->{'type'} = "reset";
4075
4850
      $output .= ' ' . $_ . '="' . $attr->{$_} . '"';
4076
4851
    }
4077
4852
    $output .= '>';
 
4853
    $DisarmDoneSomething{'form button'} = 1;
4078
4854
  } elsif ($tagname eq 'object' && $DisarmCodebaseTag) {
4079
4855
    #print "It's an object\n";
4080
4856
    if (exists $attr->{'codebase'}) {
4081
4857
      $text = substr $text, 1;
4082
4858
      $output .= "<MailScannerObject$$ " . $text;
 
4859
      $DisarmDoneSomething{'object codebase'} = 1;
4083
4860
    } elsif (exists $attr->{'data'}) {
4084
4861
      $text = substr $text, 1;
4085
4862
      $output .= "<MailScannerObject$$ " . $text;
 
4863
      $DisarmDoneSomething{'object data'} = 1;
4086
4864
    } else {
4087
4865
      $output .= $text;
4088
4866
    }
4090
4868
    #print "It's an iframe\n";
4091
4869
    $text = substr $text, 1;
4092
4870
    $output .= "<MailScannerIFrame$$ " . $text;
 
4871
    $DisarmDoneSomething{'iframe'} = 1;
4093
4872
  } elsif ($tagname eq 'script' && $DisarmScriptTag) {
4094
4873
    #print "It's a script\n";
4095
4874
    $text = substr $text, 1;
4096
4875
    $output .= "<MailScannerScript$$ " . $text;
 
4876
    $DisarmDoneSomething{'script'} = 1;
4097
4877
  } elsif ($tagname eq 'a' && $DisarmPhishing) {
4098
4878
    #print STDERR "It's a link\n";
4099
4879
    $output .= $text;
4100
 
    $DisarmLinkText = '';
 
4880
    $DisarmLinkText = ''; # Reset state of automaton
 
4881
    $DisarmLinkURL = '';
4101
4882
    $DisarmLinkURL = $attr->{'href'} if exists $attr->{'href'};
4102
4883
    $DisarmInsideLink = 1;
 
4884
    $DisarmInsideLink = 0 if $text =~ /\/\>$/; # JKF Catch /> empty A tags
 
4885
    #print STDERR "DisarmInsideLink = $DisarmInsideLink\n";
4103
4886
  } elsif ($tagname eq 'img' && $DisarmWebBug) {
4104
 
    #print "It's an image\n";
 
4887
    #print STDERR "It's an image\n";
 
4888
    #print STDERR "The src is \"" . $attr->{'src'} . "\"\n";
4105
4889
    if (exists $attr->{'width'}  && $attr->{'width'}<=2 &&
4106
 
        exists $attr->{'height'} && $attr->{'height'}<=2) {
 
4890
        exists $attr->{'height'} && $attr->{'height'}<=2 &&
 
4891
        exists $attr->{'src'}    && $attr->{'src'} !~ /^cid:|^MailScannerWebBug/i) {
4107
4892
      $output .= '<img src="MailScannerWebBug" width="' . $attr->{'width'} .
4108
4893
            '" height="' . $attr->{'height'} . '" alt="';
4109
4894
      $output .= 'Web Bug from ' . $attr->{'src'} if $attr->{'src'};
4110
4895
      $output .= '" />';
 
4896
      $DisarmWebBugFound = 1;
 
4897
      $DisarmDoneSomething{'web bug'} = 1;
4111
4898
    } else {
4112
4899
      $output .= $text;
4113
4900
    }
 
4901
  } elsif ($tagname eq 'base') {
 
4902
    #print STDERR "It's a Base URL\n";
 
4903
    $output .= $text;
 
4904
    #print STDERR "Base URL = " . $attr->{'href'} . "\n";
 
4905
    $DisarmBaseURL = $attr->{'href'} if exists $attr->{'href'};
 
4906
  } elsif ($tagname eq 'area' && $DisarmInsideLink && $DisarmPhishing) {
 
4907
    #print STDERR "It's an imagemap area\n";
 
4908
    $output .= $text;
 
4909
    #print STDERR "Area URL = " . $attr->{'href'} . "\n";
 
4910
    $DisarmAreaURL = $attr->{'href'};
4114
4911
  } else {
4115
4912
    #print STDERR "The tag was a \"$tagname\"\n";
4116
4913
    $output .= $text;
 
4914
    #print STDERR "output text is now \"$output\"\n";
4117
4915
  }
 
4916
  # tagname DisarmPhishing
 
4917
  #    a     0               0 1
 
4918
  #    a     1               0 0 tagname=a && Disarm=1
 
4919
  #    b     0               1 1
 
4920
  #    b     1               1 0 
 
4921
  #if ($DisarmInsideLink && !($tagname eq 'a' && $DisarmPhishing)) {
4118
4922
  if ($DisarmInsideLink && ($tagname ne 'a' || !$DisarmPhishing)) {
4119
4923
    $DisarmLinkText .= $output;
 
4924
    #print STDERR "StartCallback: DisarmLinkText now equals \"$DisarmLinkText\"\n";
4120
4925
  } else {
4121
4926
    print $output;
 
4927
    #print STDERR "StartCallback: Printed2 \"$output\"\n";
4122
4928
  }
4123
4929
}
4124
4930
 
4128
4934
 
4129
4935
  if ($tagname eq 'iframe' && $DisarmIframeTag) {
4130
4936
    print "</MailScannerIFrame$$>";
 
4937
    $DisarmDoneSomething{'iframe'} = 1;
4131
4938
  } elsif ($tagname eq 'form' && $DisarmFormTag) {
4132
4939
    print "</MailScannerForm$$>";
 
4940
    $DisarmDoneSomething{'form'} = 1;
4133
4941
  } elsif ($tagname eq 'script' && $DisarmScriptTag) {
4134
4942
    print "</MailScannerScript$$>";
4135
 
  } elsif ($tagname eq 'a' && $DisarmPhishing) {
4136
 
    my($squashedtext,$linkurl);
 
4943
    $DisarmDoneSomething{'script'} = 1;
 
4944
  } elsif ($tagname eq 'map' && $DisarmAreaURL) {
 
4945
    # We are inside an imagemap that is part of a phishing imagemap
 
4946
    $DisarmLinkText .= '</map>';
 
4947
  } elsif ($tagname eq 'a' && $DisarmPhishing) { # && defined $attr->{'href'}) {
 
4948
    #print STDERR "Endtag Callback found link, disarmlinktext = \"$DisarmLinkText\"\n";
 
4949
    my($squashedtext,$linkurl,$alarm,$numbertrap);
4137
4950
    $DisarmInsideLink = 0;
4138
4951
    $squashedtext = lc($DisarmLinkText);
 
4952
    if ($DisarmAreaURL) {
 
4953
      $squashedtext = $DisarmLinkURL;
 
4954
      $DisarmLinkURL = lc($DisarmAreaURL);
 
4955
      $DisarmAreaURL = ""; # End of a link, so reset this
 
4956
    } else {
 
4957
      $squashedtext = lc($DisarmLinkText);
 
4958
    }
 
4959
 
 
4960
    # Try to filter out mentions of Microsoft's .NET system
 
4961
    $squashedtext = "" if $squashedtext eq ".net";
 
4962
    $squashedtext = "" if $squashedtext =~ /(^|\b)(ado|asp)\.net($|\b)/;
 
4963
 
4139
4964
    $squashedtext =~ s/\%a0//g;
4140
4965
    $squashedtext =~ s#%([0-9a-f][0-9a-f])#chr(hex('0x' . $1))#gei; # Unescape
4141
4966
    $squashedtext =~ s/\s+//g; # Remove any whitespace
4142
 
    $squashedtext =~ s/\\/\//g;
 
4967
    $squashedtext =~ s/\\/\//g; # Change \ to / as many browsers do this
 
4968
    $squashedtext =~ s/^\[\d*\]//; # Removing leading [numbers]
4143
4969
    $squashedtext =~ s/(\<\/?[^>]*\>)*//ig; # Remove tags
4144
 
    #$squashedtext =~ s/^(\<\/?(br|p|ul)\>)*//ig; # Remove leading br, p, ul tags
 
4970
    $squashedtext =~ s/^[^\/:]+\@//; # Remove username of email addresses
 
4971
    #$squashedtext =~ s/\&\w*\;//g; # Remove things like &lt; and &gt;
 
4972
    $squashedtext =~ s/\&lt\;/\</g; # Remove things like &lt; and &gt;
 
4973
    $squashedtext =~ s/\&gt\;/\>/g; # rEmove things like &lt; and &gt;
 
4974
    $squashedtext =~ s/./CharToIntnl("$&")/ge;
4145
4975
    #print STDERR "Text = \"$text\"\n";
4146
4976
    #print STDERR "1SquashedText = \"$squashedtext\"\n";
4147
4977
    #print STDERR "1LinkURL      = \"$DisarmLinkURL\"\n";
4148
4978
    # If it looks like a link, remove any leading https:// or ftp://
4149
 
    if ($squashedtext =~ /^(w+|ft+p|fpt+|ma[il]+to)([.,]|\%2e)/i || 
 
4979
    ($linkurl,$alarm) = CleanLinkURL($DisarmLinkURL);
 
4980
    #print STDERR "linkurl = $linkurl\nBefore If statement\n";
 
4981
    #print STDERR "squashedtext = $squashedtext\nBefore If statement\n";
 
4982
 
 
4983
    # Has it fallen foul of the numeric-ip phishing net? Must treat x
 
4984
    # like a digit so it catches 0x41 (= 'A')
 
4985
    $numbertrap = ($DisarmNumbers && $linkurl !~ /[<>g-wyz]+/)?1:0;
 
4986
 
 
4987
    if ($alarm ||
 
4988
        $squashedtext =~ /^(w+|ft+p|fpt+|ma[il]+to)([.,]|\%2e)/i || 
4150
4989
        $squashedtext =~ /[.,](com|org|net|info|biz|ws)/i ||
4151
4990
        $squashedtext =~ /[.,]com?[.,][a-z][a-z]/i ||
4152
 
        $squashedtext =~ /^(ht+ps?|ft+p|fpt+|mailto)[:;](\/\/)?(.*(\.|\%2e))/i) {
4153
 
        #$squashedtext =~ /^(ht+ps?|ft+p|fpt+|mailto)[:;]\/\/?(.*(\.|\%2e))/i) {
 
4991
        $squashedtext =~ /^(ht+ps?|ft+p|fpt+|mailto)[:;](\/\/)?(.*(\.|\%2e))/i ||
 
4992
        $numbertrap) {
4154
4993
      $squashedtext =~  s/^(ht+ps?|ft+p|fpt+|mailto)[:;](\/\/)?(.*(\.|\%2e))/$3/i;
4155
 
      #$squashedtext =~  s/^(ht+ps?|ft+p|fpt+|mailto)[:;]\/\/?(.*(\.|\%2e))/$2/i;
4156
4994
      $squashedtext =~ s/\/.*$//; # Only compare the hostnames
4157
4995
      $squashedtext =~ s/[,.]+$//; # Allow trailing dots and commas
4158
4996
      $squashedtext = 'www.' . $squashedtext
4159
 
        unless $squashedtext =~ /^ww+|ft+p|fpt+|mailto/;
4160
 
      $linkurl = lc($DisarmLinkURL);
4161
 
      $linkurl =~ s/\%a0//ig;
4162
 
      $linkurl =~ s#%([0-9a-f][0-9a-f])#chr(hex('0x' . $1))#gei; # Unescape
4163
 
      $linkurl =~ s/\s+//; # Remove any whitespace
4164
 
      $linkurl = "" if $linkurl =~ /\@/ && $linkurl !~ /\//; # Ignore emails
4165
 
      #$linkurl =~ s/(\<\/?[^>]*\>)*//ig; # Remove tags
4166
 
      #$linkurl =~ s/^(\<\/?(br|p|ul)\>)*//ig; # Remove leading br, p, ul tags
4167
 
      $linkurl =~ s/^blocked[:\/]+//i; # Remove "blocked::" labels
4168
 
      $linkurl =~ s/^(https?|ftp)[:;]\/\///i;
4169
 
      $linkurl = "" if $linkurl =~ /^ma[il]+to[:;]/i;
4170
 
      $linkurl =~ s/[?\/].*$//; # Only compare up to the first '/' or '?'
4171
 
      $linkurl =~ s/(\<\/?(br|p|ul)\>)*$//ig; # Remove trailing br, p, ul tags
4172
 
      $linkurl = "" if $linkurl =~ /^file:/i; # Ignore file: URLs completely
4173
 
      $linkurl =~ s/\/$//; # LinkURL is trimmed -- note
 
4997
        unless $squashedtext =~ /^ww+|ft+p|fpt+|mailto/ || $numbertrap;
4174
4998
      #print STDERR "2SquashedText = \"$squashedtext\"\n";
 
4999
      # If we have already tagged this link as a phishing attack, spot the
 
5000
      # warning text we inserted last time and don't tag it again.
 
5001
      my $possiblefraudstart = MailScanner::Config::LanguageValue(0, 'possiblefraudstart');
 
5002
      my $squashedpossible = lc($possiblefraudstart);
 
5003
      my $squashedsearch   = lc($DisarmLinkText);
 
5004
      $squashedpossible =~ s/\s//g;
 
5005
      $squashedpossible =~ s/(\<\/?[^>]*\>)*//ig; # Remove tags
 
5006
      $squashedsearch   =~ s/\s//g;
 
5007
      $squashedsearch   =~ s/(\<\/?[^>]*\>)*//ig; # Remove tags
 
5008
      #$squashedpossible = "www.$squashedpossible\"$linkurl\"";
 
5009
      $squashedpossible = quotemeta($squashedpossible);
 
5010
      #print STDERR "NEW CODE: SquashedText     = $squashedtext\n";
 
5011
      #print STDERR "NEW CODE: DisarmLinkText   = $DisarmLinkText\n";
 
5012
      #print STDERR "NEW CODE: Text             = $text\n";
 
5013
      #print STDERR "NEW CODE: SquashedPossible = $squashedpossible\n";
 
5014
      #print STDERR "NEW CODE: LinkURL          = $linkurl\n";
 
5015
      if ($squashedtext =~ /$squashedpossible/) {
 
5016
        #print STDERR "FOUND IT\n";
 
5017
        #print STDERR "$DisarmLinkText$text\n";
 
5018
        print "$DisarmLinkText$text";
 
5019
        $DisarmLinkText = ""; # Reset state of automaton
 
5020
        return;
 
5021
      }
4175
5022
      #print STDERR "2LinkURL      = \"$linkurl\"\n";
4176
 
      if ($linkurl ne "" && $squashedtext !~ /^(w+\.)?\Q$linkurl\E\/?$/) {
4177
 
        print MailScanner::Config::LanguageValue(0, 'possiblefraudstart') .
4178
 
              ' "' . $linkurl . '" ' .
4179
 
              MailScanner::Config::LanguageValue(0, 'possiblefraudend') . ' ';
4180
 
        $DisarmPhishingFound = 1;
4181
 
        $linkurl = substr $linkurl, 0, 80;
4182
 
        $squashedtext = substr $squashedtext, 0, 80;
4183
 
        MailScanner::Log::InfoLog('Found phishing fraud from %s ' .
4184
 
                                  'claiming to be %s in %s',
4185
 
                                  $linkurl, $squashedtext, $id);
4186
 
                                  #$DisarmLinkURL);
 
5023
      # If it is a phishing catch, or else it's not (numeric or IPv6 numeric)
 
5024
      # then notify.
 
5025
      #print STDERR "LinkURL is \"$linkurl\"\n";
 
5026
      #print STDERR "Squashe is \"$squashedtext\"\n";
 
5027
      #print STDERR "Phishing by numbers is $DisarmNumbers\n";
 
5028
 
 
5029
      #if ($linkurl ne "" && $squashedtext !~ /^(w+\.)?\Q$linkurl\E\/?$/) {
 
5030
      #   || ($linkurl ne "" && $DisarmNumbers && $linkurl =~ /^\d+\.[^g-z]+/)){
 
5031
      if ($alarm ||
 
5032
          ($linkurl ne "" && $squashedtext !~ /^(w+\.)?\Q$linkurl\E\/?$/)
 
5033
          || ($linkurl ne "" && $numbertrap)) {
 
5034
 
 
5035
        unless (InPhishingWhitelist($linkurl)) {
 
5036
          use bytes; # Don't send UTF16 to syslog, it breaks!
 
5037
          if ($linkurl ne "" && numbertrap && $linkurl eq $squashedtext) {
 
5038
            # It's not a real phishing trap, just a use of numberic IP links
 
5039
            print MailScanner::Config::LanguageValue(0, 'numericlinkwarning') .
 
5040
                  ' ' if $PhishingHighlight;
 
5041
          } else {
 
5042
            # It's a phishing attack.
 
5043
            print $possiblefraudstart . ' "' . $linkurl . '" ' .
 
5044
                  MailScanner::Config::LanguageValue(0, 'possiblefraudend') . ' ' if $PhishingHighlight;
 
5045
          }
 
5046
          $DisarmPhishingFound = 1;
 
5047
          $linkurl = substr $linkurl, 0, 80;
 
5048
          $squashedtext = substr $squashedtext, 0, 80;
 
5049
          $DisarmDoneSomething{'phishing'} = 1 if $PhishingSubjectTag;
 
5050
          if ($numbertrap) {
 
5051
            MailScanner::Log::InfoLog('Found ip-based phishing fraud from ' .
 
5052
                                      '%s in %s', $linkurl, $id);
 
5053
          } else {
 
5054
            MailScanner::Log::InfoLog('Found phishing fraud from %s ' .
 
5055
                                      'claiming to be %s in %s',
 
5056
                                      $linkurl, $squashedtext, $id);
 
5057
                                      #$DisarmLinkURL);
 
5058
          }
 
5059
          #print STDERR "Fake\n";
 
5060
          no bytes;
 
5061
        }
4187
5062
      }
 
5063
      #print STDERR "\n";
4188
5064
    }
 
5065
    #print STDERR "End tag printed \"$DisarmLinkText$text\"\n";
4189
5066
    print "$DisarmLinkText$text";
 
5067
    $DisarmLinkText = ""; # Reset state of automaton
 
5068
    #print STDERR "Reset disarmlinktext\n";
4190
5069
  } else {
 
5070
    #print STDERR "End tag printed \"$text\"\n";
4191
5071
    print $text;
4192
5072
  }
4193
5073
}
4194
5074
 
 
5075
my %CharToInternational = (
 
5076
160,'nbsp',
 
5077
161,'iexcl',
 
5078
162,'cent',
 
5079
163,'pound',
 
5080
164,'curren',
 
5081
165,'yen',
 
5082
166,'brvbar',
 
5083
167,'sect',
 
5084
168,'uml',
 
5085
169,'copy',
 
5086
170,'ordf',
 
5087
171,'laquo',
 
5088
172,'not',
 
5089
173,'shy',
 
5090
174,'reg',
 
5091
175,'macr',
 
5092
176,'deg',
 
5093
177,'plusmn',
 
5094
178,'sup2',
 
5095
179,'sup3',
 
5096
180,'acute',
 
5097
181,'micro',
 
5098
182,'para',
 
5099
183,'middot',
 
5100
184,'cedil',
 
5101
185,'sup1',
 
5102
186,'ordm',
 
5103
187,'raquo',
 
5104
188,'frac14',
 
5105
189,'frac12',
 
5106
190,'frac34',
 
5107
191,'iquest',
 
5108
192,'Agrave',
 
5109
193,'Aacute',
 
5110
194,'Acirc',
 
5111
195,'Atilde',
 
5112
196,'Auml',
 
5113
197,'Aring',
 
5114
198,'AElig',
 
5115
199,'Ccedil',
 
5116
200,'Egrave',
 
5117
201,'Eacute',
 
5118
202,'Ecirc',
 
5119
203,'Euml',
 
5120
204,'Igrave',
 
5121
205,'Iacute',
 
5122
206,'Icirc',
 
5123
207,'Iuml',
 
5124
208,'ETH',
 
5125
209,'Ntilde',
 
5126
210,'Ograve',
 
5127
211,'Oacute',
 
5128
212,'Ocirc',
 
5129
213,'Otilde',
 
5130
214,'Ouml',
 
5131
215,'times',
 
5132
216,'Oslash',
 
5133
217,'Ugrave',
 
5134
218,'Uacute',
 
5135
219,'Ucirc',
 
5136
220,'Uuml',
 
5137
221,'Yacute',
 
5138
222,'THORN',
 
5139
223,'szlig',
 
5140
224,'agrave',
 
5141
225,'aacute',
 
5142
226,'acirc',
 
5143
227,'atilde',
 
5144
228,'auml',
 
5145
229,'aring',
 
5146
230,'aelig',
 
5147
231,'ccedil',
 
5148
232,'egrave',
 
5149
233,'eacute',
 
5150
234,'ecirc',
 
5151
235,'euml',
 
5152
236,'igrave',
 
5153
237,'iacute',
 
5154
238,'icirc',
 
5155
239,'iuml',
 
5156
240,'eth',
 
5157
241,'ntilde',
 
5158
242,'ograve',
 
5159
243,'oacute',
 
5160
244,'ocirc',
 
5161
245,'otilde',
 
5162
246,'ouml',
 
5163
247,'divide',
 
5164
248,'oslash',
 
5165
249,'ugrave',
 
5166
250,'uacute',
 
5167
251,'ucirc',
 
5168
252,'uuml',
 
5169
253,'yacute',
 
5170
254,'thorn',
 
5171
255,'yuml'
 
5172
);
 
5173
 
 
5174
# Turn any character into an international version of it if it is in the range
 
5175
# 160 to 255.
 
5176
sub CharToIntnl {
 
5177
  my $p = shift @_;
 
5178
  # Passed in an 8-bit character.
 
5179
  #print STDERR "Char in is $p\n";
 
5180
  ($a) = unpack 'C', $p;
 
5181
 
 
5182
  #print STDERR "Char is $a, $p\n";
 
5183
 
 
5184
  # Bash char 160 (space) to nothing
 
5185
  return '' if $a == 160;
 
5186
  my $char = $CharToInternational{$a};
 
5187
  return '&' . $char . ';' if $char ne "";
 
5188
  return $p;
 
5189
}
 
5190
 
 
5191
# Clean up a link URL so it is suitable for phishing detection
 
5192
# Return (clean url, alarm trigger value). An alarm trigger value non-zero
 
5193
# means this is definitely likely to be a phishing trap, no matter what
 
5194
# anything else says.
 
5195
sub CleanLinkURL {
 
5196
  my($DisarmLinkURL) = @_;
 
5197
 
 
5198
  use bytes;
 
5199
 
 
5200
  my($linkurl,$alarm);
 
5201
  $alarm = 0;
 
5202
  $linkurl = $DisarmLinkURL;
 
5203
  $linkurl = lc($linkurl);
 
5204
  #print STDERR "Cleaning up $linkurl\n";
 
5205
  #$linkurl =~ s/\%a0//ig;
 
5206
  #$linkurl =~ s/\%e9/&eacute;/ig;
 
5207
 
 
5208
  $linkurl =~ s#%([0-9a-f][0-9a-f])#chr(hex('0x' . $1))#gei; # Unescape
 
5209
  #print STDERR "2Cleaning up $linkurl\n";
 
5210
 
 
5211
  $linkurl =~ s/./CharToIntnl("$&")/ge;
 
5212
 
 
5213
  #print STDERR "Was $linkurl\n";
 
5214
  $linkurl = "" unless $linkurl =~ /[.\/]/; # Ignore if it is not a website at all
 
5215
  $linkurl =~ s/\s+//g; # Remove any whitespace
 
5216
  $linkurl =~ s/\\/\//g; # Change \ to / as many browsers do this
 
5217
  #print STDERR "Is $linkurl\n";
 
5218
  $linkurl = "" if $linkurl =~ /\@/ && $linkurl !~ /\//; # Ignore emails
 
5219
  $linkurl =~ s/^\[\d*\]//; # Remove leading [numbers]
 
5220
  #$linkurl =~ s/(\<\/?[^>]*\>)*//ig; # Remove tags
 
5221
  #$linkurl =~ s/^(\<\/?(br|p|ul)\>)*//ig; # Remove leading br, p, ul tags
 
5222
  $linkurl =~ s/^blocked[:\/]+//i; # Remove "blocked::" labels
 
5223
  $linkurl =~ s/^outbind:\/\/\d+\///i; # Remove "outbind://22/" type labels
 
5224
  $linkurl = $DisarmBaseURL . '/' . $linkurl
 
5225
    if $linkurl ne "" && $DisarmBaseURL ne "" &&
 
5226
       $linkurl !~ /^(https?|ftp|mailto):/i;
 
5227
  $linkurl =~ s/^(https?|ftp)[:;]\/\///i;
 
5228
  $linkurl = "" if $linkurl =~ /^ma[il]+to[:;]/i;
 
5229
  $linkurl =~ s/[?\/].*$//; # Only compare up to the first '/' or '?'
 
5230
  $linkurl =~ s/(\<\/?(br|p|ul)\>)*$//ig; # Remove trailing br, p, ul tags
 
5231
  $linkurl = "" if $linkurl =~ /^file:/i; # Ignore file: URLs completely
 
5232
  $linkurl = "" if $linkurl =~ /^#/; # Ignore internal links completely
 
5233
  $linkurl =~ s/\/$//; # LinkURL is trimmed -- note
 
5234
  $alarm = 1 if $linkurl =~ s/[\x00-\x1f[:^ascii:]]/_BAD_/g; # /\&\#/;
 
5235
  #$alarm = 1 if $linkurl =~ s/[\x00-\x1f\x80-\x{ffff}]/_BAD_/g; # /\&\#/;
 
5236
  #print STDERR "Produced $linkurl and $alarm\n";
 
5237
  $linkurl = 'JavaScript' if $linkurl =~ /^javascript:/i;
 
5238
  ($linkurl, $alarm);
 
5239
}
 
5240
 
 
5241
# Return 1 if the hostname in $linkurl is in the safe sites file.
 
5242
# Return 0 otherwise.
 
5243
sub InPhishingWhitelist {
 
5244
  my($linkurl) = @_;
 
5245
 
 
5246
  # Quick lookup
 
5247
  return 1 if $MailScanner::Config::PhishingWhitelist{$linkurl};
 
5248
 
 
5249
  # Trim host. off the front of the hostname
 
5250
  while ($linkurl ne "" && $linkurl =~ s/^[^.]+\.//) {
 
5251
    # And replace it with *. then look it up
 
5252
    #print STDERR "Looking up *.$linkurl\n";
 
5253
    return 1 if $MailScanner::Config::PhishingWhitelist{'*.' . $linkurl};
 
5254
  }
 
5255
 
 
5256
  return 0;
 
5257
}
4195
5258
 
4196
5259
 
4197
5260
# Convert 1 MIME entity from html to text using HTML::Parser.
4305
5368
#
4306
5369
sub WordDecoderKeep7Bit {
4307
5370
    local $_ = shift;
4308
 
    tr/\x00-\x7F/#/c;
 
5371
    # JKF 19/8/05 Allow characters with the top bit set.
 
5372
    # JKF 19/8/05 Still blocks 16-bit characters though, as it should.
 
5373
    #tr/\x00-\x7F/#/c;
 
5374
    tr/\x00-\xFF/#/c;
4309
5375
    $_;
4310
5376
}
4311
5377