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