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 %>
<br><a href="/mail/print.html?folder=<% $folder |u %>&uid=<% $uid %>&uidv=<% $uidv %>&sortby=<% $sortby %>&sorted_offset=<% $sorted_offset %>&full_headers=1">more headers...</a>
% } else {
<pre>
<% $header->{full_header} %>
</pre>
<br><a href="/mail/print.html?folder=<% $folder |u %>&uid=<% $uid %>&uidv=<% $uidv %>&sortby=<% $sortby %>&sorted_offset=<% $sorted_offset %>">minimum headers</a>
% }
</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 $attachments = [];
my $inline = [];
my $header = {};
# 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);
eval {
$message = $c->getMessage($folder, $uid, $uidv);
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};
};
if($@) {
$logger->debug("Failed to get message from server: $@");
$error = 1;
}
$parser->output_under($dir);
$parser->decode_headers(0);
$parser->ignore_errors(0);
$entity = $parser->parse_open("<$message");
parse_entity($entity, "", "", $inline, $attachments, $header);
$c->close;
};
if($@) {
$logger->error("Read 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;
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(/usr/bin/lynx -verbose -nolist -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