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