print.html from AlphaMail at Krugle

Show print.html syntax highlighted

% # vim: set syntax=mason:
<%args>
$folder
$uid
$uidv
$sorted_offset
$sortby
$full_headers => 0
$n => 20
</%args>
<html>
   <head>
      <title><% $header->{subject} |h %></title>
   </head>
   <body>
      <table class="message_display">
         <tr>
            <td class="messageHeader">
% if(!$full_headers) {
               <b>Subject:</b> <% $header->{subject} |h %>
               <br><b>To:</b> <% $header->{to} |h %>
%     if(defined($header->{cc}) && $header->{cc} ne "") {
               <br><b>Cc:</b> <% $header->{cc} |h %>
%     }
               <br><b>From:</b> <% $header->{from} |h %>
               <br><b>Date:</b> <% $header->{date} |h %>
% } else {
               <pre>
<% $header->{full_header} %> 
               </pre>
% }
            </td>
         </tr><tr>
            <td>
	      <div class="messageBody">
                <pre>
<% wrap('','', main_body($inline)) |h %>
                </pre>
	      </div>	
            </td>
         </tr>
      </table>
   </body>
</html>
<%init>
my $user = Apache::SiteControl->getCurrentUser($r);
my $manager = Apache::SiteControl->getPermissionManager($r);
my $logger = Log::Log4perl->get_logger('alphamail');
my $c;
my $error = 0;
my $message;
my $parser = new MIME::Parser;
my $entity;
my $headers;
my $msgcnt;
my $uidvalidity;
my $filename;
my $key;

my $attachments = [];
my $inline = [];
my $header = {};
my $cachetime = $config->get("message_tmpdir_cachetime", 10) . ' min';

# Flags
my ($deleted, $replied, $forwarded);

$user->setAttribute($r, 'reading_folder', $folder);
$user->setAttribute($r, 'reading_uid', $uid);
$user->setAttribute($r, 'reading_uidv', $uidv);
$user->setAttribute($r, 'reading_offset', $sorted_offset);
$user->setAttribute($r, 'reading_sortby', $sortby);

my $dir = $config->get("message_tmpdir", '/tmp') . "/" .  
          $user->getAttribute('imap') .  "_" . $user->getUsername();

eval {
   if(!-d $dir) {
      mkdir $dir or die "Could not create temporary storage for message: $dir.";
   }

   $c = new AlphaMail::Middleware($user->getAttribute('imap'),
                                  $user->getUsername(),
                                  $user->getAttribute('password'),
                                  $config);

   $key = $user->getUsername() . $user->getAttribute('imap') .
             $folder . $uid . $uidv;
   # We only cache the message and its parsed form, because uidv could
   # change, and we have to know that at every request for reliability.
   $message = $m->cache->get($key);
   if(!defined($message)) {
      $message = $c->getMessage($folder, $uid, $uidv);
      $m->cache->set($key, $message, $cachetime);
      $logger->debug("Read message from server");
   } else {
      $logger->debug("Read message from cache");
   }
   if($sorted_offset > 1) {
      $headers = $c->getMessageHeaders($folder, $sorted_offset-1, 3, $sortby);
      $deleted = $headers->[1]{deleted};
      $replied = $headers->[1]{answered};
      $forwarded = 0;
   } else {
      $headers = $c->getMessageHeaders($folder, $sorted_offset, 2, $sortby);
      $deleted = $headers->[0]{deleted};
      $replied = $headers->[0]{answered};
      $forwarded = 0;
   }
   $msgcnt = $headers->[0]{count};
   $uidvalidity = $headers->[0]{uidvalidity};

   $key = $user->getUsername() . "_" . $user->getAttribute('mx') . "_${folder}_${uid}_${uidv}_${sorted_offset}_${sortby}_${full_headers}_${n}";
   my $data_cache = $m->cache->get($key);
   if(!defined($data_cache)) {
      $parser = new MIME::Parser;
      $parser->output_dir($dir);
      $parser->decode_headers(0);
      $parser->ignore_errors(0);
      $entity = $parser->parse_open("<$message");
      parse_entity($entity, "", "", $inline, $attachments, $header);
      $data_cache = {
         inline => $inline,
         attachments => $attachments,
         header => $header
      };
      $m->cache->set($key, $data_cache, $cachetime);
   } else {
      $inline = $data_cache->{inline};
      $attachments = $data_cache->{attachments};
      $header = $data_cache->{header};
   }

   $c->close;
};
if($@) {
   $logger->error("print.html failed: $@");
   $error = $@;
}

$m->redirect('/mail/index.html') if $error;


</%init>
<%once>
use Encode;
use Text::Wrap qw(wrap);

$Text::Wrap::columns = $config->get('textwrap_columns', 80);

sub parse_entity {
   my ($entity, $name, $charset, $inline_parts, $attachments, $header) = @_;
   defined($name) or $name = "'anonymous'";
   my $result = {};

   # TODO: Clean this charset crap up
   $charset = $result->{charset} = 
      lc($entity->head->mime_attr('content-type.charset')) || 'us-ascii';

   if($entity->head->get('Subject')) {
      $header->{subject} = AlphaMail::Middleware::_mimewords_to_utf8(
         $entity->head->get('Subject'));
      $header->{date} = AlphaMail::Middleware::_mimewords_to_utf8(
         $entity->head->get('Date'));
      $header->{from} = AlphaMail::Middleware::_mimewords_to_utf8(
         $entity->head->get('From'));
      $header->{to} = AlphaMail::Middleware::_mimewords_to_utf8(
         $entity->head->get('To'));
      $header->{cc} = AlphaMail::Middleware::_mimewords_to_utf8(
         $entity->head->get('Cc'));
      $header->{full_header} = AlphaMail::Middleware::_mimewords_to_utf8(
         $entity->head->as_string);
   }

   my @parts = $entity->parts;
   if (@parts) {
      my $i;
      foreach $i (0 .. $#parts) {
         parse_entity($parts[$i], "", $charset, $inline_parts, $attachments);
      }
   } else {
      $result->{disposition} = $entity->head->mime_attr('content-disposition');
      $result->{recommended_filename} = $entity->head->recommended_filename;
      ($result->{type}, $result->{subtype}) = split('/', $entity->head->mime_type);
      $result->{body} = $entity->bodyhandle;
      my $path = $result->{body}->path;
      my $size = ($path ? (-s $path) : '???');
      $result->{path} = $path;
      $result->{size} = $size;

      if($result->{type} eq 'text' && $result->{subtype} eq 'plain') {
         push @$inline_parts, $result;
      } elsif($result->{type} eq 'text' && $result->{subtype} eq 'html') {
         push @$inline_parts, $result;
         $result->{recommended_filename} = 'HTML message' if(length($result->{recommended_filename}) < 1);
         push @$attachments, $result;
      } else {
         push @$attachments, $result;
      }
   }
}

sub main_body
{
   my $inline_parts = shift;
   my $attachments = shift;
   my $result = '';
   my $show_separator = 0;
   my $IO;
   my $elinks = $config->get('elinks', "/usr/bin/elinks");

   return '' if((!defined($inline_parts) || !@$inline_parts) && (!defined($attachments) || !@$attachments));

   $show_separator = 1 if($#$inline_parts > 0);

   for my $part (@$inline_parts) {
      if($part->{subtype} eq 'html') {
         $result .= "NOTE: The following part of this message was originally in HTML. The primary text has been sanitized of images and potentially harmful code, but should still be readable. If you want to view the original message you can use the link in the attachment section at the bottom.\n\n";
         my @lines = qx($elinks -no-home 1 -dump $part->{path});
         for my $l (@lines) {
            $l =~ s/^\s*//;
            $result .= $l;
         }
      } else {
         my $body = $part->{body};
         if ($IO = $body->open("r")) {
            while (defined($_ = $IO->getline)) {
               eval {
                  $result .= decode($part->{charset}, $_);
               };
               if($@) {
                  $result .= $_;
               }
            }
         }
         $IO->close;
      }
      if($show_separator) {
         $result .= "\n\n" . "-" x 72 . "\n";
         $show_separator++;
      }
   }

   return $result;
}
</%once>
See more files for this project here