diff options
Diffstat (limited to 'exilog_cgi_html.pm')
| -rw-r--r-- | exilog_cgi_html.pm | 984 |
1 files changed, 0 insertions, 984 deletions
diff --git a/exilog_cgi_html.pm b/exilog_cgi_html.pm deleted file mode 100644 index f42b795..0000000 --- a/exilog_cgi_html.pm +++ /dev/null @@ -1,984 +0,0 @@ -#!/usr/bin/perl -w -# -# This file is part of the exilog suite. -# -# http://duncanthrax.net/exilog/ -# -# (c) Tom Kistner 2004 -# -# See LICENSE for licensing information. -# - -package exilog_cgi_html; -use exilog_config; -use exilog_util; -use CGI; -use strict; -use Data::Dumper; - -BEGIN { - use Exporter; - use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS); - - $VERSION = 0.1; - @ISA = qw(Exporter); - @EXPORT = qw( - &render_message - &render_reject - &render_queue - &render_header - &render_server - &render_queue_table - $q - - ); - - %EXPORT_TAGS = (); - @EXPORT_OK = qw(); - - use vars qw( $q ); -} - -$q = new CGI; - -# Renders server statistics -# $stats->{ID}->{order} -# ->{desc} -# ->{icon} -# ->{text} - -sub render_server { - my $server = shift; - my $num_queued = shift; - my $h24_stats = shift; - - $q->div({-class=>"top_spacer"}, - $q->table({-class=>"stats", -cellspacing=>1, -cellpadding=>2, -border=>0}, - $q->Tr( - $q->td({-rowspan=>2,-class=>"table_stats",-style=>"width: 300px;"}, - $q->table({-cellpadding=>0, -cellspacing=>0, -border=>0}, - $q->Tr( - $q->td({-class=>"large_icon"}, - $q->img({-src=>"icons/server_normal.png",-border=>0}) - ), - $q->td({-class=>"large_text"}, - $server - ) - ) - ) - ), - $q->td({-class=>"table_stats"}, - $q->table({-cellpadding=>0, -cellspacing=>0, -border=>0, -width=>"1%"}, - $q->Tr( - $q->td({-rowspan=>2,-class=>"large_icon"}, - $q->img({-src=>"icons/queue_normal.png",-border=>0,-title=>"Queue Status"}) - ), - $q->td({-rowspan=>2,-class=>"large_icon"}, - "<b>Queue Status</b>" - ), - $q->td({-class=>"stats"}, - _item( { 'icon' => "icons/queued.png" }, - { - #'link' => { 'tab' => 'queues' }, - 'text' => ($num_queued->{deferred}+$num_queued->{frozen})." queued (".($num_queued->{deferred_bounce}+$num_queued->{frozen_bounce})." bounces)" } ) - - ), - $q->td({-class=>"stats"}, - ( $num_queued->{deferred} ? - _item( { 'icon' => "icons/deferred.png" }, - { 'text' => $num_queued->{deferred}." deferred (".$num_queued->{deferred_bounce}." bounces)" } ) - : - " " - ) - ) - ), - $q->Tr( - $q->td({-class=>"stats"}, - ( $num_queued->{frozen} ? - _item( { 'icon' => "icons/frozen.png" }, - { 'text' => $num_queued->{frozen}." frozen (".$num_queued->{frozen_bounce}." bounces)" } ) - : - " " - ) - ) - ) - ) - ) - ), - $q->Tr( - $q->td({-class=>"table_stats"}, - $q->table({-cellpadding=>0, -cellspacing=>0, -border=>0, -width=>"1%"}, - $q->Tr( - $q->td({-rowspan=>2,-class=>"large_icon"}, - $q->img({-src=>"icons/stats_h24.png",-border=>0,-title=>"Usage Statistics"}) - ), - $q->td({-rowspan=>2,-class=>"large_icon"}, - "<b>Last 24h stats</b>" - ), - $q->td({-class=>"stats"}, - _item( { 'icon' => "icons/arrival.png", 'title' => "Arrivals" }, - { 'text' => $h24_stats->{arrivals}." arrivals" } ) - ), - $q->td({-class=>"stats"}, - _item( { 'icon' => "icons/size.png", 'title' => "Average message size" }, - { 'text' => "Average message size: ".human_size($h24_stats->{avg_msg_size}) } ) - ) - ), - $q->Tr( - $q->td({-class=>"stats"}, - _item( { 'icon' => "icons/delivery.png" }, - { 'text' => $h24_stats->{deliveries}." deliveries" } ) - ), - $q->td({-class=>"stats"}, - _item( { 'icon' => "icons/error.png" }, - { 'text' => $h24_stats->{errors}." errors" } ) - ) - ) - ) - ) - ) - ) - ); - -}; - - -# Renders messages and post-DATA rejects. - -sub render_message { - my $h = shift; # main message context - - # Subclass list with references to HTML generation code. - my $subclasses = { 'rejects' => \&_reject_html, - 'deferrals' => \&_deferral_html, - 'errors' => \&_error_html, - 'deliveries' => \&_delivery_html, - 'unknown' => \&_unknown_html, - 'queue' => \&_queue_html }; - - my $sort_pref = { 'rejects' => 5, - 'deferrals' => 4, - 'errors' => 3, - 'deliveries' => 6, - 'unknown' => 2, - 'queue' => 1 }; - - my @dde = (); # holds list of subclass hashrefs - # --->{html} (HTML code generated by ) - # \->{timestamp} (timestamp for sorting later) - - # Now loop through the subclass list and call HTML - # generation code for each entry in all subclasses. - # Push the stuff onto dde where we can sort it later. - # Remember the timestamp of each entry so we can sort - # by it later to display the message events in the - # right order. - foreach my $subclass (keys %{ $subclasses }) { - foreach my $obj (@{ $h->{$subclass} }) { - my $tmp = {}; - $tmp->{timestamp} = $obj->{timestamp}; - $tmp->{sort_pref} = $sort_pref->{$subclass}; - # pass in "master sort" timestamp too - $tmp->{html} = &{$subclasses->{$subclass}}($obj,$h->{sort_timestamp}); - push @dde, $tmp; - }; - }; - - $q->div({-class=>"top_spacer"}, - $q->table({-class=>"message", -cellspacing=>1, -cellpadding=>2, -border=>0}, - _titlebar_html($h), - (exists($h->{mailfrom}) ? _message_html($h) : ""), - eval { - my $event_html = ""; - foreach my $event (sort by_event_order @dde) { - $event_html .= $event->{html}; - }; - $event_html; - } - ) - ); -}; -sub by_event_order { - if ($a->{timestamp} == $b->{timestamp}) { - ($a->{sort_pref} <=> $b->{sort_pref}); - } - else { - ($a->{timestamp} <=> $b->{timestamp}); - }; -}; - - -# This function is used to render pre-DATA rejects. -# Since those don't have any other associated events -# it is useless to go through all other tables like -# _render_message does. - -sub render_reject { - my $h = shift; - $q->div({-class=>"top_spacer"}, - $q->table({-class=>"message", -cellspacing=>1, -cellpadding=>2, -border=>0}, - _titlebar_html($h). - _reject_html($h,$h->{timestamp}) - ) - ); -}; - - -# renders a small "page header" - -sub render_header { - my $text = shift || ""; - - $q->div({-class=>"top_spacer"}, - $q->table({-class=>"header", -cellspacing=>1, -cellpadding=>2, -border=>0}, - $q->Tr( - $q->td({-class=>"header"}, - $text - ) - ) - ) - ); -} - - - -sub _titlebar_html { - my $h = shift || {}; - - my $actions = [ 0, 'deliver' ]; - unless (ina($config->{web}->{restricted_users}, $main::user)) { - if ($h->{mailfrom} ne '<>') { - push @{$actions}, 'cancel'; - } - push @{$actions}, 'delete'; - } - - $q->Tr( - $q->td({-class=>"table_titlebar"}, - $q->table({-cellpadding=>0,-cellspacing=>0, -border=>0}, - $q->Tr( - $q->td({-class=>"message_wide"}, - _item( { 'text' => $h->{server} }, - ( (edv($h,'message_id') && ($h->{message_id} =~ /^.{6}\-.{6}-.{2}$/) ) ? - { 'text' => '·' } : undef ), - ( (edv($h,'message_id') && ($h->{message_id} =~ /^.{6}\-.{6}-.{2}$/) ) ? - { 'link' => { 'tab' => 'messages', - 'tr' => '0', - 'qt' => 'message_id', - 'qs' => $h->{message_id} }, - 'text' => $h->{message_id} } : undef ), - ( edv($h,'msgid') ? { 'text' => '·' } : undef ), - ( edv($h,'msgid') ? ({ 'link' => { 'tab' => 'messages', - 'qt' => 'msgid', - 'tr' => '0', - 'qs' => $h->{msgid} }, - 'text' => "Track MSGID" }) : undef ), - ( (edv($h,'queue') && - defined(@{$h->{queue}}[0])) ? { 'text' => '·' } : undef ), - ( (edv($h,'queue') && - defined(@{$h->{queue}}[0])) ? { 'html' => $q->popup_menu({ - -name => 'ac_'.$h->{server}.'_'.$h->{'message_id'}, - -values => $actions, - -default => 0, - -labels => { 0 => ':: Please select action ::', - 'deliver' => 'Force delivery', - 'cancel' => 'Cancel (bounce)', - 'delete' => 'Delete' }, - -override => 1 - }).$q->submit({-name=>'Go'}) - } : undef ) ) - ), - (exists($h->{size}) ? - $q->td({-class=>"message"}, - _item( { 'icon' => "icons/size.png" }, - { 'text' => human_size($h->{size})} ) - ) : ""), - (exists($h->{completed}) ? - $q->td({-class=>"message"}, - _item( { 'icon' => "icons/stopwatch.png"}, - { 'text' => _timespan((defined($h->{completed}) ? $h->{completed} : time()) - $h->{timestamp} ) } ) - ) : "") - ) - ) - ) - ); -}; - - -sub _message_html { - my $h = shift || {}; - - $q->Tr( - $q->td({-class=>"table_arrival"}, - $q->table({-cellpadding=>0,-cellspacing=>0, -border=>0}, - $q->Tr( - $q->td({-rowspan=>2,-valign=>"top",-align=>"center",-class=>"large_icon"}, - ( ($h->{proto} =~ /local/i) ? - # local - $q->img({-src=>"icons/arrival_local.png",-border=>0,-title=>uc($h->{proto})." | ".$h->{user}}) - : - ( ( ($h->{proto} eq "asmtp") || ($h->{proto} =~ /a$/) ) ? - ( defined($h->{tls_cipher}) ? - # Auth w/ TLS - $q->img({-src=>"icons/arrival_tls_auth.png",-border=>0,-title=>uc($h->{proto})." | ".$h->{user}." | ".$h->{tls_cipher}}) - : - # Auth w/o TLS - $q->img({-src=>"icons/arrival_auth.png",-border=>0,-title=>uc($h->{proto})." | ".$h->{user}}) - ) - : - ( defined($h->{tls_cipher}) ? - # TLS - $q->img({-src=>"icons/arrival_tls.png",-border=>0,-title=>uc($h->{proto})." | ".$h->{tls_cipher}}) - : - # nothing special - $q->img({-src=>"icons/arrival_normal.png",-border=>0,-title=>uc($h->{proto})}) - ) - ) - ) - ), - $q->td( - _item( { 'style' => "font-weight: bold;", - ( ($h->{mailfrom} eq '<>') ? - ( (defined($h->{bounce_parent}) ? - ('link' => { 'tab' => 'messages', - 'tr' => '0', - 'qt' => 'message_id', - 'qs' => $h->{bounce_parent} }) - : () ), - 'text' => "Bounce". - (defined($h->{bounce_parent}) ? - " of ".$h->{bounce_parent} - : - "" - ) - ) - : - ('link' => { 'tab' => 'messages', - 'tr' => '0', - 'qt' => 'addr-all', - 'qs' => $h->{mailfrom} }, - 'text' => $h->{mailfrom}) - ) } - ) - ) - ), - $q->Tr( - $q->td( - _item( { 'style' => (($h->{timestamp} == $h->{sort_timestamp}) ? "text-decoration: underline;" : undef) , 'text' => stamp_to_date($h->{timestamp}) }, - (defined($h->{host_addr}) ? ( - { 'icon' => "icons/server.png" }, - { 'link' => { 'tab' => 'messages', - 'tr' => '0', - 'qt' => 'host-all', - 'qs' => $h->{host_addr} }, - 'text' => $h->{host_addr} }, - (edt($h,'host_rdns') ? - ( { 'icon' => "icons/dns.png" }, - { 'link' => { 'tab' => 'messages', - 'tr' => '0', - 'qt' => 'host-all', - 'qs' => $h->{host_rdns} }, - 'text' => $h->{host_rdns} } ) - : - () - ), - (edt($h,'host_helo') ? - ( { 'icon' => "icons/helo.png" }, - { 'link' => { 'tab' => 'messages', - 'tr' => '0', - 'qt' => 'host-all', - 'qs' => $h->{host_helo} }, - 'text' => $h->{host_helo} } ) - : - () - ), - (defined($h->{host_ident}) ? ( - { 'icon' => "icons/ident.png" }, - { 'link' => { 'tab' => 'messages', - 'tr' => '0', - 'qt' => 'ident', - 'qs' => $h->{host_ident} }, - 'text' => $h->{host_ident} } ) - : () ) - ) - : () ) ) - ) - ) - ) - ) - ); -}; - -sub _deferral_html { - my $deferral = shift || {}; - my $sort_timestamp = shift || 0; - - $q->Tr( - $q->td({-class=>"table_deferral"}, - $q->table({-cellpadding=>0,-cellspacing=>0, -border=>0}, - $q->Tr( - $q->td({-rowspan=>3,-valign=>"top",-align=>"center",-class=>"large_icon"}, - ( defined($deferral->{tls_cipher}) ? - # w/ TLS - $q->img({-src=>"icons/deferral_tls.png",-border=>0,-title=>$deferral->{tls_cipher}}) - : - # w/o TLS - $q->img({-src=>"icons/deferral_normal.png",-border=>0}) - ) - ), - $q->td( - _item( { 'style' => "font-weight: bold;", - 'link' => { 'tab' => 'messages', - 'tr' => '0', - 'qt' => 'addr-all', - 'qs' => $deferral->{rcpt} }, - 'text' => $deferral->{rcpt} }, - (edt($deferral,'rcpt_intermediate') ? - ({ 'text' => '-> '.$deferral->{rcpt_intermediate} }) - : - () - ), - ((lc($deferral->{rcpt}) ne lc($deferral->{rcpt_final})) ? - ({ 'link' => { 'tab' => 'messages', - 'tr' => '0', - 'qt' => 'addr-all', - 'qs' => $deferral->{rcpt_final} }, - 'text' => '-> '.$deferral->{rcpt_final} }) - : - () - ) - ) - ) - ), - $q->Tr( - $q->td( - _item( { 'style' => (($deferral->{timestamp} == $sort_timestamp) ? "text-decoration: underline;" : undef) , 'text' => stamp_to_date($deferral->{timestamp}) }, - { 'icon' => "icons/router_transport.png" }, - { 'text' => $deferral->{router}. - ( defined($deferral->{transport}) ? - "->".$deferral->{transport}.(defined($deferral->{shadow_transport}) ? " [".$deferral->{shadow_transport}."]" : "") - : - "") }, - ( defined($deferral->{host_addr}) ? - ( { 'icon' => "icons/server.png" }, - { 'link' => { 'tab' => 'messages', - 'tr' => '0', - 'qt' => 'host-all', - 'qs' => $deferral->{host_addr} }, - 'text' => $deferral->{host_addr} }, - { 'icon' => "icons/dns.png" }, - { 'link' => { 'tab' => 'messages', - 'tr' => '0', - 'qt' => 'host-all', - 'qs' => $deferral->{host_dns} }, - 'text' => $deferral->{host_dns} } ) - : - () - ) ) - ) - ), - $q->Tr( - $q->td( - _item( { 'icon' => "icons/errmsg.png" }, - { 'text' => $deferral->{errmsg} } ) - ) - ) - ) - ) - ); -}; - -sub _reject_html { - my $reject = shift || {}; - my $sort_timestamp = shift || 0; - - $q->Tr( - $q->td({-class=>"table_reject"}, - $q->table({-cellpadding=>0,-cellspacing=>0,-border=>0}, - $q->Tr( - $q->td({-rowspan=>2,-valign=>"top",-align=>"center",-class=>"large_icon"}, - (edv($reject,'message_id') ? - # post-DATA - $q->img({-src=>"icons/reject_postdata.png",-border=>0}) - : - # pre-DATA - $q->img({-src=>"icons/reject_predata.png",-border=>0}) - ) - ), - $q->td( - _item( (edv($reject,'mailfrom') ? - (($reject->{mailfrom} eq '<>') ? - { 'style' => "font-weight: bold;", - 'text' => "Bounce" } - : - { 'link' => { 'tab' => 'messages', - 'tr' => '0', - 'qt' => 'addr-all', - 'qs' => $reject->{mailfrom} }, - 'style' => "font-weight: bold;", - 'text' => $reject->{mailfrom} } - ) - : - () ), - { 'icon' => "icons/server.png" }, - { 'link' => { 'tab' => 'messages', - 'tr' => '0', - 'qt' => 'host-all', - 'qs' => $reject->{host_addr} }, - 'text' => $reject->{host_addr} }, - (edt($reject,'host_rdns') ? - ( { 'icon' => "icons/dns.png" }, - { 'link' => { 'tab' => 'messages', - 'tr' => '0', - 'qt' => 'host-all', - 'qs' => $reject->{host_rdns} }, - 'text' => $reject->{host_rdns} } ) - : - () - ), - (edt($reject,'host_helo') ? - ( { 'icon' => "icons/helo.png" }, - { 'link' => { 'tab' => 'messages', - 'tr' => '0', - 'qt' => 'host-all', - 'qs' => $reject->{host_helo} }, - 'text' => $reject->{host_helo} } ) - : - () - ), - (defined($reject->{host_ident}) ? - ( { 'icon' => "icons/ident.png" }, - { 'link' => { 'tab' => 'messages', - 'tr' => '0', - 'qt' => 'ident', - 'qs' => $reject->{host_ident} }, - 'text' => $reject->{host_ident} } ) : () - ) ) - ) - ), - $q->Tr( - $q->td( - _item( { 'style' => (($reject->{timestamp} == $sort_timestamp) ? "text-decoration: underline;" : undef) , 'text' => stamp_to_date($reject->{timestamp}) }, - { 'icon' => "icons/errmsg.png" }, - { 'text' => $reject->{errmsg} } ) - ) - ) - ) - ) - ); -}; - -sub _error_html { - my $error = shift || {}; - my $sort_timestamp = shift || 0; - - $q->Tr( - $q->td({-class=>"table_error"}, - $q->table({-cellpadding=>0,-cellspacing=>0, -border=>0}, - $q->Tr( - $q->td({-rowspan=>3,-valign=>"top",-align=>"center",-class=>"large_icon"}, - ( defined($error->{tls_cipher}) ? - # w/ TLS - $q->img({-src=>"icons/error_tls.png",-border=>0,-title=>$error->{tls_cipher}}) - : - # w/o TLS - $q->img({-src=>"icons/error_normal.png",-border=>0}) - ) - ), - $q->td( - _item( { 'style' => "font-weight: bold;", - 'link' => { 'tab' => 'messages', - 'tr' => '0', - 'qt' => 'addr-all', - 'qs' => $error->{rcpt} }, - 'text' => $error->{rcpt} }, - (edt($error,'rcpt_intermediate') ? - ({ 'text' => '-> '.$error->{rcpt_intermediate} }) - : - () - ), - ((lc($error->{rcpt}) ne lc($error->{rcpt_final})) ? - ({ 'link' => { 'tab' => 'messages', - 'tr' => '0', - 'qt' => 'addr-all', - 'qs' => $error->{rcpt_final} }, - 'text' => '-> '.$error->{rcpt_final} }) - : - () - ) - ) - ) - ), - $q->Tr( - $q->td( - _item( { 'style' => (($error->{timestamp} == $sort_timestamp) ? "text-decoration: underline;" : undef) , 'text' => stamp_to_date($error->{timestamp}) }, - ( edv($error,'router') ? ( - { 'icon' => "icons/router_transport.png" }, - { 'text' => $error->{router}. - ( defined($error->{transport}) ? - "->".$error->{transport}.(defined($error->{shadow_transport}) ? " [".$error->{shadow_transport}."]" : "") - : - "") }, - ( defined($error->{host_addr}) ? - ( { 'icon' => "icons/server.png" }, - { 'link' => { 'tab' => 'messages', - 'tr' => '0', - 'qt' => 'host-all', - 'qs' => $error->{host_addr} }, - 'text' => $error->{host_addr} }, - { 'icon' => "icons/dns.png" }, - { 'link' => { 'tab' => 'messages', - 'tr' => '0', - 'qt' => 'host-all', - 'qs' => $error->{host_dns} }, - 'text' => $error->{host_dns} } ) - : - () - ) ) : () ) ) - ) - ), - $q->Tr( - $q->td( - _item( { 'icon' => "icons/errmsg.png" }, - { 'text' => $error->{errmsg} } ) - ) - ) - ) - ) - ); -}; - -sub _delivery_html { - my $delivery = shift || {}; - my $sort_timestamp = shift || 0; - - $q->Tr( - $q->td({-class=>"table_delivery"}, - $q->table({-cellpadding=>0,-cellspacing=>0, -border=>0}, - $q->Tr( - $q->td({-rowspan=>2,-valign=>"top",-align=>"center",-class=>"large_icon"}, - ( defined($delivery->{tls_cipher}) ? - # w/ TLS - $q->img({-src=>"icons/delivery_tls.png",-border=>0,-title=>$delivery->{tls_cipher}}) - : - # w/o TLS - $q->img({-src=>"icons/delivery_normal.png",-border=>0}) - ) - ), - $q->td( - _item( { 'style' => "font-weight: bold;", - 'link' => { 'tab' => 'messages', - 'tr' => '0', - 'qt' => 'addr-all', - 'qs' => $delivery->{rcpt} }, - 'text' => $delivery->{rcpt} }, - (edt($delivery,'rcpt_intermediate') ? - ({ 'text' => '-> '.$delivery->{rcpt_intermediate} }) - : - () - ), - ((lc($delivery->{rcpt}) ne lc($delivery->{rcpt_final})) ? - ({ 'link' => { 'tab' => 'messages', - 'tr' => '0', - 'qt' => 'addr-all', - 'qs' => $delivery->{rcpt_final} }, - 'text' => '-> '.$delivery->{rcpt_final} }) - : - () - ) - ) - ) - ), - $q->Tr( - $q->td( - _item( { 'style' => (($delivery->{timestamp} == $sort_timestamp) ? "text-decoration: underline;" : undef) , 'text' => stamp_to_date($delivery->{timestamp}) }, - { 'icon' => "icons/router_transport.png" }, - { 'text' => $delivery->{router}. - ( defined($delivery->{transport}) ? - "->".$delivery->{transport}.(defined($delivery->{shadow_transport}) ? " [".$delivery->{shadow_transport}."]" : "") - : - "") }, - ( defined($delivery->{host_addr}) ? - ( { 'icon' => "icons/server.png" }, - { 'link' => { 'tab' => 'messages', - 'tr' => '0', - 'qt' => 'host-all', - 'qs' => $delivery->{host_addr} }, - 'text' => $delivery->{host_addr} }, - { 'icon' => "icons/dns.png" }, - { 'link' => { 'tab' => 'messages', - 'tr' => '0', - 'qt' => 'host-all', - 'qs' => $delivery->{host_dns} }, - 'text' => $delivery->{host_dns} } ) - : - () - ) ) - ) - ) - ) - ) - ); -}; - -sub _unknown_html { - my $unknown = shift || {}; - my $sort_timestamp = shift || 0; - - $q->Tr( - $q->td({-class=>"table_unknown"}, - $q->table({-cellpadding=>0,-cellspacing=>0, -border=>0}, - $q->Tr( - $q->td({-valign=>"top",-align=>"center",-class=>"large_icon"}, - $q->img({-src=>"icons/unknown.png",-border=>0}) - ), - $q->td( - _item( { 'style' => (($unknown->{timestamp} == $sort_timestamp) ? "text-decoration: underline;" : undef) , 'text' => stamp_to_date($unknown->{timestamp}) }, - { 'text' => $unknown->{line} } ) - ) - ) - ) - ) - ); -}; - -sub _queue_html { - my $queue = shift || {}; - my $sort_timestamp = shift || 0; - - my @recipients_delivered = split / /, $queue->{recipients_delivered}; - my @recipients_pending = split / /, $queue->{recipients_pending}; - - $q->Tr( - $q->td({-class=>"table_queue"}, - $q->table({-cellpadding=>0,-cellspacing=>0, -border=>0}, - $q->Tr( - $q->td({-rowspan=>2,-valign=>"top",-align=>"center",-class=>"large_icon"}, - ( edt($queue,'frozen') ? - # frozen - $q->img({-src=>"icons/queue_frozen.png",-border=>0,-title=>"Frozen at ".stamp_to_date($queue->{frozen})}) - : - # normal - $q->img({-src=>"icons/queue_deferred.png",-border=>0}) - ) - ), - $q->td( - _item( { #'style' => "font-family: Arial, Helvetica, Sans-Serif;", - 'text' => $queue->{subject} } ) - ) - ), - $q->Tr( - $q->td( - _item( { 'icon' => "icons/delivered.png", - ( (scalar @recipients_delivered) ? - ( 'title' => join("\n",@recipients_delivered) ) - : - () - ) }, - { 'text' => scalar @recipients_delivered }, - { 'text' => ' ' }, - { 'icon' => "icons/deferred.png", - 'title' => join("\n",@recipients_pending) }, - { 'text' => scalar @recipients_pending }, - { 'text' => ' ' }, - { 'icon' => "icons/dsn_warning.png", - 'title' => "Number of DSNs sent" }, - { 'text' => $queue->{num_dsn} } ) - ) - ) - ) - ) - ); -}; - -sub render_queue_table { - my $messages = shift; - my $now = time(); - - my $rows = ""; - foreach my $message (@{ $messages }) { - my $row_id = $message->{server}.'_'.$message->{message_id}; - my @rcpts_delivered = split / /,$message->{recipients_delivered}; - my @rcpts_pending = split / /,$message->{recipients_pending}; - $rows .= - $q->Tr( - $q->td({-class=>"queue"}, - # Actions - ), - $q->td({-class=>"queue"}, - $message->{server} - ), - $q->td({-class=>"queue"}, - edt($message,'timestamp') ? - _timespan($now - $message->{timestamp}) - : - '?' - ), - $q->td({-class=>"queue"}, - _shorten_addr($message->{mailfrom},40) - ), - $q->td({-class=>"queue", - -onMouseOver=>"javascript:document.getElementById('$row_id' + '_pending').style.visibility = 'visible';", - -onMouseOut=>"javascript:document.getElementById('$row_id' + '_pending').style.visibility = 'hidden';"}, - _shorten_addr($rcpts_pending[0],40) - ), - $q->td({-class=>"queue"}, - (defined($rcpts_pending[0]) ? - $q->div({-id=>$row_id.'_pending', -class=>"rcpts_pending_popup"},"Test<br>Test2<br>Test3") - : - ''). - _shorten_string($message->{subject},60) - ) - ); - }; - - $q->div({-class=>"top_spacer"}, - $q->table({-class=>"queue_table",-cellpadding=>0,-cellspacing=>1,border=>0}, - $q->Tr( - # Table header - $q->td({-class=>"queue_header",-width=>"1%"}, - " " - ), - $q->td({-class=>"queue_header",-width=>"1%"}, - "Server" - ), - $q->td({-class=>"queue_header",-width=>"1%"}, - "Age" - ), - $q->td({-class=>"queue_header",-width=>"1%"}, - "Sender" - ), - $q->td({-class=>"queue_header",-width=>"1%"}, - "Recipient(s)" - ), - $q->td({-class=>"queue_header"}, - "Subject" - ) - ), - $rows - ) - ); -}; - - -# -- Private functions ------------------------------------- - -sub _item { - my $html = ""; - - # Loop through all parts and build the table TDs - while (scalar @_) { - my $part = shift @_; - next unless $part; - - my $link = ""; - if (exists($part->{'link'})) { - # this item has a link - $link = 'exilog_cgi.pl?'; - foreach my $var (keys %{ $part->{'link'} }) { - $link .= $var.'='._url_encode($part->{'link'}->{$var}).'&'; - } - chop($link); - } - - if (exists($part->{icon})) { - $html .= - $q->td({-class=>"item_icon",-style=>(exists($part->{style}) ? $part->{style} : "")}, - $q->img({ -src=>$part->{icon}, - -title=>(exists($part->{title}) ? $part->{title} : "" ), - -border=>0 }) - ); - next; - } - elsif (exists($part->{html})) { - $html .= $q->td({-class=>"item_text"}, $part->{html}); - } - elsif (exists($part->{text})) { - # HTML-quote angle brackets - $part->{text} =~ s/\>/\>\;/g; - $part->{text} =~ s/\</\<\;/g; - - # break long text at colons or blanks - $part->{text} =~ s/([^<>]{80,}?)([: ])/$1$2\<br\>/g; - - $html .= - $q->td({-class=>"item_text", - ($link ? ( -onClick=>"javascript:document.location.href='$link';", - -style=>(exists($part->{style}) ? $part->{style} : "")."cursor:pointer;cursor:hand;", - -onMouseOver=>"javascript:link_on(this);", - -onMouseOut=>"javascript:link_off(this);" ) - : ( - -style=>(exists($part->{style}) ? $part->{style} : "") - ) ) }, - $part->{text} - ); - }; - }; - - # Wrap everything in the surrounding table. - return - $q->table({-class=>"item",-cellspacing=>0,-cellpadding=>0,-border=>0}, - $q->Tr( - $html - ) - ); -}; - - -sub _shorten_addr { - my $addr = shift; - my $max = shift; - return $addr if (length($addr) <= $max); - - my ($localpart,$domain) = split /\@/, $addr, 2; - - if (length($addr) > (int($max/2))) { - # shorten local part first - $localpart = substr($localpart,0,int($max/4)).'...'; - }; - # return if that suffices - return $localpart.'@'.$domain if (length($localpart.'@'.$domain) <= $max); - - # shorten domain - my @domainparts = split /\./, $domain; - while ((scalar @domainparts) > 1) { - shift @domainparts; - last if (length($localpart.'@'.'...'.join('.',@domainparts)) <= $max); - }; - - return $localpart.'@'.'...'.join('.',@domainparts); -}; - - -sub _shorten_string { - my $string = shift; - my $max = shift; - return $string if (length($string) <= $max); - return substr($string,0,($max-3)).'...'; -}; - - -sub _timespan { - my $amnt = shift; - my @steps = (1,60,60,24,7,999999999); - my @units = ('s','m','h','d','wk'); - - my $str = ""; - while ($amnt > $steps[1]) { - my $rest = $amnt % $steps[1]; - $str = $rest.$units[0]." ".$str; - $amnt = int($amnt/$steps[1]); - shift @units; - shift @steps; - }; - $str = $amnt.$units[0]." ".$str; - return $str; -}; - -sub _url_encode { - my $subj = shift; - $subj =~ s/([^A-Za-z0-9])/sprintf("%%%02x",ord($1))/eg; - return $subj; -}; - -1; |