bin/rt-deleter.pl

   1 #
   2
   3 =head1 rt-deleter
   4
   5 Get a cookie from, say firebug. Call me with numbers and ranges, eg
   6
   7   23658..9 32665..72
   8
   9 Tickets will be displayed with 'less'.
  10
  11 The question will be asked if you want to delete it.
  12
  13 =cut
  14
  15 use strict;
  16 use warnings;
  17
  18 use ExtUtils::MakeMaker qw(prompt);
  19 use Getopt::Long;
  20 use HTML::TreeBuilder;
  21 use HTML::FormatText;
  22 use LWP::UserAgent ();
  23 use YAML::Syck;
  24 { no warnings "once"; $YAML::Syck::ImplicitUnicode = 1; }
  25
  26 sub _h2text ($);
  27
  28 my %Config = (
  29               server      => 'https://rt.cpan.org',
  30               username    => 'ANDK',
  31               password    => '',
  32               cookie      => '',
  33               less        => '',
  34               autodelete  => [
  35                               qr/(?s:R+e+a+l+.+?m+e+n+!+.+?M+i+l+i+o+n+s+.+?o+f+.+?p+e+o+p+l+e+.+?a+c+r+o+s+.+?t+h+e+.+?w+o+r+l+d+)/,
  36                               qr/We strongly recommend deleting this letter and avoid clicking any links/,
  37                               qr/\QI looked for you on Reunion.com, the largest people\E/,
  38                               qr/Enjoy secure ordering, lowest possible prices/,
  39                               qr/Download eTrust Antivirus ScanReport.TxT/,
  40                               qr/bietet Ihnen ein leistungsorientiertes Lohn und/,
  41                               qr/wunderbare Aufstiegschancen/,
  42                               qr/J..?.?ai en ma possession tous les documents/,
  43                               qr/Dior, the Christian Dior Fashion House has/,
  44                               qr/Spring Sale Fashion Footwear Shoes/,
  45                               qr/(?s:P+r+e+s+e+n+t+.+u+n+f+o+r+g+e+t+t+a+b+l+e+.+n+i+g+h+t+.+t+o+.+y+o+u+r+.+b+e+l+o+v+e+d+.+o+n+e+)/,
  46                               qr/\QНи3kи{e} ц{e}ны!!!\E/,
  47                               qr/I am the representative of the large Ukrainian/,
  48                               qr|Consortium of Export/Import Based in Czech|,
  49                               qr{(?s:I+n+c+r+e+a+s+e+.+?S+e+x+u+a+l+.+?E+n+e+r+g+y+.+a+n+d+.+?P+l+e+a+s+u+r+e+)},
  50                               qr{It is Very Easy To Loss Weight},
  51                               qr{8.901.530.28.70\.},
  52                               qr{495.{3}772.07.57},
  53                               qr{(?s:le super lot de la loterie.*sultats de la Loterie Mega Millions.*FELICITATION!)},
  54                               qr{(?:eflyers|newsflash|specialfeatures|accountsaction|Radio&Music|adlinx|tvlinx)\@es1\.indiantelevision\.com},
  55                               qr{Read.*?What.*?Our.*?Satisfied.*?Customers.*?Say},
  56                               qr{\Q***<br />
  57 Warning!<br />
  58 This letter contains a virus which has been<br />
  59 successfully detected and cured.<br />
  60 ***<br />\E},
  61
  62
  63                               qr{\QOur system detected an illegal attachment on your message\E},
  64                               qr{Diagnostic-Code:\s+X-Postfix;\s+host.+\s+said:\s+550\s+.+\s+Recipient address rejected:.+\s+User unknown in virtual mailbox table},
  65                               qr{<title>.+Mail delivery failed: returning message to sender</title>},
  66                               qr{----- The following addresses had permanent fatal errors -----},
  67                               qr{(?s:Failed to deliver to.+account is full.+quota exceeded)},
  68
  69
  70                               qr{(?x:Ahn \s nyeong|Ciao|God \s dag|Goedendag|Guten \s Tag|
  71 Hallo|Hai|Hei|Hej|Hello|Hey|Heya|Hi|Hoi|
  72 Ni \s hao|Oi|Salve|Bonjour,Try\s)[,\.]+(?:\s|<br\s*/>)*\s*(?xi:
  73 \QFuck \s beer! \s Got \s sexy \s girl\?\E
  74 |How \s to \s keep \s your \s girlfriend \s happy \s \.\.\.
  75 |How+ \s to \s turn \s your.+
  76 |(p+r+o+v+e+|s+a+v+e+) \s y+o+u+r+ \s l+o+v+e+!?
  77 )(?:\s|<br\s*/>)*http://\S+[\.\[\]](?:cn|com)[\s<]},
  78                               qr{(?i:Pour ne plus recevoir de messages.+cliquez ici)},
  79                               qr{If you would like not to receive any further communication from us, please send email to unsubscribe\@whozat.com.},
  80                               qr{To unsubscribe, send an email to: \S+ with the address: \S+ in the subject line},
  81                               qr{[\x{0400}-\x{0513}\s,\.:]{50}}, # 50 cyrillic is spam?
  82                               qr{Avis de tempete sur les prix},
  83                               qr{Sie wuenschen Ihre Freizeit fuer Ihre Finanzen nutzen},
  84                               qr{Sie haben oefters Freizeit},
  85                               qr{Mailen Sie uns.*\.ru und lassen Sie sich genauere Informationen zukommen.},
  86                               qr{Viel Kohle in klitzekleiner Zeit},
  87                               qr{To begin processing of your prize contact:},
  88                               qr{(?mx: (^ [ef]\S{9}\s[ef]\S{9}\s[ef]\S{9}.+\n){3} )},
  89                               qr{(?mx: (^ [ef]\S{10}\s[ef]\S{10}\s[ef]\S{10}.+\n){3} )},
  90                               qr{The attachment file in the message has been removed by eManager},
  91                               qr{(?s:This is an automated response to let you know that your message has been.+?caught by our spam filter)},
  92                               qr{(?s:The WatchGuard Firebox which protects your network detected a message which may.+?not be safe\.)},
  93                               qr{(?s:This nondelivery report was generated by the amavisd-new program)},
  94                               qr{(?:MailEnable: Message could not be delivered to some recipients.)},
  95                               qr{(?:This is an automatically generated Delivery Status Notification.<br />)},
  96                               qr{(?:Message you sent blocked by bulk email filter!)},
  97                               qr{(?:The message has been blocked because it contains)},
  98                               qr{(?:Si vous ne souhaitez plus recevoir de mail de notre part,)},
  99                               qr{(?:The email you sent with the following subject has NOT BEEN DELIVERED)},
 100
 101
 102                               qr{US Pharmaceutical Company Executives List(ing)?},
 103                               qr{every dentist in the (United States|US) with full contact details},
 104                               qr{Chiropractors in the USA},
 105                               qr{Contact List of Chiropractors},
 106                               qr{for (termination of|stopping) this e?mail (in future )?send (us )?an? (blank message|email) with},
 107                               qr{Chiropractors offices with full contact data},
 108                               qr{(?i:dentists and dental services)},
 109
 110                               qr{Si no desea recibir información en un futuro},
 111                               qr{\QFuck beer! Got sexy girl?\E},
 112                               qr{\QITEMS BELOW ARE INCLUDED IN THE DEAL AT NO EXTRA COST\E},
 113                               qr{\QThis week only you pay only:\E},
 114                               qr{\QPastas Simples - Pastas com Bolsa\E},
 115                               qr{(?i:HOW TO CLAIM YOUR PRIZE)},
 116                               qr{ULTIMAS NOTEBOOKS DELL},
 117                               qr{(?:eventually considered the camera as a valuable)},
 118                               qr{Sign up so you can check it out with me},
 119                               qr{Ideas for your Business},
 120                               qr{We design and manufacture car wraps},
 121                               qr{Anjelina Jolie XXX Video Free.},
 122                               qr{Click here and Enjoy: <a href="http://},
 123                               qr{You can check you order status at the fol?owing link:},
 124
 125                               qr{(Sexy|Nude) Angelina Jolie video!},
 126                               qr{(?:VENDAS - GLOBAL GESSO)},
 127                               qr{Este es un correo no solicitado},
 128                               qr{(?:Dear Client,<br />)},
 129                               qr{(?:Your account was temporarily blocked. Here is an instruction on recovery of your account.)},
 130                               qr{CLICK THIS LINK TO VISIT:},
 131                               qr{It's free to join and easy to sign up!},
 132                               qr{More Easy To Make Money},
 133                               qr{You have recieved a Hallmark E-Card from your friend.},
 134                               qr{IKEA has a Fantastic new FREE tool for home decorating},
 135                               # qr{EasyWeb\@tdcanadatrust.com},
 136                               qr{HELLO MY LOVE ONE},
 137                               qr{In dringenden F.llen wenden Sie sich bitte an meine Vertretung Silvio Kranzusch},
 138                               qr{miss Mabel Dagba},
 139                               qr{\swww\.xema\.es\s},
 140                              ],
 141              );
 142
 143 GetOptions(\my %config,
 144            (map { ref $Config{$_} ? "$_=s\@" : "$_=s" } keys %Config),
 145            "nonono!",
 146            "stats!",
 147           ) or die;
 148 while (my($k,$v) = each %config) {
 149   $Config{$k} = $v;
 150 }
 151 unless ($Config{cookie}) {
 152   die "Missing mandatory option --cookie";
 153 }
 154 $ENV{LESS} = $Config{less};
 155
 156 my @rtickets = @ARGV or die "Usage: $0 [options] ticket...";
 157 my @tickets;
 158 for my $i (0..$#rtickets) {
 159   if ( $rtickets[$i] =~ /(\d+)\.\.(\d+)/ ) {
 160     my($from,$sto) = ($1,$2);
 161     my $to = $from;
 162     my $x = ("." x length($sto)) . '$';
 163     $to = $sto unless $to =~ s/$x/$sto/; # s/// fails on 99..100
 164     push @tickets, $from..$to;
 165   } else {
 166     push @tickets, $rtickets[$i];
 167   }
 168 }
 169 @tickets = sort {$a <=> $b} @tickets;
 170 print "Planning to visit tickets @tickets.\n";
 171 my $yaml_db_file = "$ENV{HOME}/sources/CPAN/data/rt-deleter.yml";
 172 my $ALL;
 173 if (-e $yaml_db_file) {
 174   $ALL = YAML::Syck::LoadFile($yaml_db_file);
 175   #for my $k (keys %$ALL) {
 176   #  my $k7d = sprintf "%07d", $k;
 177   #  if (substr($k,0,1) eq " " or length $k != 7 and length $k7d == 7) {
 178   #    $ALL->{$k7d} = delete $ALL->{$k};
 179   #  }
 180   #}
 181 } else {
 182   warn "WARNING: yaml file '$yaml_db_file' not found!!!";
 183   sleep 3;
 184   $ALL = {};
 185 }
 186
 187 my $ua = LWP::UserAgent->new(
 188                              keep_alive => 1,
 189                             );
 190 $ua->default_headers->push_header(
 191                                   Cookie => $config{cookie},
 192                                  );
 193 $|=1;
 194 TICKET: for my $ticket (@tickets) {
 195   unless ($ticket =~ /^\d+$/) {
 196     warn "Alert: skipping invalid ticket '$ticket'";
 197     next TICKET;
 198   }
 199   if ($ticket =~ /^(17751)$/) {
 200     #
 201     warn "Alert: skipping known DOS ticket '$ticket'";
 202     next TICKET;
 203   }
 204   my $displ = "$Config{server}/Ticket/Display.html?id=$ticket";
 205   print "Retrieving ticket '$ticket' as $displ...\n";
 206   my $resp = $ua->get($displ);
 207   unless ($resp->is_success) {
 208       warn sprintf "Could not retrieve '%s': %s", $displ, $resp->code;
 209       sleep 2;
 210       next TICKET;
 211   }
 212   my $decoded = $resp->decoded_content;
 213   unless ($decoded) {
 214       $decoded = $resp->content;
 215       my $cnt = $decoded =~ tr[\200-\377][?]d;
 216       if ($cnt) {
 217           warn sprintf "Warning: had to replace %d bytes in the content of the message", $cnt;
 218           sleep 2;
 219       }
 220   }
 221   if ($decoded =~ m|>Status:</td>\s+<td.+?>deleted</td>\s+.+\bTicket\sdeleted\s+|s) {
 222     warn "Ticket already deleted, nothing to do\n";
 223     sleep 2;
 224     next TICKET;
 225   }
 226   my $answer;
 227   if ($Config{nonono}) {
 228     print "not showing '$ticket'\n";
 229     sleep 1;
 230     $answer = "n";
 231   } elsif ($Config{autodelete}) {
 232   REGEXP: for my $rx (@{$Config{autodelete}}) {
 233       if ($decoded =~ $rx) {
 234         print "Ticket matches '$rx'\n";
 235         $answer = "y";
 236         last REGEXP;
 237       }
 238     }
 239   }
 240   $DB::single=1;
 241   my $text = _h2text($decoded);
 242   # http://rt.cpan.org/RT-Extension-QuickDelete/ToggleQuickDelete?id=32655
 243   # https://rt.cpan.org/RT-Extension-QuickDelete/ToggleQuickDelete?id=41648
 244   if ($answer) {
 245     print join "", (("=" x 79) . "\n") x 2;
 246     print "Answer '$answer' has already been determined automatically\n";
 247     sleep 1;
 248   } else {
 249     {no warnings "once"; $DB::single++;}
 250     open my $less, "|-", "less" or die "Could not fork: $!";
 251     binmode $less, ":utf8";
 252     print $less $decoded;
 253     print $less "="x79,"\n" for 0..1;
 254     print $less $text;
 255     close $less;
 256     print join "", (("=" x 79) . "\n") x 2;
 257     $answer = prompt "You have now seen the ticket '$ticket'. Do you want to delete it? {N,y,q,yq}", "n";
 258   }
 259   my $ticket7d = sprintf "%07d", $ticket;
 260   if ($answer =~ /^q/i) {
 261     print "OK, end of loop\n";
 262     last TICKET;
 263   } elsif ($answer =~ /^n/i) {
 264     print "OK, leaving ticket '$ticket' alone\n";
 265     $ALL->{$ticket7d} ||= { text => $text,
 266                           want_delete => 0,
 267                           date => scalar(localtime),
 268                         };
 269     next TICKET;
 270   } elsif ($answer =~ /^y/i) {
 271     print "OK, trying to delete ticket '$ticket'\n";
 272     $ALL->{$ticket7d} = { text => $text,
 273                         want_delete => 1,
 274                         date => scalar(localtime),
 275                       };
 276     my $delete = "$Config{server}/RT-Extension-QuickDelete/ToggleQuickDelete?id=$ticket";
 277     my $resp = $ua->get($delete);
 278     if ($resp->is_success) {
 279       my $decoded = $resp->decoded_content;
 280       if ($decoded =~ /Undelete/) {
 281         $ALL->{$ticket7d}{could_delete} = 1;
 282         print "Ticket '$ticket' deleted\n";
 283       } else {
 284         my $text = _h2text($decoded);
 285         die "ALERT: response was succeess but did not contain 'Undelete'. text[$text]";
 286       }
 287     } else {
 288       $ALL->{$ticket7d}{could_delete} = 0;
 289       warn "ALERT: Could not delete ticket '$ticket': " . $resp->as_string;
 290       last TICKET;
 291     }
 292     if ($answer =~ /^yq/i) {
 293       print "OK, end of loop\n";
 294       last TICKET;
 295     }
 296   }
 297 }
 298
 299 print "End of loop, writing memories...";
 300 open my $fh, ">:utf8", "$yaml_db_file.new" or die "Couldn't open: $!";
 301 print $fh YAML::Syck::Dump($ALL);
 302 rename $yaml_db_file, "$yaml_db_file~";
 303 rename "$yaml_db_file.new", $yaml_db_file;
 304 print "Memories written to $yaml_db_file\n";
 305
 306 if ($Config{stats}) {
 307   print "Collecting stats\n";
 308   my %del_by;
 309   for my $k (keys %$ALL) {
 310     if ($ALL->{$k}{text} =~ /^(.+) - Ticket deleted/m) {
 311       $del_by{$1}++;
 312     } elsif ($ALL->{$k}{could_delete}) {
 313       $del_by{ANDK}++;
 314     } else {
 315       $del_by{UNKNOWN}++;
 316     }
 317   }
 318   my $i = 0;
 319   for my $k (sort { $del_by{$b} <=> $del_by{$a} } keys %del_by) {
 320     $i++;
 321     printf "%3d %23s %5d\n", $i, $k, $del_by{$k};
 322     last if $i >= 10;
 323   }
 324 }
 325
 326 sub _h2text ($) {
 327   my($decoded) = @_;
 328   my $tree = HTML::TreeBuilder->new_from_content($decoded);
 329   my $formatter = HTML::FormatText->new(leftmargin => 0, rightmargin => 50);
 330   my $text = $formatter->format($tree);
 331   $tree->delete;
 332   $text;
 333 }
 334
 335 __END__
 336
 337 # Local Variables:
 338 # mode: cperl
 339 # coding: utf-8
 340 # cperl-indent-level: 2
 341 # End: