maps/bin/display.cgi

   1 #!/usr/bin/perl
   2 ################################################################################
   3 #
   4 # File:         $RCSfile: display.cgi,v $
   5 # Revision:     $Revision: 1.1 $
   6 # Description:  Displays an email message
   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-2006, Andrew@DeFaria.com, all rights reserved.
  13 #
  14 ################################################################################
  15 use strict;
  16 use warnings;
  17
  18 use FindBin;
  19 local $0 = $FindBin::Script;
  20
  21 use lib "$FindBin::Bin/../lib";
  22 use lib "$FindBin::Bin/../../lib";
  23
  24 use MAPS;
  25 use MAPSWeb;
  26
  27 use CGI qw/:standard *table/;
  28 use CGI::Carp "fatalsToBrowser";
  29
  30 use MIME::Parser;
  31 use MIME::Base64;
  32 use MIME::Words qw(:all);
  33
  34 my $userid = cookie('MAPSUser');
  35 my $sender = param('sender');
  36
  37 # CGI will replace '+' with ' ', which many mailers are starting to do,
  38 # so add it back
  39 $sender =~ s/ /\+/;
  40
  41 my $msg_date   = param('msg_date');
  42 my $table_name = 'message';
  43
  44 sub ParseEmail(@) {
  45   my (@header) = @_;
  46
  47   my %header;
  48
  49   # First output the header information. Note we'll skip uninteresting stuff
  50   for (@header) {
  51     last if ($_ eq '' || $_ eq "\cM");
  52
  53     # Escape "<" and ">"
  54     s/\</\&lt\;/;
  55     s/\>/\&gt\;/;
  56
  57     if (/^from:\s*(.*)/i) {
  58       $header{From} = $1;
  59     } elsif (/^subject:\s*(.*)/i) {
  60       $header{Subject} = $1;
  61     } elsif (/^date:\s*(.*)/i) {
  62       $header{date} = $1;
  63     } elsif (/^To:\s*(.*)/i) {
  64       $header{to} = $1;
  65     } elsif (/^Content-Transfer-Encoding: base64/) {
  66       $header{base64} = 1;
  67     } # if
  68   } # for
  69
  70   return %header;
  71 } # ParseEmail
  72
  73 sub Body($) {
  74   my ($date) = @_;
  75
  76   # Find unique message using $date
  77   my ($err, $msg) = FindEmail(
  78     userid    => $userid,
  79     sender    => $sender,
  80     timestamp => $date,
  81   );
  82
  83   my $rec = GetEmail;
  84
  85   my $parser = MIME::Parser->new();
  86
  87   # For some strange reason MIME::Parser has started having some problems
  88   # with writing out tmp files...
  89   $parser->output_to_core(1);
  90   $parser->tmp_to_core(1);
  91
  92   my $entity = $parser->parse_data($rec->{data});
  93
  94   my %header = ParseEmail @{($entity->header)[0]};
  95
  96   print p . "\n";
  97     print start_table ({-align        => "center",
  98                         -id           => $table_name,
  99                         -border       => 0,
 100                         -cellspacing  => 0,
 101                         -cellpadding  => 0,
 102                         -width        => "100%"});
 103     print start_table ({-align        => "center",
 104                         -bgcolor      => 'steelblue',
 105                         #-bgcolor      => "#d4d0c8",
 106                         -border       => 0,
 107                         -cellspacing  => 2,
 108                         -cellpadding  => 2,
 109                         -width        => "100%"}) . "\n";
 110     print "<tbody><tr><td>\n";
 111     print start_table ({-align        => "center",
 112                         -border       => 0,
 113                         -cellspacing  => 0,
 114                         -cellpadding  => 2,
 115                         -bgcolor      => 'black',
 116                         #-bgcolor      => "#ece9d8",
 117                         -width        => "100%"}) . "\n";
 118
 119     for (keys (%header)) {
 120       next if /base64/;
 121
 122       my $str = decode_mimewords($header{$_});
 123
 124       print Tr ([
 125         th ({-align    => 'right',
 126              -bgcolor  => 'steelblue',
 127              -style    => 'color: white',
 128              #-bgcolor  => "#ece9d8",
 129              -width    => "8%"}, ucfirst "$_:") . "\n" .
 130         td ({-bgcolor  => 'white'}, $str)
 131       ]);
 132     } # for
 133
 134     print end_table;
 135     print "</td></tr>";
 136     print end_table;
 137
 138   print start_table ({-align        => 'center',
 139                       -bgcolor      => 'steelblue',
 140                       -border       => 0,
 141                       -cellspacing  => 0,
 142                       -cellpadding  => 2,
 143                       -width        => "100%"}) . "\n";
 144   print "<tbody><tr><td>\n";
 145   print start_table ({-align        => "center",
 146                       -border       => 0,
 147                       -cellspacing  => 0,
 148                       -cellpadding  => 2,
 149                       -bgcolor      => 'white',
 150                       -width        => "100%"}) . "\n";
 151   print "<tbody><tr><td>\n";
 152
 153   my @parts = $entity->parts;
 154
 155   if (scalar @parts == 0) {
 156     if ($entity->{mail_inet_head}{mail_hdr_hash}{'Content-Transfer-Encoding'} and
 157         ${$entity->{mail_inet_head}{mail_hdr_hash}{'Content-Transfer-Encoding'}[0]} =~ /base64/) {
 158       print $entity->{ME_Bodyhandle}{MBS_Data};
 159     } else {
 160       print '<pre>';
 161       print $entity->print_body;
 162       print '</pre>';
 163     } # if
 164   } else {
 165     for my $part ($entity->parts) {
 166       # We assume here that if this part is multipart/alternative then
 167       # there exists at least one part that is text/html and we favor
 168       # that (since we're outputing to a web page anyway...
 169       if ($part->mime_type eq 'multipart/alternative') {
 170         for my $subpart ($part->parts) {
 171           if ($subpart->mime_type eq 'text/html') {
 172             # There should be an easier way to get this but I couldn't find one.
 173             my $encoding = ${$subpart->{mail_inet_head}{mail_hdr_hash}{'Content-Transfer-Encoding'}[0]};
 174             if ($encoding =~ /base64/) {
 175               $subpart->bodyhandle->print;
 176             } else {
 177               print $subpart->print_body;
 178             } # if
 179             last;
 180           } elsif ($subpart->mime_type eq 'multipart/related') {
 181             # This is stupid - multipart/related? When it's really just HTML?!?
 182             $subpart->print_body;
 183             last;
 184           } # if
 185         } # for
 186       } elsif ($part->mime_type eq 'multipart/related') {
 187         # Sometimes parts are 'multipart/relative'...
 188         $part->print_body;
 189       } else {
 190         if ($part->mime_type =~ /text/) {
 191           my $encoding = '';
 192
 193           $encoding = ${$part->{mail_inet_head}{mail_hdr_hash}{'Content-Transfer-Encoding'}[0]}
 194             if $part->{mail_inet_head}{mail_hdr_hash}{'Content-Transfer-Encoding'};
 195
 196           if ($encoding =~ /base64/) {
 197             $part->bodyhandle->print();
 198           } else {
 199             print '<pre>';
 200             print $part->print_body;
 201             print '</pre>';
 202           } # if
 203         } # if
 204       } # if
 205     } # for
 206   } # if
 207
 208   print "</td></tr>\n";
 209   print end_table;
 210   print "</td></tr>\n";
 211   print end_table;
 212   print end_table;
 213 } # Body
 214
 215 $userid = Heading(
 216   'getcookie',
 217   '',
 218   "Email message from $sender",
 219   "Email message from $sender",
 220   '',
 221   $table_name,
 222 );
 223
 224 $userid //= $ENV{USER};
 225
 226 SetContext($userid);
 227 NavigationBar($userid);
 228
 229 Body($msg_date);
 230
 231 Footing($table_name);