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