maps/bin/detail.cgi

   1 #!/usr/bin/perl
   2 ################################################################################
   3 #
   4 # File:         $RCSfile: detail.cgi,v $
   5 # Revision:     $Revision: 1.1 $
   6 # Description:  Displays list of email addresses based on report type.
   7 # Author:       Andrew@DeFaria.com
   8 # Created:      Fri Nov 29 14:17:21  2002
   9 # Modified:     $Date: 2013/06/12 14:05:47 $
  10 # Language:     perl
  11 #
  12 # (c) Copyright 2000-2021, Andrew@DeFaria.com, all rights reserved.
  13 #
  14 ################################################################################
  15 use strict;
  16 use warnings;
  17
  18 use MIME::Words qw(:all);
  19
  20 use CGI qw(:standard *table start_td end_td start_Tr end_Tr start_div end_div);
  21 use CGI::Carp 'fatalsToBrowser';
  22
  23 use FindBin;
  24
  25 local $0 = $FindBin::Script;
  26
  27 use lib "$FindBin::Bin/../lib";
  28 use lib "$FindBin::Bin/../../lib";
  29
  30 use MAPS;
  31 use MAPSLog;
  32 use MAPSWeb;
  33 use DateUtils;
  34
  35 my $type   = param 'type';
  36 my $next   = param 'next';
  37 my $lines  = param 'lines';
  38 my $date   = param 'date';
  39
  40 $date ||= '';
  41
  42 my ($userid, $current, $last, $prev, $total);
  43
  44 my $table_name = 'detail';
  45
  46 my %types = (
  47   'blacklist'   => [
  48     'Blacklist report',
  49     'The following blacklisted users attempted to email you'
  50   ],
  51   'whitelist'   => [
  52     'Delivered report',
  53     'Delivered email from the following users'
  54   ],
  55   'nulllist'    => [
  56     'Discarded report',
  57     'Discarded messages from the following users'
  58   ],
  59   'error'       => [
  60     'Error report',
  61     'Errors detected'
  62   ],
  63   'mailloop'    => [
  64     'MailLoop report',
  65     'Automatically detected mail loops from the following users'
  66   ],
  67   'registered'  => [
  68     'Registered report',
  69     'The following users have recently registered'
  70   ],
  71   'returned'    => [
  72     'Returned report',
  73     'Sent Register reply to the following users'
  74   ]
  75 );
  76
  77 sub MakeButtons($) {
  78   my ($type) = @_;
  79
  80   my $prev_button = $prev >= 0 ?
  81     a ({-href      => "detail.cgi?type=$type;date=$date;next=$prev",
  82         -accesskey => 'p',
  83     }, '<img src=/maps/images/previous.gif border=0 alt=Previous align=middle>') : '';
  84   my $next_button = ($next + $lines) < $total ?
  85     a {-href      => "detail.cgi?type=$type;date=$date;next=" . ($next + $lines),
  86        -accesskey => 'n',
  87     }, '<img src=/maps/images/next.gif border=0 alt=Next align=middle>' : '';
  88
  89   my $buttons = $prev_button;
  90
  91   if ($type eq 'whitelist') {
  92     $buttons = $buttons .
  93       submit ({-name    => 'action',
  94                -value   => 'Blacklist',
  95                -onClick => 'return CheckAtLeast1Checked (document.detail);'}) . '&nbsp;' .
  96       submit ({-name    => 'action',
  97                -value   => 'Nulllist',
  98                -onClick => 'return CheckAtLeast1Checked (document.detail);'}) . '&nbsp;' .
  99       submit ({-name    => 'action',
 100                -value   => 'Reset',
 101                -onClick => 'return ClearAll (document.detail);'});
 102   } elsif ($type eq 'blacklist') {
 103     $buttons = $buttons .
 104       submit ({-name    => 'action',
 105                -value   => 'Whitelist',
 106                -onClick => 'return CheckAtLeast1Checked (document.detail);'}) . '&nbsp;' .
 107       submit ({-name    => 'action',
 108                -value   => 'Nulllist',
 109                -onClick => 'return CheckAtLeast1Checked (document.detail);'}) . '&nbsp;' .
 110       submit ({-name    => 'action',
 111                -value   => 'Reset',
 112                -onClick => 'return ClearAll (document.detail);'});
 113   } elsif ($type eq 'nulllist') {
 114     $buttons = $buttons .
 115       submit ({-name    => 'action',
 116                -value   => 'Whitelist',
 117                -onClick => 'return CheckAtLeast1Checked (document.detail);'}) . '&nbsp;' .
 118       submit ({-name    => 'action',
 119                -value   => 'Blacklist',
 120                -onClick => 'return CheckAtLeast1Checked (document.detail);'}) . '&nbsp;' .
 121       submit ({-name    => 'action',
 122                -value   => 'Reset',
 123                -onClick => 'return ClearAll (document.detail);'});
 124   } else {
 125     $buttons = $buttons .
 126       submit ({-name    => 'action',
 127                -value   => 'Whitelist',
 128                -onClick => 'return CheckAtLeast1Checked (document.detail);'}) . '&nbsp;' .
 129       submit ({-name    => 'action',
 130                -value   => 'Blacklist',
 131                -onClick => 'return CheckAtLeast1Checked (document.detail);'}) . '&nbsp;' .
 132       submit ({-name    => 'action',
 133                -value   => 'Nulllist',
 134                -onClick => 'return CheckAtLeast1Checked (document.detail);'}) . '&nbsp;' .
 135       submit ({-name    => 'action',
 136                -value   => 'Reset',
 137                -onClick => 'return ClearAll (document.detail);'});
 138   } # if
 139
 140   print div {
 141     -align => 'center',
 142     -class => 'toolbar',
 143   }, $buttons . $next_button;
 144
 145   return;
 146 } # MakeButtons
 147
 148 sub Body($) {
 149   my ($type) = @_;
 150
 151   my $current = $next + 1;
 152
 153   print div {-align => 'center'}, b (
 154     '(' . $current . '-' . $last . ' of ' . $total . ')');
 155   print start_form {
 156     -method => 'post',
 157     -action => 'processaction.cgi',
 158     -name   => 'detail'
 159   };
 160
 161   MakeButtons $type;
 162
 163   print start_div {-id => 'highlightrow'};
 164
 165   print start_table({-align        => 'center',
 166                      -id           => $table_name,
 167                      -border       => 0,
 168                      -cellspacing  => 0,
 169                      -cellpadding  => 0,
 170                      -width        => '100%'}) . "\n";
 171
 172   print
 173     Tr [
 174       th {-class  => 'tablebordertopleft'},  '',
 175       th {-class  => 'tableborder'},         'Sender',
 176       th {-class  => 'tableborder'},         'List',
 177       th {-class  => 'tableborder'},         'Hit Count',
 178       th {-class  => 'tableborder'},         'Rule',
 179       th {-class  => 'tablebordertopright'}, 'Comment',
 180     ];
 181
 182   my @senders = ReturnSenders(
 183     userid   => $userid,
 184     type     => $type,
 185     start_at => $next,
 186     lines    => $lines,
 187     date     => $date
 188   );
 189
 190   for my $sender (@senders) {
 191     my $msgs = ReturnMessages(
 192       userid => $userid,
 193       sender => $sender,
 194     );
 195
 196     my $leftclass    = 'tableleftdata';
 197     my $dataclass    = 'tabledata';
 198     my $rightclass   = 'tablerightdata';
 199     my $senderclass  = 'sender';
 200     my $subjectclass = 'subject';
 201
 202     # Check to see if this is the last line
 203     if ((($next + 1) % $lines) == (@senders % $lines)) {
 204       # We always "bottom" the first column
 205       $leftclass = 'tablebottomleft';
 206
 207       # Check to see if there any message lines to display
 208       unless (@$msgs) {
 209         $dataclass   = 'tablebottomdata';
 210         $rightclass  = 'tablebottomright';
 211         $senderclass = 'senderbottom';
 212       } # unless
 213     } # if
 214
 215     # This is for the purposes of supplying a subject line if the mailto address
 216     # is clicked on. It's kludgy because we are simply grabbing the subject line
 217     # of the first email sent where there may be many emails from this sender
 218     # Still it is often the right subject (or a good enough one)
 219     #
 220     # A little tricky here because of transliteration. If I test for
 221     # $msg->[0]{subject} when $msg->[0] is essentially empty I create the hash
 222     # making it non empty. Therefore I need to first test if $msgs->[0] exists
 223     # first.
 224     my $heading = '';
 225
 226     if ($msgs->[0]) {
 227       $heading = $msgs->[0]{subject} if $msgs->[0]{subject};
 228     } # if
 229
 230     my ($onlist, $seq);
 231
 232     my $rule      = 'none';
 233     my $hit_count = 0;
 234
 235     ($onlist, $rule, $seq, $hit_count) = OnWhitelist($sender, $userid, 0);
 236
 237     unless ($onlist) {
 238       ($onlist, $rule, $seq, $hit_count) = OnBlacklist($sender, 0);
 239
 240       unless ($onlist) {
 241         ($onlist, $rule, $seq, $hit_count) = OnNulllist($sender, 0);
 242       } # unless
 243     } # unless
 244
 245     $hit_count //= '';
 246
 247     my $list     = '';
 248     my $sequence = 0;
 249     my $comment  = '';
 250
 251     # Parse rule
 252     if ($rule) {
 253       if ($rule =~ /\((\w+):(\d+)\)\s+"(\S*)"/) {
 254         $list     = $1;
 255         $sequence = $2;
 256         $rule     = $3;
 257         $comment  = '';
 258       } elsif ($rule =~ /\((\w+):(\d+)\)\s+"(\S*) - (.*)"/) {
 259         $list     = $1;
 260         $sequence = $2;
 261         $rule     = $3;
 262         $comment  = $4;
 263       } # if
 264
 265       $rule =~ s/\\@/\@/;
 266     } # if
 267
 268     $sequence //= 0;
 269     $next++;
 270
 271     # Start Sender line
 272     my $rowspan = @$msgs + 1;
 273
 274     print start_Tr {-valign => 'middle'};
 275     print td {
 276       -class   => $leftclass,
 277       -align   => 'right',
 278       -valign  => 'middle',
 279       -rowspan => $rowspan,
 280     }, $next,
 281       checkbox {
 282         -name   => "action$next",
 283         -label  => '',
 284         -valign => 'middle',
 285       };
 286
 287       print hidden({
 288         -name    => "email$next",
 289         -default => $sender,
 290       });
 291
 292     # Get subject line
 293     $heading = "?subject=$heading" if $heading;
 294
 295     print td {
 296       -class => $senderclass,
 297     }, a {
 298       -href  => "mailto:$sender$heading",
 299     }, "&nbsp;$sender";
 300
 301     my $listlink = ($list and $sequence) ? "$list:$sequence" : '&nbsp;';
 302
 303     print td {
 304       -class => $dataclass,
 305       -align => 'right',
 306     }, a {
 307       href  => "/maps/php/list.php?type=$list&next=" . ($sequence - 1),
 308     }, $listlink,
 309     td {
 310       -class => $dataclass,
 311       -align => 'right',
 312     }, "$hit_count&nbsp;",
 313     td {
 314       -class => $dataclass,
 315     }, $rule,
 316     td {
 317       -class => $rightclass,
 318     }, $comment;
 319     print end_Tr;
 320
 321     my $msgnbr = 0;
 322
 323     for my $rec (@$msgs) {
 324       $msgnbr++;
 325
 326       # We increased $next earlier so do not add 1 here
 327       if (($next % $lines) == (@senders % $lines)) {
 328         $dataclass    = 'tablebottomdata';
 329         $rightclass   = 'tablebottomright' if $msgnbr == @$msgs;
 330
 331         # Only subjectbottom the last message
 332         $subjectclass = 'subjectbottom' if $msgnbr == @$msgs;
 333       } # if
 334
 335       if ($date eq substr ($rec->{timestamp}, 0, 10)) {
 336         $rec->{date} = b font {-color => 'green'}, SQLDatetime2UnixDatetime $rec->{timestamp};
 337       } else {
 338         $rec->{date} = SQLDatetime2UnixDatetime $rec->{timestamp};
 339       } # if
 340
 341       $rec->{subject} //= '&lt;Unspecified&gt;';
 342       $rec->{subject} = decode_mimewords ($rec->{subject});
 343       $rec->{subject} =~ s/\>/&gt;/g;
 344       $rec->{subject} =~ s/\</&lt;/g;
 345
 346       print
 347         Tr [
 348           td {
 349             -class   => $subjectclass,
 350             -colspan => 4,
 351           }, a {
 352             -href    => "display.cgi?sender=$sender;msg_date=$rec->{timestamp}",
 353            }, '&nbsp;&nbsp;&nbsp;&nbsp;' . $rec->{subject},
 354           td {-class => $rightclass,
 355               -width => '150',
 356               -align => 'right'}, span {-class => 'date'}, $rec->{date} . '&nbsp',
 357         ];
 358     } # for
 359   } # for
 360
 361   print end_table;
 362   print end_div;
 363
 364   MakeButtons $type;
 365
 366   print end_form;
 367
 368   return;
 369 } # Body
 370
 371 # Main
 372 my $condition;
 373 my @scripts = ('ListActions.js');
 374
 375 my $heading_date =$date ne '' ? ' on ' . FormatDate ($date, 1) : '';
 376
 377 $userid = Heading(
 378   'getcookie',
 379   '',
 380   (ucfirst ($type) . ' Report'),
 381   $types{$type} [0],
 382   $types{$type} [1] . $heading_date,
 383   $table_name,
 384   @scripts
 385 );
 386
 387 $userid ||= $ENV{USER};
 388
 389 SetContext($userid);
 390 NavigationBar($userid);
 391
 392 unless ($lines) {
 393   my %options = GetUserOptions($userid);
 394   $lines = $options{'Page'};
 395 } # unless
 396
 397 if ($date eq '') {
 398   $condition .= "type = '$type'";
 399 } else {
 400   my $sod = $date . ' 00:00:00';
 401   my $eod = $date . ' 23:59:59';
 402
 403   $condition .= "type = '$type' and timestamp > '$sod' and timestamp < '$eod'";
 404 } # if
 405
 406 # Need to count distinct on sender
 407 $total = CountLogDistinct(
 408   userid     => $userid,
 409   column     => 'sender',
 410   additional => $condition,
 411 );
 412
 413 $next ||= 0;
 414
 415 $last = $next + $lines < $total ? $next + $lines : $total;
 416
 417 if (($next - $lines) > 0) {
 418   $prev = $next - $lines;
 419 } else {
 420   $prev = $next == 0 ? -1 : 0;
 421 } # if
 422
 423 Body($type);
 424
 425 Footing($table_name);
 426
 427 exit;