# ================================================================== # Gossamer Mail - enhanced email management system # # Website : http://gossamer-threads.com/ # Support : http://gossamer-threads.com/scripts/support/ # Revision : $Id: Messages.pm,v 1.174 2003/11/05 00:17:56 brewt Exp $ # # Copyright (c) 2003 Gossamer Threads Inc. All Rights Reserved. # Redistribution in part or in whole strictly prohibited. Please # see LICENSE file for full details. # ================================================================== # # Description: Message manipulation module for Gossamer Mail. # package GMail::Messages; # ================================================================== # Pragmas use strict; use vars qw/$DEBUG @ISA $ERRORS %MIME_TYPE %MIME_EXT/; # Internal modules use GMail qw{:objects :folders :user_returns :sorting $PERSIST}; use GMail::Config; use GMail::Folders; use GT::Date qw/date_transform date_get timegm timelocal/; use GT::AutoLoader; # Global vars @ISA = qw(GMail); # Map content-type to image file %MIME_TYPE = ( 'text/html' => 'html.gif', 'text/plain' => 'txt.gif', 'application/pdf' => 'pdf.gif', 'application/dvi' => 'dvi.gif', 'application/postscript' => 'postscript.gif', 'application/x-tex' => 'tex.gif', 'application/x-texinfo' => 'tex.gif', 'application/gtar' => 'tar.gif', 'application/x-tar' => 'tar.gif', 'application/x-ustar' => 'tar.gif', 'application/zip' => 'tgz.gif', 'message/rfc822' => 'email.gif', 'message/external-body' => 'email.gif', 'multipart/alternative' => 'email.gif', 'multipart/appledouble' => 'email.gif', 'multipart/digest' => 'email.gif', 'multipart/mixed' => 'email.gif', 'multipart/voice-message' => 'sound.gif', 'audio/basic' => 'sound.gif', 'audio/x-aiff' => 'sound.gif', 'audio/x-wav' => 'sound.gif', 'image/gif' => 'image.gif', 'image/ief' => 'image.gif', 'image/jpeg' => 'image.gif', 'image/tiff' => 'image.gif', 'image/vnd.fpx' => 'image.gif', 'image/x-cmu-rast' => 'image.gif', 'image/x-portable-anymap' => 'image.gif', 'image/x-portable-bitmap' => 'image.gif', 'image/x-portable-graymap' => 'image.gif', 'image/x-portable-pixmap' => 'image.gif', 'image/x-rgb' => 'image.gif', 'image/x-xbitmap' => 'image.gif', 'image/x-xwindowdump' => 'image.gif', 'image/png' => 'image.gif', 'image/bmp' => 'image.gif', 'video/mpeg' => 'video.gif', 'video/quicktime' => 'video.gif', 'application/x-troff-msvideo' => 'video.gif', 'video/x-sgi-movie' => 'video.gif', ); # Map file extention to image file %MIME_EXT = ( htm => 'html.gif', html => 'html.gif', shtm => 'html.gif', shtml => 'html.gif', text => 'txt.gif', c => 'source.gif', cc => 'source.gif', 'c++' => 'source.gif', h => 'source.gif', pl => 'source.gif', cgi => 'source.gif', txt => 'txt.gif', eml => 'email.gif', email => 'email.gif', mime => 'email.gif', java => 'source.gif', el => 'source.gif', pdf => 'pdf.gif', dvi => 'dvi.gif', eds => 'postscript.gif', ai => 'postscript.gif', ps => 'postscript.gif', tex => 'tex.gif', texinfo => 'tex.gif', tar => 'tar.gif', ustar => 'tar.gif', zip => 'tgz.gif', tgz => 'tgz.gif', gz => 'tgz.gif', snd => 'sound.gif', au => 'sound.gif', aifc => 'sound.gif', aif => 'sound.gif', aiff => 'sound.gif', wav => 'sound.gif', bmp => 'image.gif', gif => 'image.gif', ief => 'image.gif', jfif => 'image.gif', 'jfif-tbnl' => 'image.gif', jpe => 'image.gif', jpg => 'image.gif', jpeg => 'image.gif', tif => 'image.gif', tiff => 'image.gif', fpx => 'image.gif', fpix => 'image.gif', ras => 'image.gif', pnm => 'image.gif', pbn => 'image.gif', pgm => 'image.gif', ppm => 'image.gif', rgb => 'image.gif', xbm => 'image.gif', xpm => 'image.gif', xwd => 'image.gif', png => 'image.gif', mpg => 'video.gif', mpe => 'video.gif', mpeg => 'video.gif', mov => 'video.gif', qt => 'video.gif', avi => 'video.gif', movie => 'video.gif', mv => 'video.gif', sh => 'shellscript.gif', rpm => 'rpm.gif', ttf => 'font_true.gif', ); $COMPILE{info} = __LINE__ . <<'END_OF_SUB'; sub info { # ------------------------------------------------------------------- # Should be called on any page you want to list messages. Takes # the folder to list as the first argument or from form input # msgtrack_fid. Defaults the folder to the inbox if one is not # specified. Returns the following vars to the template for # display: # so => Sort order, ASC and DESC # sb => Sort by to sort messages by. # msgtrack_fid => Folder ID to of the folder we are # displaying. # msgs_list => List of the messages for this view. # This loop var gives all the fields # in msgs and msgtrack as vars. # This also includes msgs_preview, which is # a short preview of the beginning of the email. # msgs_list_num => Number of messages in this view. # msgs_toolbar => The html toolbar for paging. # msgs_paging => \ # msgs_top_page => | Paging variables; see ``sub paging'' in GMail.pm, # msgs_dotdotdot => | and the msgs_paging_include.htm template. # msgs_paging_base => / # msgs_total => The total number of messages in this folder. # msgs_total_size => The total size of all the messages in this # folder. # msgs_total_unread => The total number of unread messages in this # folder. # folders_name => The name of the folder we are viewing. # my ($self, $fid) = @_; my $cgi = $IN->get_hash(); delete $cgi->{msgtrack_id}; my $tags = $self->{tags}; $fid ||= $cgi->{msgtrack_fid}; my $folder; if (!$fid) { $folder = $DB->table('folders')->select({ folders_userid => $USER->{userid}, folders_type => INBOX })->fetchrow_hashref; $fid = $folder->{folders_fid}; } my $name; # Find the folder id based on a name if ($fid =~ /\D/) { $fid = $self->_find_folder($fid); } $folder ||= $DB->table('folders')->select({ folders_fid => $fid, folders_userid => $USER->{userid}, })->fetchrow_hashref; # If we are viewing threaded mode, load the thread module and go there my $t = $PLG->dispatch('GMail::template_set', sub { $self->template_set() }); if ($folder->{folders_display_threaded}) { require GMail::Messages::Threads; my $thrd = new GMail::Messages::Threads(tags => $self->{tags}); return $thrd->info($folder); } $cgi->{msgtrack_fid} = $fid; my $opt = $self->_disp_opts($cgi, $folder); my $tb = $DB->table('msgs', 'msgtrack'); my ($msg_size, $hits, @list) = (0); # The block of code below handles sorting by recipient/sender/etc. An ordinary # "ORDER BY msgs_sent_from_..." can't be done because that ends up with any # e-mail address starting with a " coming first - which is wrong, since # ``"Jason" '' should come AFTER ``Adrian ''. # The way around this is to select both those records starting with and not # starting with ", sort the whole list _without_ using the " (see sub # sort_addresses), and take the appropriate rows from the sorted list. if ($opt->{mh} > 0 and $opt->{sb} and index($opt->{sb}, 'msgs_sent_') == 0) { my %temp_opt = %$opt; delete @temp_opt{qw/ww so sb mh nh/}; # First, get the total number of hits: $hits = $tb->count(\%temp_opt); # Get the rows starting with " my $cond = GT::SQL::Condition->new( \%temp_opt, $opt->{sb} => LIKE => '"%' ); $tb->select_options("ORDER BY $opt->{sb} $opt->{so}"); $tb->select_options("LIMIT " . ($opt->{mh} * $opt->{nh})) if $opt->{mh} >= 1; my $sth = $tb->select($cond); @list = @{$sth->fetchall_hashref}; @list = reverse @list if lc $opt->{so} eq 'desc'; # Make sort_addresses' life easier # Now go after the ones not starting with " $cond = GT::SQL::Condition->new( \%temp_opt, GT::SQL::Condition->new($opt->{sb} => LIKE => '"%')->not ); $tb->select_options("ORDER BY $opt->{sb} $opt->{so}"); $tb->select_options("LIMIT " . ($opt->{mh} * $opt->{nh})) if $opt->{mh} >= 1; $sth = $tb->select($cond); push @list, @{$sth->fetchall_hashref}; @list = reverse @list if lc $opt->{so} eq 'desc'; # Make sort_addresses' life easier # Sort the whole mess $self->sort_addresses(\@list, $opt->{sb}); @list = reverse @list if lc $opt->{so} eq 'desc'; # Get rid of the excess rows from the sorted rows if ($opt->{mh} >= 1) { splice @list, 0, ($opt->{nh} - 1) * $opt->{mh} if $opt->{nh} > 1; if (@list > $opt->{mh}) { splice @list, $opt->{mh}; } } } else { my $sth = $tb->query_sth($opt); $hits = $tb->hits() || 0; # Go through the message and produce the list if ($sth) { my $pos = ($opt->{nh} - 1) * $opt->{mh}; while (my $msg = $sth->fetchrow_hashref()) { $pos++; $msg_size += $msg->{msgs_size}; $msg->{msgs_pos} = $pos; push @list, $msg; } } } $self->format_msgs_row(\@list) if @list; my $unread = $DB->table('msgtrack')->count({ msgtrack_userid => $USER->{userid}, msgtrack_fid => $fid, msgtrack_status => 'New', }); # Add in the message preview if (@list) { my @mids; for (0 .. $#list) { push @mids, $list[$_]->{msgs_mid}; } my $msth = $DB->table('msgsearch')->select('msgsearch_mid', 'msgsearch_body', { 'msgsearch_mid' => \@mids }); my %mid2body; while (my ($msg_id, $msg_body) = $msth->fetchrow_array) { $mid2body{$msg_id} = substr($msg_body, 0, $USER->{opts}->{display}->{preview}); } for (0 .. $#list) { $list[$_]->{msgs_preview} = $mid2body{$list[$_]->{msgs_mid}}; } } # Produce the toolbar if there is more than one page of messages my $toolbar = ''; my $urlbase = ''; my $maxhits = $opt->{mh} || $folder->{folders_per_page} || S_MH_DEFAULT; my $nh = ($opt->{nh} || 1); my $paging; if ($hits > $opt->{mh}) { $paging = GMail->paging($hits, $maxhits, $nh, 15, '...'); # The rest of the code is here for compatibility - as of 2.2.0, the # preferred way to do the paging is in a loop in the template. $urlbase = "webmail.cgi?"; for (qw/t sid msgtrack_fid msgs_pos page error_page sb so mh/) { $urlbase .= "$_=" . $IN->escape($cgi->{$_}) . ';' if defined $cgi->{$_}; } if ($nh > 1) { $toolbar .= qq'[<<] '; $toolbar .= qq'[<]'; } my ($ploop, $ptop, $ddd) = @$paging{qw/paging top_page dotdotdot/}; unless ($ploop->[0]->{page_num} == 1) { $toolbar .= qq' 1'; $toolbar .= ' ...' unless $ploop->[0]->{page_num} == 2; } for (@$ploop) { if ($_->{is_current_page}) { $toolbar .= " $_->{page_num}"; } else { $toolbar .= qq' $_->{page_num}'; } } if ($ddd) { $toolbar .= ' ...'; $toolbar .= qq' $ptop'; } if ($nh < $ptop) { $toolbar .= qq' [>]'; $toolbar .= qq' [>>]'; } } my $has_previous = ($nh > 1) ? $nh - 1 : 0; my $has_next = ($nh * $maxhits > $hits) ? 0 : $nh + 1; return { so => $opt->{so} || '', sb => $opt->{sb} || '', nh => $nh, msgtrack_fid => $cgi->{msgtrack_fid}, msgs_list => \@list, msgs_list_num => scalar @list, msgs_toolbar => \$toolbar, msgs_paging => $paging->{paging}, msgs_top_page => $paging->{top_page}, msgs_dotdotdot => $paging->{dotdotdot}, msgs_paging_base => $urlbase, msgs_total => $hits, msgs_total_size => $self->format_size($msg_size), msgs_total_unread => $unread, folders_name => $name || $tags->{folders_name}, has_next => $has_next, has_previous => $has_previous, %{$opt}, %{$folder} }; } END_OF_SUB $COMPILE{view} = __LINE__ . <<'END_OF_SUB'; sub view { # ------------------------------------------------------------------- # Should be called from any template you want to view a message on. # The message that is viewed is specified by msgtrack_id in form # input, or can be passed in as the first argument. Returns the # following tags for the template: # msgs_body => The body of the message to view. # msgs_attach_list => A loop var of attachments. In this loop # you will get all the columns in the msgdata # table as vars. # msgs_attach_num => The number of attachments for this message # msgs_next => The next message URL. You will need to pass # in all the sb, so, and folders_id from the # message list for this to work. # msgs_prev => This is the same as the msgs_next URL but # is the URL for the previous message. # msgs_next_or_prev => This is true if there is a next or previous. # msgtrack_nextid => This is the next message ID. You can use this # to figure out what the next message in the # current sort-by and sort order is. Pass this # back in as msgtrack_nextid to goto the next # message in the list after doing an action like # delete or move. # msgtrack_previd => This is the same as the msgtrack_nextid except # it is for the previous message in the current # set. # sb => This is the current sort-by for this set. # so => This is the current sort-order for this set. # # Aside from these you have all the columns out of the msgs and msgtrack # table. # if ($IN->param('search_state')) { require GMail::Messages::Search; return GMail::Messages::Search->view(@_[1 .. $#_]); } my ($self, $id) = @_; # Find the folder id based on a name my ($folder, $cgi); { $cgi = $IN->get_hash(); my $fid = $cgi->{msgtrack_fid} || GMail::Folders->inbox_fid; my $tb = $DB->table('folders'); if ($fid =~ /\D/) { $fid = $self->_find_folder($fid); } my $sth = $tb->select({ folders_fid => $fid, folders_userid => $USER->{userid}, }); $folder = $sth->fetchrow_hashref(); # If we are viewing threaded mode, load the thread module and go there if ($folder->{folders_display_threaded}) { require GMail::Messages::Threads; return GMail::Messages::Threads->view($folder); } $cgi->{msgtrack_fid} = $fid; } # After we get the folder we need to get our search opts my $opt = $self->_disp_opts($cgi, $folder); $id ||= $cgi->{msgtrack_id}; # Get next/previous messages if requested my ($pos, $total); { my $tb = $DB->table('msgs', 'msgtrack'); $total = $tb->count({ msgtrack_userid => $USER->{userid}, msgtrack_fid => $folder->{folders_fid} }); $pos = $cgi->{msgs_pos}; if (($cgi->{msgtrack_nextid} || $cgi->{msgtrack_previd}) and (!$cgi->{stay_put})) { # Are we doing next or previous my $pos_next = delete $cgi->{msgtrack_nextid}; my $pos_prev = delete $cgi->{msgtrack_previd}; $pos = $pos_next || $pos_prev; my $offset = ($pos - (S_RANGE / 2)) > 0 ? int($pos - (S_RANGE / 2)) : 0; # Select based on next or previous $tb->select_options("ORDER BY $opt->{sb} $opt->{so}", "LIMIT $offset, " . S_RANGE); my $sth = $tb->select('msgtrack_id', { msgtrack_userid => $USER->{userid}, msgtrack_fid => $folder->{folders_fid} }); my ($prev_id, $new_id, $exact_id, $exact_pos); # calculate the position we are going through my $i = ($offset >= $total) ? $total : $offset; $i = ($offset < 0) ? 1 : $offset; # If the next message is requested try and find it if ($pos_next) { $pos_next = ($pos_next > $total) ? $total : $pos_next; $pos_next = ($pos_next <= 0) ? 1 : $pos_next; while (my ($msg_id) = $sth->fetchrow_array()) { $i++; ($i == $pos_next) and ($exact_id, $exact_pos) = ($msg_id, $i); ($msg_id == $id) and ($new_id) = $sth->fetchrow_array(), last; } } # Try to find the previous message elsif ($pos_prev) { $pos_prev = ($pos_prev > $total) ? $total : $pos_prev; $pos_prev = ($pos_prev <= 0) ? 1 : $pos_prev; while (my ($msg_id) = $sth->fetchrow_array()) { $i++; ($i == $pos_prev) and ($exact_id, $exact_pos) = ($msg_id, $i); ($msg_id == $id) and $new_id = $prev_id, last; $prev_id = $msg_id; } } # No message found stay at the current position (!$new_id) ? ($pos, $id) = ($exact_pos, $exact_id) : $id = $new_id; } # Get the message ID $opt->{msgtrack_id} = $id || 0; $IN->param(msgtrack_id => $opt->{msgtrack_id}); # Oops, no message if (!$tb->count({ msgtrack_id => $id, msgtrack_userid => $USER->{userid}, msgtrack_fid => $folder->{folders_fid} })) { return ({ msgs_sent_from => '', msgs_body => '', msgs_attach_list => [], msgs_attach_num => 0, msgs_next => '', msgs_prev => '', msgs_next_or_prev => '', msgs_pos => $pos, msgtrack_nextid => '', msgtrack_previd => '', %{$opt}, %{$folder}, map { $_ => '' } keys %{$DB->table('msgs')->cols()}, keys %{$DB->table('msgtrack')->cols()} }); } } # Get the next and previous url my ($prev, $next); if (defined $pos) { my $c = GT::CGI->new({}); for (qw/nh mh so sb t sid page error_page msgs_pos msgtrack_fid/) { next unless defined $cgi->{$_}; $c->param($_ => [$cgi->{$_}]); } my $url = $c->url; $url =~ s/login\.cgi/webmail.cgi/; $prev = $url . ";msgtrack_id=$id;msgtrack_previd=" . ($pos - 1) if ($pos > 1); $next = $url . ";msgtrack_id=$id;msgtrack_nextid=" . ($pos + 1) if ($pos < $total); } else { $pos = 0; } # Get the message body and the attachments my ($b, $attach, $msg); { ($attach, $msg) = $PLG->dispatch('GMail::Messages::get_attachlist', sub { $self->get_attachlist(@_) }, $id); # Format message $msg->{msgdata_size} = $PLG->dispatch('GMail::format_size', sub { $self->format_size(@_) }, $msg->{msgdata_size}); $attach ||= []; my ($attachlist, @inline); $msg->{msgdata_type} ||= 'text/plain'; my $i = 0; my $can_inline = ($msg and ($msg->{msgdata_type} eq 'text/html')); foreach my $data (@{$attach}) { $data->{msgdata_size} = $PLG->dispatch('GMail::format_size', sub { $self->format_size(@_) }, $data->{msgdata_size}); # Get a list of all the content-id's we have for inline images if ($can_inline and $data->{msgdata_cid} and $data->{msgdata_type} =~ /image/) { push @inline, $data; undef $attach->[$i]; } $i++; } @{$attach} = grep { defined } @{$attach}; # Format the body $b = $PLG->dispatch('GMail::Messages::format_message', sub { $self->format_message(@_) }, $msg); # Parse the body for any inline tages if ($b and @inline) { my $t = $PLG->dispatch('GMail::template_set', sub { $self->template_set() }); my $url = $IN->url(query_string => 0); $url =~ s/login\.cgi/webmail.cgi/; for (@inline) { my $f = $_->{msgdata_suggestedname}; my $did = $_->{msgdata_did}; my $sid = $IN->param('sid') || ''; my $cid = $_->{msgdata_cid}; $b =~ s[(["'])cid:\Q$cid\E\1]["$url/$f?sid=$sid;t=$t;msgdata_did=$did;do=messages-print_attach"]ig; } } } # Mark the message as read if ($msg->{msgtrack_status} eq 'New') { my $tb = $DB->table('msgtrack'); $DB->table('msgtrack')->update( { msgtrack_status => 'Read' }, { msgtrack_id => $msg->{msgtrack_id}, msgtrack_userid => $USER->{userid} } ); # Update the folders list $PLG->dispatch('GMail::Folders::update', sub { GMail::Folders->update(@_) }, $msg->{msgtrack_fid}); } # Ensure we have a complete message for (keys %{$DB->table('msgs')->cols()}, keys %{$DB->table('msgtrack')->cols()}) { $msg->{$_} ||= ''; } $self->format_msgs_row($msg); # Get our select lists and return our TPL arguments return ({ msgs_body => \$b, msgs_attach_list => $attach, msgs_attach_num => scalar @{$attach}, msgs_next => \$next, msgs_prev => \$prev, msgs_next_or_prev => ($next || $prev), msgtrack_nextid => $pos + 1, msgtrack_previd => $pos - 1, msgs_pos => $pos, %{$msg}, %{$opt}, %{$folder}, }); } END_OF_SUB $COMPILE{format_msgs_row} = __LINE__ . <<'END_OF_SUB'; sub format_msgs_row { # ----------------------------------------------------------------------------- # Formats one or more message rows. Takes either a single row as the argument, # or an array reference of multiple rows. # my ($self, $msg) = @_; my @msg = ref $msg eq 'ARRAY' ? @$msg : $msg; return unless @msg; if ($CFG->{date_days_long}) { GT::Date::date_set_days([split /\s*,\s*/ => $CFG->{date_days_long}]); } if ($CFG->{date_days_short}) { GT::Date::date_set_days_short([split /\s*,\s*/ => $CFG->{date_days_short}]); } if ($CFG->{date_month_long}) { GT::Date::date_set_month([split /\s*,\s*/ => $CFG->{date_month_long}]); } if ($CFG->{date_month_short}) { GT::Date::date_set_month_short([split /\s*,\s*/ => $CFG->{date_month_short}]); } # Select the folder display limits from the database for all folders that we're formatting: my %disp_max = map { $_->{folders_fid} => { folders_display_len_from => $_->{folders_display_len_from}, folders_display_len_to => $_->{folders_display_len_to}, folders_display_len_subject => $_->{folders_display_len_subject} } } @{$DB->table('folders')->select(qw/folders_fid folders_display_len_from folders_display_len_to folders_display_len_subject/, { folders_userid => $USER->{userid}, folders_fid => [keys %{{ map { $_->{msgtrack_fid} => 1 } @msg }}] } )->fetchall_hashref}; for my $msg (@msg) { next if $msg->{_msgs_formatted}++; # Get the name of the person that the email was from ($msg->{msgs_sent_from_name}, $msg->{msgs_sent_from_email}) = $self->parse_address($msg->{msgs_sent_from} || ''); if ($msg->{msgs_sent_from_name} =~ /\s/) { ($msg->{msgs_sent_from_first_name}, $msg->{msgs_sent_from_last_name}) = split ' ' => $msg->{msgs_sent_from_name}, 2; } require GT::Mail::Parts; my @to = GT::Mail::Parts->split_line('\s*,\s*', $msg->{msgs_sent_to} || ''); my @to_disp; for my $to (@to) { my ($name, $email) = $self->parse_address($to); push @to_disp, $name || $email; } $msg->{msgs_sent_to_disp} = join ', ', @to_disp; my %map = ( len_from => ['msgs_sent_from_email', 'msgs_sent_from_name'], len_to => ['msgs_sent_to_disp'], len_subject => ['msgs_subject'] ); for my $col (keys %map) { my $max = $disp_max{$msg->{msgtrack_fid}}->{"folders_display_$col"} || $USER->{opts}->{display}->{$col}; for my $field (@{$map{$col}}) { my $save = $field eq 'msgs_sent_to_disp' ? 'msgs_sent_to' : $field; if ($max and length $msg->{$field} > $max) { $msg->{"${save}_disp"} = substr($msg->{$field}, 0, $max) . '...'; $msg->{"${save}_cut"} = 1; } else { $msg->{"${save}_disp"} = $msg->{$field}; } } } my @gmtime = GT::Date::parse_format($msg->{msgs_sent}, $CFG->{date_db_format} || '%yyyy%-%mm%-%dd% %HH%:%MM%:%ss%'); my $time = timelocal(@gmtime); my $format = $CFG->{date_user_format} || '%yyyy%-%mm%-%dd% %HH%:%MM%:%ss%'; if (defined($USER->{opts}->{display}->{date_offset}) || defined $CFG->{date_offset}) { my $offset_cfg = defined($USER->{opts}->{display}->{date_offset}) && length($USER->{opts}->{display}) ? $USER->{opts}->{display}->{date_offset} : $CFG->{date_offset}; my ($offset) = split /\|/ => $offset_cfg, 2; $time += $offset * 60 if $offset; } $msg->{msgs_sent} = date_get($time, $format); $msg->{msgs_size} = $self->format_size($msg->{msgs_size}); } return scalar @msg; } END_OF_SUB $COMPILE{_find_folder} = __LINE__ . <<'END_OF_SUB'; sub _find_folder { # ------------------------------------------------------------------- # Internal method to find a folder name and ID given a string that # could be the name of a folder or a folder ID. # my ($self, $fid) = @_; my $folders = $DB->table('folders'); if (uc($fid) eq 'INBOX') { $fid = GMail::Folders->inbox_fid; } elsif (uc($fid) eq 'SENT') { $fid = GMail::Folders->sent_fid; } elsif (uc($fid) eq 'TRASH') { $fid = GMail::Folders->trash_fid; } elsif (uc $fid eq 'DRAFTS') { $fid = GMail::Folders->drafts_fid; } elsif ($fid =~ /\D/) { my $sth = $DB->table('folders')->select(folders_fid => { folders_name => $fid, folders_userid => $USER->{userid} }); if ($sth->rows()) { $fid = $sth->fetchrow; } else { $fid = GMail::Folders->inbox_fid; } } else { $fid = GMail::Folders->inbox_fid; } return $fid; } END_OF_SUB $COMPILE{_disp_opts} = __LINE__ . <<'END_OF_SUB'; sub _disp_opts { # ------------------------------------------------------------------- # Internal method to format cgi input for displaying a list of # messages or a single message. # my ($self, $cgi, $folder) = @_; my $tb = $DB->table('msgs', 'msgtrack'); my $cols = $tb->cols(); my $ret = {}; for (keys %{$cols}) { next if /userid/; (my $cp = $_) =~ s/^[^.]+\.//; $ret->{$cp} = $cgi->{$cp} if exists $cgi->{$cp} and $cgi->{$cp} =~ /\S/; } my $t = $PLG->dispatch('GMail::template_set', sub { $self->template_set() }); my $fid = $ret->{msgtrack_fid}; $ret->{sb} = ($cgi->{sb} and exists($ret->{$cgi->{sb}})) ? $cgi->{sb} : ($folder->{folders_sb} || S_SB_DEFAULT); $ret->{so} = ($cgi->{so} and $cgi->{so} =~ /(asc|desc)/) ? $1 : ($folder->{folders_so} || S_SO_DEFAULT); $ret->{mh} = $cgi->{mh} ? ($cgi->{mh} + 0) : ($folder->{folders_per_page} || $USER->{opts}->{display}->{msgs_per_page} || S_MH_DEFAULT); $ret->{nh} = ($cgi->{nh} and $cgi->{nh} !~ /\D/) ? $cgi->{nh} : 1; $ret->{ww} = 1; for (qw/ww nh mh so sb/) { $IN->param($_ => [$ret->{$_}]) } $ret->{msgtrack_userid} = $USER->{userid}; return $ret; } END_OF_SUB $COMPILE{raw_header} = __LINE__ . <<'END_OF_SUB'; sub raw_header { # ----------------------------------------------------------------------------- # Returns a scalar reference to the header of a message. The message ID should # be passed in. The message will be read off disk into a scalar, then a # reference to that scalar will be returned to you. # # This is the raw header; it is _not_ HTML-escaped. If you are looking for a # way to get the header for display in a template, use the header() method # below. # my ($self, $id) = @_; $id or return $self->error(MSGERR_VIEW_NOID => 'WARN'); $id =~ /\D/ and return $self->error(MSGERR_VIEW_ID => 'WARN'); my $checksum = $DB->table(msgs => 'msgtrack')->select(msgs_checksum => { msgtrack_id => $id, msgtrack_userid => $USER->{userid} })->fetchrow; my $p = substr($checksum, 0, 1) . '/' . substr($checksum, 1, 1) . '/' . substr($checksum, 2, 1); my $file = $CFG->{location}->{path}->{data} . '/msgs/' . $p . '/' . $checksum; my $fh = \do { local *FILE; *FILE }; open $fh, "< $file" or return $self->error(READOPEN => 'FATAL' => $file, "$!"); my $header = ''; while (<$fh>) { last if /^\r?$/; $header .= $_; } \$header; } END_OF_SUB $COMPILE{header} = __LINE__ . <<'END_OF_SUB'; sub header { # ------------------------------------------------------------------- # Returns a hash reference contianing the key msgsearch_header. # This key contains a scalar reference to the header of the message # retrieved by the id passed in. If no id is passed in it is taken # from cgi input as msgtrack_id. # my ($self, $id) = @_; my $cgi = $IN->get_hash(); $id ||= $cgi->{msgtrack_id}; my $header = $self->raw_header($id); $IN->html_escape($header); if ($cgi->{highlight}) { my $start = $cgi->{highlight_start}; my $stop = $cgi->{highlight_stop}; unless ($start and $stop) { ($start, $stop) = ('', ''); } my @head; @head = (split ' ' => $cgi->{query}) if defined($cgi->{query}) and $cgi->{query} =~ /\S/; for (grep { m/^msgs[_e]/ && !m/opt$/ } keys %{$cgi}) { push @head, $cgi->{$_}; } for (@head) { next unless defined and length; $$header =~ s/(\Q$_\E)/$start$1$stop/ig; } } return { msgsearch_header => $header }; } END_OF_SUB $COMPILE{print_source} = __LINE__ . <<'END_OF_SUB'; sub print_source { # ------------------------------------------------------------------- # Prints and html escapes the entire unformatted message. # my ($self, $id) = @_; my $cgi = $IN->get_hash(); $id ||= $cgi->{msgtrack_id}; $id or return $self->error('MSGERR_VIEW_NOID', 'WARN'); $id =~ /\D/ and return $self->error('MSGERR_VIEW_ID', 'WARN'); my $sth = $DB->table('msgs', 'msgtrack')->select('msgs_checksum', { msgtrack_id => $id, msgtrack_userid => $USER->{userid}, }); my ($checksum) = $sth->fetchrow_array(); my $p = substr($checksum, 0, 1) . '/' . substr($checksum, 1, 1) . '/' . substr($checksum, 2, 1); my $file = $CFG->{location}->{path}->{data} . '/msgs/' . $p . '/' . $checksum; open (FILE, "< $file") or return $self->error('READOPEN', 'FATAL', $file, "$!"); while (read(FILE, my $buffer, 64 * 1024)) { print $IN->html_escape($buffer); } close FILE; return; } END_OF_SUB $COMPILE{print_attach} = __LINE__ . <<'END_OF_SUB'; sub print_attach { # ------------------------------------------------------------------- # This should be linked to from the message view or from anywhere # you want to print an attachment. The attachment is specified by # cgi input msgdata_did or as the first argument to this function. # Looks up the attachment, prints the proper header for it then # prints the attachments body and exits. # my ($self, $did, $return) = @_; $did ||= $IN->param('msgdata_did'); $did or return $self->error('ATTACHERR_NOID', 'WARN'); $did =~ /^\d+$/ or return $self->error('ATTACHERR_ID', 'WARN', $did); # Get the data for this attachment my $sth = $DB->table('msgdata', 'msgtrack', 'msgs')->select({ msgdata_did => $did }); $sth->rows() > 0 or return $self->error('ATTACHERR_ID', 'WARN', $did); my $row = $sth->fetchrow_hashref(); # Make sure this user can view this attachment $DB->table('msgtrack')->count({ msgtrack_mid => $row->{msgdata_mid}, msgtrack_userid => $USER->{userid}, }) or return $self->error('ATTACHERR_ID', 'WARN', $row->{msgdata_mid}); # Get the path to the attachment my $p = substr($row->{msgdata_filename}, 0, 1) . '/' . substr($row->{msgdata_filename}, 1, 1) . '/' . substr($row->{msgdata_filename}, 2, 1); my $data = "$CFG->{location}->{path}->{data}/msgs/$p/$row->{msgdata_filename}"; -e $data or return $self->error('ATTACHERR_EXIST', 'WARN', $data); my $attsize = -s _; # Open it, print the proper header and display it my ($ext) = $row->{msgdata_suggestedname} =~ /\.([^.]+)$/; require GT::Mail; my $type = exists($GT::Mail::CONTENT->{$ext}) ? $GT::Mail::CONTENT->{$ext} : $row->{msgdata_type} ? $row->{msgdata_type} : 'application/octet-stream'; my %header = ( -type => $type, "Content-Disposition" => \("inline; filename=" . $IN->escape($row->{msgdata_suggestedname}) . "; size=$attsize"), "Content-Length" => $attsize ); open FH, $data or $self->error("READOPEN", "FATAL", $data, $!); binmode FH; binmode STDOUT; my $b; { local $/; $b = ; } close FH; # Handle inline images if ($type eq 'text/html') { my ($attach) = $PLG->dispatch('GMail::Messages::get_attachlist', sub { $self->get_attachlist(@_) }, $row->{msgtrack_id}); $attach ||= []; my ($attachlist, @inline); my $i = 0; my $can_inline = ($row and ($row->{msgdata_type} eq 'text/html')); foreach my $data (@{$attach}) { $data->{msgdata_size} = $PLG->dispatch('GMail::format_size', sub { $self->format_size(@_) }, $data->{msgdata_size}); # Get a list of all the content-id's we have for inline images if ($can_inline and $data->{msgdata_cid} and $data->{msgdata_type} =~ /image/) { push @inline, $data; undef $attach->[$i]; } $i++; } @{$attach} = grep { defined } @{$attach}; # Parse the body for any inline tages if ($b and @inline) { my $t = $PLG->dispatch('GMail::template_set', sub { $self->template_set }); my $url = $IN->url(query_string => 0); $url =~ s/login\.cgi/webmail.cgi/; for (@inline) { my $f = $_->{msgdata_suggestedname}; my $did = $_->{msgdata_did}; my $sid = $IN->param('sid') || ''; my $cid = $_->{msgdata_cid}; $b =~ s[(["'])cid:\Q$cid\E\1]["$url/$f?sid=$sid;t=$t;msgdata_did=$did;do=messages-print_attach"]ig; } } } print $IN->header($type); $return ? return \$b : print $b; return EXIT; } END_OF_SUB $COMPILE{dangerous} = __LINE__ . <<'END_OF_SUB'; sub dangerous { # ----------------------------------------------------------------------------- # Identify a "dangerous" message - that is, a message with an attachment # matching one of the "dangerous" attachment settings in the admin panel. # Returns 0 if the message is fine, 1 if the message should be deleted, and 2 # if the message contained attachments that were filtered out of the e-mail. # my ($self, $mail) = @_; my @strip = @{$CFG->{email}->{attachment_filters}}; my @delete = @{$CFG->{email}->{attachment_blocks}}; for (@strip, @delete) { $_ = quotemeta; s/(?:\\\*)+/.*/g; s/\\\?/./g; $_ = "^$_\$"; } return 0 unless @strip or @delete; my @parts = $mail->all_parts; my @delete_parts; PART: for my $part (@parts) { my $cd = $part->get('Content-Disposition'); next unless $cd; my (undef, $filename) = $cd =~ /filename=("?)((?:[^\\"]|\\.)+)\1(?:;|$)/; $filename =~ s/\\(.)/$1/g; next unless $filename; for (@delete) { if ($filename =~ /$_/i) { return 1; } } for (@strip) { if ($filename =~ /$_/i) { push @delete_parts, $part; next PART; } } } for my $del (@delete_parts) { for (my $i = 0; $i < @{$parts[0]->{parts}}; $i++) { if ($parts[0]->{parts}->[$i] == $del) { splice @{$parts[0]->{parts}}, $i--, 1; } } for (my $i = 1; $i < @{$mail->{parts}}; $i++) { if ($mail->{parts}->[$i] == $del) { splice @{$mail->{parts}}, $i--, 1; splice @parts, $i--, 1; } } } return @delete_parts ? 2 : 0; } END_OF_SUB $COMPILE{delete_message} = __LINE__ . <<'END_OF_SUB'; sub delete_message { # ------------------------------------------------------------------- # Deletes a message given a message id and the folder id it is in # (msgtrack_id and msgtrack_fid). The fid can be passed as the first # argument and the message id can be passed in as the second argument # If not passed in they are both pulled from cgi input as msgtrack_fid # and msgtrack_id respectively. # shift->delete(@_); } END_OF_SUB $COMPILE{delete_group} = __LINE__ . <<'END_OF_SUB'; sub delete_group { # ------------------------------------------------------------------- # Deletes a group of messages given message ids and the folder id # they are in (msgtrack_id and msgtrack_fid). The fid can be passed # as the first argument and the message ids can be passed in as the # rest of the arguments. If not passed in they are both pulled from # cgi input as msgtrack_fid and msgtrack_id respetivly. # shift->delete(@_); } END_OF_SUB $COMPILE{delete_folder} = __LINE__ . <<'END_OF_SUB'; sub delete_folder { # ----------------------------------------------------------------------------- # Deletes all the messages from one or more folders. The folder_fids are # passed in, or, if not passed in, obtained from the CGI input parameter # msgtrack_fid. This subroutine is simply a wrapper around delete() that # pre-selects all the messages in the given folders and passes them off to # delete(). # my ($self, @fid) = @_; @fid = $IN->param('folders_fid') if !@fid; my $cnt = 0; for my $fid (@fid) { my @msgs = $DB->table('msgtrack')->select(msgtrack_id => { msgtrack_fid => $fid, msgtrack_userid => $USER->{userid} })->fetchall_list; next unless @msgs; my @r = $self->delete($fid, @msgs); $cnt += $r[1]; } return { message => 'MSG_FOLD_DEL' }, $cnt; } END_OF_SUB $COMPILE{delete} = __LINE__ . <<'END_OF_SUB'; sub delete { # ------------------------------------------------------------------- # This method is wrapped by delete_message and delete_group. This # was done to make it easier to distinguish between the two in the # page you display for each one. The same arguments that apply to # delete_group apply here. # my ($self, $fid, @del_list) = @_; my $tb = $DB->table('msgtrack'); my $cnt = 0; $fid ||= $IN->param('msgtrack_fid'); # We have to have a list of messages to delete @del_list = $IN->param('msgtrack_id') unless (@del_list); @del_list or return $self->error('MSGERR_DEL_NOMID', 'WARN'); for (@del_list) { /^\d+$/ or return $self->error('MSGERR_DEL_ID', 'WARN', $_) } # Set the default if the option doesn't exist. my $delete_to_trash = !exists($USER->{opts}->{mailbox}->{delete_to_trash}) ? 1 : $USER->{opts}->{mailbox}->{delete_to_trash}; my ($trash_id, $trash_fid) = $DB->table('folders')->select(folders_id => folders_fid => { folders_type => TRASH, folders_userid => $USER->{userid} })->fetchrow; $trash_id ||= 0; $trash_fid ||= 0; my %trash_folders = ($trash_fid => 1); # Figure out all folders that are subfolders of the trash folder - we delete # directly from these without moving them to trash. for ($DB->table('folders')->select(folders_fid => { folders_root => $trash_id })->fetchall_list) { $trash_folders{$_}++; } # If no folder id we have to look *them* up if (!$fid) { my $sth = $tb->select('msgtrack_fid', 'msgtrack_id', { msgtrack_id => \@del_list, msgtrack_userid => $USER->{userid} }); my (@trash, @del); while (my ($folder_fid, $id) = $sth->fetchrow()) { if ($trash_folders{$folder_fid} or !$delete_to_trash) { push @del, $id; } else { push @trash, $id; } } if (@trash) { my @ret = $self->move($trash_fid, @trash) or return; $cnt = $ret[1]; } if (@del) { $fid = $trash_fid; @del_list = @del; } else { return { message => 'MSG_DEL' }, $cnt; } } else { $fid =~ /^\d+$/ or return $self->error('MSGERR_DEL_FOLDID', 'WARN', $fid); } if ($trash_folders{$fid} or !$delete_to_trash) { # The e-mail is already in the trash (or a subfolder) # We have to count because of FK relations $cnt += $tb->count({ msgtrack_id => \@del_list, msgtrack_userid => $USER->{userid} }); # Delete the message(s) $tb->delete({ msgtrack_id => \@del_list, msgtrack_userid => $USER->{userid} }, 'cleanup'); } else { my @ret = $PLG->dispatch('GMail::Messages::move', sub { $self->move(@_) }, $trash_fid, @del_list); $cnt += $ret[1]; } # Update the folders list $PLG->dispatch('GMail::Folders::update', sub { GMail::Folders->update(@_) }, $fid); return { message => 'MSG_DEL' }, $cnt; } END_OF_SUB $COMPILE{change_status} = __LINE__ . <<'END_OF_SUB'; sub change_status { # ------------------------------------------------------------------- # This method takes a set of message ids and marks them as read/unread. The # list of message ids can be passed in. If not passed in they are # taken from cgi input as msgtrack_id. # my ($self, $status, @mids) = @_; # Get the list of messages we are moving @mids = $IN->param('msgtrack_id') unless (@mids); @mids or return $self->error('MSGERR_MARK_NOMID', 'WARN'); for (@mids) { /^\d+$/ or return $self->error('MSGERR_MARK_ID', 'WARN', $_) } # Move the messages $status ||= (($IN->param('msgtrack_set_status') eq 'Read') ? 'Read' : 'New'); my $tb = $DB->table('msgtrack'); my $sth = $tb->update( { msgtrack_status => $status }, { msgtrack_id => \@mids, msgtrack_userid => $USER->{userid}, msgtrack_status => ($status eq 'Read' ? 'New' : [qw/Read Replied Forward/]) } ); # Update the folders list $tb->select_options('LIMIT 1'); $sth = $tb->select('msgtrack_fid', { msgtrack_id => \@mids, msgtrack_userid => $USER->{userid} }); my ($fid) = $sth->fetchrow(); $PLG->dispatch('GMail::Folders::update', sub { GMail::Folders->update(@_) }, $fid); # Return success return { message => 'MSG_MARKED' }, $sth->rows(), $status; } END_OF_SUB sub move_group { shift->move(@_); } sub move_message { shift->move(@_); } $COMPILE{move} = __LINE__ . <<'END_OF_SUB'; sub move { # ------------------------------------------------------------------- # This method moves messages from one folder to another. The folder # id to move to can be passed in as the first argument. If it is not # it will be pulled from cgi input as folders_fid. The list of # message ids to move can be passed in as any additional arguments. If # none are passed in they will be pulled from cgi input as msgtrack_id. # my ($self, $fid, @mids) = @_; # Get the folder id we are moving to $fid ||= $IN->param('folders_fid'); $fid or return $self->error('MSGERR_MOVE_NOFOLD', 'WARN'); $fid !~ /\D/ and $DB->table('folders')->count({ folders_userid => $USER->{userid}, folders_fid => $fid }) or return $self->error('MSGERR_MOVE_FOLDID', 'WARN', $fid); # Get the list of messages we are moving @mids = $IN->param('msgtrack_id') unless (@mids); @mids or return $self->error('MSGERR_MOVE_NOMID', 'WARN'); for (@mids) { /^\d+$/ or return $self->error('MSGERR_MOVE_ID', 'WARN', $_) } # Move the messages my $tb = $DB->table('msgtrack'); $tb->select_options('LIMIT 1'); my $sth = $tb->select('msgtrack_fid', { msgtrack_id => \@mids, msgtrack_userid => $USER->{userid} }); my ($from) = $sth->fetchrow(); $sth = $tb->update( { msgtrack_fid => $fid }, { msgtrack_id => \@mids, msgtrack_userid => $USER->{userid} } ); # Update the folders list $PLG->dispatch('GMail::Folders::update', sub { GMail::Folders->update(@_) }, $from, $fid); # Return success return { message => 'MSG_MVD' }, $sth->rows(); } END_OF_SUB sub moveuser { # ----------------------------------------------------------------------------- # This is similar to move() above, except that it moves the message into the # Inbox of another user. This is only possibly when logging in through the # admin "Login" link, which replaced the pre-2.2.0 email.cgi functionality. # my ($self, $username, $domain, @mids) = @_; $SESSION and $SESSION->data->{admin} or return $self->error(FUNCERR => 'WARN'); if (@mids == 1 and ref $mids[0] eq 'ARRAY') { @mids = @{$mids[0]}; } elsif (!@mids) { @mids = $IN->param('msgtrack_id'); } @mids or return $self->error('MSGERR_MOVE_NOMID', 'WARN'); for (@mids) { /^\d+$/ or return $self->error('MSGERR_MOVE_ID', 'WARN', $_) } $username ||= $IN->param('moveuser_username'); $domain ||= $IN->param('moveuser_domain'); $username and $domain or return $self->error('MSGERR_MOVEUSER_NOUSER', 'WARN'); $PLG->dispatch('GMail::Auth::get_pass', sub { GMail::Auth->get_pass(@_) }, "$username\@$domain") or return $self->error('MSGERR_MOVEUSER_USERDNE', 'WARN'); # Load the user (creating them if necessary) my $u = new GMail::User; $u->load_user("$username\@$domain"); $u->check_create; my $old_user = $USER; $USER = $u; %GMail::FID_CACHE = (); my $sth = $DB->table('msgtrack')->update( { msgtrack_userid => $u->{userid}, msgtrack_fid => GMail::Folders->inbox_fid }, { msgtrack_userid => $old_user->{userid}, msgtrack_id => \@mids } ); $PLG->dispatch('GMail::Folders::update', sub { GMail::Folders->update(@_) }, GMail::Folders->inbox_fid); $USER = $old_user; %GMail::FID_CACHE = (); $PLG->dispatch('GMail::Folders::update', sub { GMail::Folders->update(@_) }); # Return success return { message => 'MSG_MVD' }, $sth->rows(); } $COMPILE{move_all} = __LINE__ . <<'END_OF_SUB'; sub move_all { # ------------------------------------------------------------------- # This method moves all messages to a folder. The folder ID to # move to can be passed in as the first argument. If it is not, it # will nbe pulled from cgi input as msgtrack_fid. # my ($self, $fid) = @_; $fid ||= $IN->param('msgtrack_fid'); $fid or return $self->error('MSGERR_MOVE_NOFOLD', 'WARN'); $fid =~ /^\d+$/ or return $self->error('MSGERR_MOVE_FOLDID', 'WARN', $fid); my $sth = $DB->table('msgtrack')->update( { msgtrack_fid => $fid }, { msgtrack_userid => $USER->{userid} } ); # Update the folders list $PLG->dispatch('GMail::Folders::update', sub { GMail::Folders->update(@_) }); # Update folder list return { message => 'MSG_ALL_MVD' }, $sth->rows(); } END_OF_SUB $COMPILE{move_folder} = __LINE__ . <<'END_OF_SUB'; sub move_folder { # ------------------------------------------------------------------- # This method moves all messages in a given folder to anouther folder. # The folder to move from can be passed in as the first argument. If # it is not passed in, it will be taken from cgi input as folders_fid. # The folder ID to move to can be passed in as the second argumnet. # If it is not, it will be taken from form input as msgtrack_fid. # my ($self, $from, $to) = @_; $from ||= $IN->param('folders_fid'); $to ||= $IN->param('msgtrack_fid'); $from or return $self->error('FOLDERR_NOID', 'WARN'); $from =~ /^\d+$/ or return $self->error('FOLDERR_ID', 'WARN', $from); $to or return $self->error('FOLDERR_NOID', 'WARN'); $to =~ /^\d+$/ or return $self->error('FOLDERR_ID', 'WARN', $to); my $tb = $DB->table('msgtrack'); my $sth = $tb->update( { msgtrack_fid => $to }, { msgtrack_fid => $from, msgtrack_userid => $USER->{userid} } ); # Update the folders list $PLG->dispatch('GMail::Folders::update', sub { GMail::Folders->update(@_) }, $from, $to); # Update folder list return { message => 'MSG_FOLD_MVD' }, $sth->rows; } END_OF_SUB $COMPILE{moveuser_folder} = __LINE__ . <<'END_OF_SUB'; sub moveuser_folder { # ----------------------------------------------------------------------------- # Similar to move_folder, above, except that this moves all the messages in the # folder to another user's Inbox. my ($self, $from) = @_; $from ||= $IN->param('folders_fid'); $from or return $self->error(FOLDERR_NOID => 'WARN'); $from !~ /\D/ or return $self->error(FOLDERR_ID => WARN => $from); my @mids = $DB->table('msgtrack')->select( msgtrack_id => { msgtrack_userid => $USER->{userid}, msgtrack_fid => $from } )->fetchall_list; return $self->moveuser(undef, undef, \@mids); } END_OF_SUB $COMPILE{delete_folder_duplicates} = __LINE__ . <<'END_OF_SUB'; sub delete_folder_duplicates { # ------------------------------------------------------------------- # Takes the folder ID from folders_fid as cgi input and delete any # messages that are duplicates. The folder ID can also be passed in # as the first argument. If it is it will ignore CGI input. # my ($self, $fid) = @_; $fid ||= $IN->param('folders_fid'); $fid or return $self->error('FOLDERR_NOID', 'WARN'); $fid =~ /^\d+$/ or return $self->error('FOLDERR_ID', 'WARN', $fid); my $sth = $DB->table('msgs', 'msgtrack')->select( 'msgs_checksum', 'msgtrack_id', { msgtrack_userid => $USER->{userid}, msgtrack_fid => $fid, } ); my (%cache, @delete); while (my ($checksum, $id) = $sth->fetchrow()) { if (exists($cache{$checksum})) { push @delete, $id; } else { $cache{$checksum} = 1; } } my $cnt = $PLG->dispatch('GMail::Messages::delete', sub { $self->delete(@_) }, $fid, @delete); return { message => 'MSG_DEL' }, $cnt; } END_OF_SUB $COMPILE{format_message} = __LINE__ . <<'END_OF_SUB'; sub format_message { # ------------------------------------------------------------------- # Formats a message body, removes intro html if html, line wraps the # message if it is plain text. This is a mostly internal method and # should proabably not be called from a template. # The first argument is the hash the represents the message data # portion of the message as it is selected out of the msgdata table. # If a second true argument is specified the message is not formatted # just returned. # my ($self, $msg, $no_clean) = @_; my $body; ($msg and $msg->{msgdata_filename}) or return ''; my $p = substr($msg->{msgdata_filename}, 0, 1) . '/' . substr($msg->{msgdata_filename}, 1, 1) . '/' . substr($msg->{msgdata_filename}, 2, 1); my $path = "$CFG->{location}->{path}->{data}/msgs/$p/$msg->{msgdata_filename}"; if (-e $path) { open FILE, $path or $self->error('READOPEN', 'FATAL', $path, $!); read(FILE, $body, -s FILE); close FILE; } return $body if $no_clean; my $t = $self->template_set(); $body = $PLG->dispatch('GMail::format_type', sub { $self->format_type(@_) }, $msg->{msgdata_type}, $body, ($USER->{opts}->{display}->{line_wrap} || 100)); return $body; } END_OF_SUB $COMPILE{insert_data} = __LINE__ . <<'END_OF_SUB'; sub insert_data { # ------------------------------------------------------------------- # This is an internal method and should not be called from a template. # Inserts a message into the GMail system. Assumes you have already # validated the email. $mail_object should be a GT::Mail object and # the message should already be stored (eg parsed) in that object. # Returns the message id. This also makes sure the message is not # already in the system, if the message is this returns the message # ID for that message and does not reinsert the message. # my ($self, $mail, $checksum) = @_; # Tables to work with my $data = $DB->table('msgdata'); my $msgs = $DB->table('msgs'); my $users = $DB->table('users'); my $search = $DB->table('msgsearch'); my $head; # Get all the parts and the top level part $head = $mail->top_part() or die "No Top part!! $GT::Mail::Parse::error";; # Get some info about the email require GT::Mail; my $in_date = $head->get('date'); $in_date =~ tr/\r\n//d if $in_date; my $date = $PLG->dispatch('GMail::Messages::parse_date', sub { $self->parse_date(@_) }, $in_date || GT::Mail->date_stamp()); unless ($date) { $date = GT::Date::date_get_gm(time, '%yyyy%-%mm%-%dd% %hh%:%MM%:%ss%'); } my $has_html = 'No'; if ($head->mime_type =~ /html/) { $has_html = 'Yes' } # We md5 the message header plus the size of the message # to get a unique checksum for this message my $header = $head->header_as_string(); my @parts = ($head); my $size; for my $part (@parts) { push @parts, $part->parts(); my $part_size = $part->size() || 0; $size += $part_size; if ($part->mime_type() and $part->mime_type() =~ /html/) { $has_html = 'Yes' } } if (!$checksum) { $checksum = $self->get_message_checksum($head, $header, $size); } if (my ($size, $id) = $PLG->dispatch('GMail::Messages::message_exists', sub { $self->message_exists(@_) }, $checksum)) { return ($size, $id); } # Insert the message into the message table my @reply = $head->get('Reply-To'); my @from = $head->get('from'); @from = @reply unless @from; my $sth = $msgs->insert({ msgs_size => $size, msgs_sent => $date, msgs_sent_from => join(", " => @from) || '', msgs_sent_to => join(", " => $head->get('to')) || '', msgs_sent_cc => join(", " => $head->get('cc')) || '', msgs_sent_bcc => join(", " => $head->get('bcc')) || '', msgs_reply_to => join(", " => @reply) || '', msgs_subject => join(", " => $head->get('subject')) || '', msgs_message_id => ($head->get('message-id') || ''), msgs_has_attach => (($head->is_multipart()) ? 'Yes' : 'No'), msgs_has_html => $has_html, msgs_checksum => $checksum, msgs_content => ($head->get('content-type') || ''), msgs_dangerous => (($head->get('X-GMail-Attachments') || '') eq 'filtered' ? 1 : 0), GT_SQL_SKIP_CHECK => 1, }); my $id = $sth->insert_id(); # Inserts for threads my $reply_to = { map { /(<[^> ]+>)/ ? ($1 => 1) : () } split(' ' => join(' ' => $head->get('In-Reply-To'), $head->get('References'))) }; my $thrd_j = $DB->table('msgs', 'msgs_threads', 'msgtrack'); my $thrd = $DB->table('msgs_threads'); if (keys %{$reply_to}) { my @list = keys %{$reply_to}; my $sth = $thrd_j->select('msgs_threads_root', 'msgs_threads_mid', { msgs_message_id => \@list, msgtrack_userid => $USER->{userid} }); if ($sth->rows()) { my %seen; while (my ($root, $mid) = $sth->fetchrow()) { next if $seen{$id . ($root || $mid) . $mid}++; $thrd->insert({ msgs_threads_mid => $id, msgs_threads_root => ($root || $mid), msgs_threads_parent => $mid, GT_SQL_SKIP_CHECK => 1, }); } } else { $thrd->insert({ msgs_threads_mid => $id, msgs_threads_root => 0, msgs_threads_parent => 0, GT_SQL_SKIP_CHECK => 1, }); } } else { $thrd->insert({ msgs_threads_mid => $id, msgs_threads_root => 0, msgs_threads_parent => 0, GT_SQL_SKIP_CHECK => 1, }); } # Where to write the message to file at my $sub1 = substr($checksum, 0, 1); my $sub2 = substr($checksum, 1, 1); my $sub3 = substr($checksum, 2, 1); my $dir = "$CFG->{location}->{path}->{data}/msgs/$sub1"; if (!-d $dir) { $self->mkdir($dir) or return; } $dir .= '/' . $sub2; if (!-d $dir) { $self->mkdir($dir) or return; } $dir .= '/' . $sub3; if (!-d $dir) { $self->mkdir($dir) or return; } my $fh = $self->clobber("$dir/$checksum"); binmode $fh; my $m = GT::Mail->new(); $m->parser($mail); $GT::Mail::error ||= ''; $m->write($fh) or return $self->error($GT::Mail::error, 'WARN'); # Go through all the parts, write them to file and # insert them into the msgdata table. my ($view_part, $i, $match, $part_inserted); $i = 0; for my $part (@parts) { next if $part->mime_type() =~ /(?:multipart|message|rfc822)/i; my $path = $dir . '/' . $checksum . '.' . ++$i; $path =~ /^(.+)$/ and $path = $1; my $msg_in = $part->body_in() or next; my $msg_data; if ($msg_in eq 'FILE') { $GT::Mail::Parts::error ||= ''; my $fh = $part->open('r') or $self->error($GT::Mail::Parts::error); binmode $fh; read ($fh, $msg_data, -s $fh); close $fh; } else { $msg_data = $part->body_data(); } $msg_data ||= ''; my $fh = $self->clobber($path) or return; binmode $fh; print $fh $msg_data; close $fh; # If a name is not suggested there is usually only # three things it will be, we try to guess an extention here. my $suggest = ''; if (!($suggest = $part->mime_attr('content-disposition.filename'))) { $suggest = $part->mime_attr('content-type.name'); } my $type = $part->mime_type() || 'text/plain'; unless ($suggest) { if ($type =~ /plain/) { $suggest = $i . '.txt'; } elsif ($type =~ /html/) { $suggest = $i . '.html'; } else { $suggest = $i; } } # Insert the data of the message (my $cid = ($part->get('Content-ID') || '')) =~ s/^<|>$//g; $data->insert({ msgdata_mid => $id, msgdata_filename => $checksum . '.' . $i, msgdata_suggestedname => $suggest, msgdata_size => -s $path, msgdata_type => $type, msgdata_format => $part->mime_attr('content-type.format') || '', msgdata_charset => $part->mime_attr('content-type.charset') || '', msgdata_encoding => $part->mime_encoding(), msgdata_created => \'NOW()', msgdata_boundary => $part->multipart_boundary() || '', msgdata_disposition => $part->mime_attr('content-disposition') || '', msgdata_cid => $cid || '', GT_SQL_SKIP_CHECK => 1, }); $part_inserted++; # Create a shortened header for the msgsearch table, which will only contain useful searchable data. $head->delete('received'); my $short_header = $head->header_as_string(); $short_header =~ s/\s+/ /; if (($type =~ /plain/ or $type =~ /html/) and not $match) { $match = 1; $self->debug("Inserting message for search") if $CFG->{debug}; # If the message is longer than the preset limit, then only take that amount of the email to store. my $len = length($msg_data); if ($len > $CFG->{limits}->{search_body}) { substr($msg_data, 0, $CFG->{limits}->{search_body}) = ""; } if ($type eq 'text/html') { $self->html_to_text(\$msg_data); } $msg_data =~ s/\r?\n/\n/g; $msg_data =~ s/\r/\n/g; $msg_data =~ s/^(?:\s*\n)*//gs; # Keep the first 500 characters intact for the message preview. my $msg_data_stripped = substr($msg_data, 0, 500); if (length($msg_data) > 500) { $msg_data = substr($msg_data, 500); # Remove duplicate words in the message. my %seen; while ($msg_data_stripped =~ /([\w'-]+)/g) { my $word = lc($1); $seen{$word}++; } while ($msg_data =~ /([\w'-]+)/g) { my $word = lc($1); $msg_data_stripped .= $word . " " unless $seen{$word}++; } } chop $msg_data_stripped if $msg_data_stripped; $search->insert({ msgsearch_body => $msg_data_stripped, msgsearch_header => $short_header, msgsearch_mid => $id }); } if (!$part_inserted) { $data->insert({ msgdata_mid => $id, msgdata_filename => $checksum . '.1', msgdata_suggestedname => '1.txt', msgdata_size => 0, msgdata_type => 'text/plain', msgdata_encoding => '7bit', msgdata_created => \'NOW()', msgdata_boundary => '', msgdata_disposition => '', msgdata_cid => '', GT_SQL_SKIP_CHECK => 1, }); } } return ($size, $id); } END_OF_SUB $COMPILE{insert_user} = __LINE__ . <<'END_OF_SUB'; sub insert_user { # ------------------------------------------------------------------- # Used to insert into the msgtrack table for the user. This method # should not be called from a template. It was abstracted here so # the plugin system can override it. # Takes a hash reference of values to insert into the database. # Returns the message ID inserted. # my ($self, $insert, $size) = @_; $size ||= 0; # Check that the user has folders before attempting to insert a message. # If they don't have folders, then just skip the insert. require GMail::Folders; if (GMail::Folders::inbox_fid()) { my $sth = $DB->table('msgtrack')->insert($insert); $DB->table('users')->update({ users_space_used => \"users_space_used + $size" }, { userid => $USER->{userid} }); return $sth->insert_id(); } return; } END_OF_SUB $COMPILE{message_exists} = __LINE__ . <<'END_OF_SUB'; sub message_exists { # ------------------------------------------------------------------- # Not to be called from a template. # Takes a checksum and returns whether a message exists in the # msgdata/msgs table. If the message exists this returns the MID # for the message. If the message is not in the table this returns # false. # my ($self, $checksum) = @_; my $data = $DB->table('msgs'); # If the message matches the checksum no need to reinsert it # into all the tables. my $sth = $data->select('msgs_size', 'msgs_mid', { msgs_checksum => $checksum }); if ($sth->rows()) { my ($size, $id) = $sth->fetchrow(); return ($size, $id); } return; } END_OF_SUB $COMPILE{parse_date} = __LINE__ . <<'END_OF_SUB'; sub parse_date { # ------------------------------------------------------------------- # Internal use, not useful from a template. # Parse an RFC 822 5.1 compliant date into one understood by mysql. # Formats expected: # Sat, 28 Jul 2001 08:44:00 -0700 # Sat, 28 Jul 2001 08:44:00 EST # Sat, 28 Jul 2001 08:44:00 "EST" # Sat, 21 Jul 01 19:07:20 # 28 Jul 2001 14:57:07 -0000 # 28 Jul 2001 14:57:07 GMT # 28 Jul 2001 14:57:07 "GMT" # 20 May 01 6:33:30 PM # # Only the first date is an RFC date, but it appears lots of clients don't # use the RFC. # my ($self, $date) = @_; $date || return; # Fix any dates where it doesn't specify the seconds $date =~ s/ (\d?\d:\d?\d)( |$)/ $1:00$2/; my $format; CASE: for ($date) { /\w+, \d\d? \w+ \d{4} \d?\d:\d?\d:\d\d (?:[+-]\d+|\w+)/ and do { $format = '%ddd%, %d% %mmm% %yyyy% %H%:%M%:%s% %o%'; last CASE }; /\w+, \d\d? \w+ \d{4} \d?\d:\d?\d:\d\d "(?:[+-]\d+|\w+)"/ and do { $format = '%ddd%, %d% %mmm% %yyyy% %H%:%M%:%s% "%o%"'; last CASE }; /\w+, \d\d? \w+ \d{4} \d?\d:\d?\d:\d\d (?:[+-]\d+|\w+)/ and do { $format = '%ddd%, %d% %mmm% %yyyy% %H%:%M%:%s% %o%'; last CASE }; /\w+, \d\d? \w+ \d{4} \d?\d:\d?\d:\d\d "(?:[+-]\d+|\w+)"/ and do { $format = '%ddd%, %d% %mmm% %yyyy% %H%:%M%:%s% "%o%"'; last CASE }; /\w+, \d\d? \w+ \d{4} \d?\d:\d?\d:\d\d/ and do { $format = '%ddd%, %d% %mmm% %yyyy% %H%:%M%:%s%'; last CASE }; /\w+, \d\d? \w+ \d{2} \d?\d:\d?\d:\d\d/ and do { $format = '%ddd%, %d% %mmm% %yy% %H%:%M%:%s%'; last CASE }; /\w+, \d\d? \w+ \d{4} \d?\d:\d?\d:\d\d (?:[+-]\d+|\w+)/ and do { $format = '%ddd%, %d% %mmm% %yyyy% %H%:%M%:%s% %o%'; last CASE }; /\w+, \d\d? \w+ \d{4} \d?\d:\d?\d:\d\d "(?:[+-]\d+|\w+)"/ and do { $format = '%ddd%, %d% %mmm% %yyyy% %H%:%M%:%s% "%o%"'; last CASE }; /\w+, \d\d? \w+ \d{4} \d?\d:\d?\d:\d\d/ and do { $format = '%ddd%, %d% %mmm% %yyyy% %H%:%M%:%s%'; last CASE }; /\w+, \d\d? \w+ \d{2} \d?\d:\d?\d:\d\d/ and do { $format = '%ddd%, %d% %mmm% %yy% %H%:%M%:%s%'; last CASE }; /\d\d? \w+ \d{4} \d?\d:\d?\d:\d\d (?:[+-]\d+|\w+)/ and do { $format = '%d% %mmm% %yyyy% %H%:%M%:%s% %o%'; last CASE }; /\d\d? \w+ \d{4} \d?\d:\d?\d:\d\d "(?:[+-]\d+|\w+)"/ and do { $format = '%d% %mmm% %yyyy% %H%:%M%:%s% "%o%"'; last CASE }; /\d\d? \w+ \d{4} \d?\d:\d?\d:\d\d (?:[+-]\d+|\w+)/ and do { $format = '%d% %mmm% %yyyy% %H%:%M%:%s% %o%'; last CASE }; /\d\d? \w+ \d{4} \d?\d:\d?\d:\d\d "(?:[+-]\d+|\w+)"/ and do { $format = '%d% %mmm% %yyyy% %H%:%M%:%s% "%o%"'; last CASE }; /\d\d? \w+ \d{2} \d?\d:\d?\d:\d\d [AaPpMm]{2}/ and do { $format = '%d% %mmm% %yy% %h%:%M%:%s% %tt%'; last CASE }; } $format or return; return GT::Date::date_get_gm(timelocal(GT::Date::parse_format($date, $format)), '%yyyy%-%mm%-%dd% %HH%:%MM%:%ss%'); } END_OF_SUB $COMPILE{validate} = __LINE__ . <<'END_OF_SUB'; sub validate { # ------------------------------------------------------------------- # Internal Use. # Checks to see if a message can be inserted for a user. # Returns 0 or less on failure and sets the error in $GMail::error # 0 - User reached max messages # -1 - User is out of space # -2 - The email is too big # my ($self, $length, $cnt) = @_; # Message is to big if ($CFG->{limits}->{msgs_size} and $length > $CFG->{limits}->{msgs_size}) { $self->error("Message size ($length bytes) is greater then the maximum size ($CFG->{limits}->{msgs_size} bytes)", 'WARN'); return -2; } # User is out of space if ($USER->{users_space_used} + $length >= $USER->{users_space_allowed}) { $self->error("Message size (" . ($USER->{users_space_used} + $length) . " bytes) brings the user over their maximum limit ($USER->{users_space_allowed} bytes)", 'WARN'); return -1; } # User has too many messages defined($cnt) or $cnt = $DB->table('msgtrack')->count({ msgtrack_userid => $USER->{userid} }); if ($CFG->{limits}->{msgs_max} and $cnt >= $CFG->{limits}->{msgs_max}) { $self->error("This message brings the user over their maximum messages allowed ($CFG->{limits}->{msgs_max})", 'WARN'); return 0; } # Can insert now return 1; } END_OF_SUB sub get_message_checksum { # ------------------------------------------------------------------- my ( $self, $head, $ch_header, $ch_size ) = @_; $ch_size -= length($1) while $ch_header =~ s/^(Date:.*\n)//im; if ($head->split_field('to') > 1) { $ch_size -= length($1) while ($ch_header =~ s/^(Received:.*\n(?:^[\t ]+.*\n)*)//im); $ch_size -= length($1) while ($ch_header =~ s/^(Message-Id:.*\n)//im); } require GT::MD5; return GT::MD5::md5_hex($ch_header . $ch_size); } sub get_attachlist { # ------------------------------------------------------------------- # Internal Use. # Return ([array-ref-of-attachment-hash-refs], {body-hash-ref}) # given a message id, and optionally a desired body type (text or html). # my ($self, $id, $body_type, $strip_rel) = @_; my $body = {}; my $table = $DB->table('msgtrack', 'msgs', 'msgdata'); $table->select_options("ORDER BY msgdata_did ASC"); my $sth = $table->select({ msgtrack_id => $id, msgtrack_userid => $USER->{userid} }); # Possible to have a message with no body! if (!$sth->rows) { $table = $DB->table('msgtrack', 'msgs'); $sth = $table->select({ msgtrack_id => $id, msgtrack_userid => $USER->{userid} }); $sth->rows or return $self->error("MSGERR_NOBODY", "WARN"); } # Get a list of the messages parts my @attachlist = (); while (my $data = $sth->fetchrow_hashref()) { push @attachlist, $data } my $i = 0; my $remove; $body_type ||= $USER->{opts}->{display}->{email_part}; if ($body_type ne 'text' and $body_type ne 'html') { $body_type = 'text'; } if ($attachlist[0]->{msgs_content} and $attachlist[0]->{msgs_content} =~ /alternative|related/i and $body_type) { my @found_part; for (my $i = 0; $i < @attachlist; $i++) { next if ($attachlist[$i]->{msgdata_disposition} and $attachlist[$i]->{msgdata_disposition} eq 'attachment'); if (!$body and $body_type eq 'text' and $attachlist[$i]->{msgdata_type} =~ m,text/plain,) { $body = splice(@attachlist, $i, 1); } elsif (!$body and $body_type eq 'html' and $attachlist[$i]->{msgdata_type} =~ m,text/html,) { $body = splice(@attachlist, $i, 1); } elsif ($body_type eq 'text' and $attachlist[$i]->{msgdata_type} =~ m,text/html,) { push @found_part, splice(@attachlist, $i, 1); } elsif ($body_type eq 'html' and $attachlist[$i]->{msgdata_type} =~ m,text/plain,) { push @found_part, splice(@attachlist, $i, 1); } } $body ||= pop @found_part; unshift @attachlist, @found_part unless $strip_rel; } my ($has_non_viewable, $has_viewable, $has_viewable_attach, $has_non_viewable_attach, $first_part); for (@attachlist) { $_->{msgdata_type} ||= 'text/plain'; $_->{msgdata_mime_icon} = $self->mime_guess($_); $_->{msgdata_format} ||= ''; $_->{msgdata_charset} ||= ''; $i++; $_->{msgdata_suggestedname} ||= ''; $_->{msgdata_type} ||= ''; if ($_->{msgdata_suggestedname} =~ /^\d+(?:\.\w+)?$/) { $_->{msgdata_bad_name} = 1; } else { $_->{msgdata_bad_name} = 0; } for my $type (qw|image/gif image/jpg image/jpeg image/png|) { if ($_->{msgdata_type} eq $type and !$_->{msgdata_cid}) { $_->{msgdata_is_image} = 1; last; } } $_->{msgdata_is_image} ||= 0; if ($_->{msgdata_type} eq 'text/plain' or $_->{msgdata_type} eq 'text/html' or $_->{msgdata_suggestedname} =~ /\.html?$/i or $_->{msgdata_suggestedname} =~ /\.txt$/i) { $_->{msgdata_can_browse} = 1; } else { $_->{msgdata_can_browse} = 0; } if ($_->{msgdata_can_browse} or $_->{msgdata_is_image} and lc($_->{msgdata_format}) ne 'flowed') { $has_viewable++; } elsif (lc($_->{msgdata_format}) ne 'flowed') { $has_non_viewable++; } $_->{msgdata_disposition} ||= ''; if ((!keys %{$body}) and $_->{msgdata_disposition} ne 'attachment') { if (($_->{msgdata_type} eq 'text/plain') and $body_type eq 'text') { $body = $attachlist[$i - 1]; $remove = $i - 1; } elsif (($_->{msgdata_type} eq 'text/html') and $body_type eq 'html') { $body = $attachlist[$i - 1]; $remove = $i - 1; } elsif (! defined $first_part and (($_->{msgdata_type} eq 'text/plain') or ($_->{msgdata_type} eq 'text/html'))) { $first_part = $i - 1; } elsif ($_->{msgdata_can_browse}) { $has_viewable_attach++; } else { $has_non_viewable_attach++; } } else { if ($_->{msgdata_can_browse} or $_->{msgdata_is_image}) { $has_viewable_attach++; } elsif ($_->{msgdata_cid}) { my $match; for my $att (@attachlist) { $att->{msgdata_type} ||= ''; next unless $att->{msgdata_type} eq 'text/html'; my $b = $self->format_message($att, 1); if ($b =~ /\Q$_->{msgdata_cid}\E/) { $match = 1; last; } } if (!$match) { $has_non_viewable_attach++; } } else { $has_non_viewable_attach++; } } } splice(@attachlist, $remove, 1) if defined $remove; if (!keys %{$body}) { if (defined $first_part) { $body = splice(@attachlist, $first_part, 1); } else { for (keys %{$attachlist[0]}) { next unless /^msgs_/ || /^msgtrack_/; $body->{$_} = $attachlist[0]->{$_}; } } } elsif (defined $first_part) { $has_viewable_attach++; } ($body->{msgs_sent_from_name}, $body->{msgs_sent_from_email}) = $self->parse_address($body->{msgs_sent_from} || ''); if ($body->{msgs_sent_from_name} =~ /\s/) { ($body->{msgs_sent_from_first_name}, $body->{msgs_sent_from_last_name}) = split ' ' => $body->{msgs_sent_from_name}; } $body->{msgs_has_non_viewable} = $has_non_viewable; $body->{msgs_has_viewable} = $has_viewable; $body->{msgs_has_non_viewable_attach} = $has_non_viewable_attach; $body->{msgs_has_viewable_attach} = $has_viewable_attach; $body->{msgdata_mime_icon} = $self->mime_guess($body); return (\@attachlist, $body); } sub parse_address { # ----------------------------------------------------------------------------- # Parses out the name and e-mail address of a given "address". For example, # from: "Jason Rhinelander" , this will return # ('Jason Rhinelander', 'jason@gossamer-threads.com'). It handes escapes as # well - "Jason \(\"jagerman\"\) Rhinelander" # returns 'Jason ("jagerman") Rhinelander' for the name. # my ($self, $email_from) = @_; my ($name, $email) = ('', ''); if ($email_from =~ /"?((?:[^<"\\]|\\.)+?)"?\s*<([^>]+)>/) { ($name, $email) = ($1, $2); $name =~ s/\\(.)/$1/g; $name =~ s/^\s*$//; } elsif ($email_from =~ /<([^>]+)>/) { $email = $1; } else { $email = $email_from || ''; $email =~ s/\([^)]+\)//g; } return ($name, $email); } sub sort_addresses { # ----------------------------------------------------------------------------- # Takes an array reference of hash references and sorts them, changing the # array reference passed. For strictly speed purposes, this doesn't sort # exactly like the return value from parse_address above; instead it just # removes any leading ", then sorts. # my ($self, $addrs, $key) = @_; my %c; @$addrs = sort { ($c{int $a} ||= lc(index($a->{$key}, '"') == 0 ? substr($a->{$key}, 1) : $a->{$key})) cmp ($c{int $b} ||= lc(index($b->{$key}, '"') == 0 ? substr($b->{$key}, 1) : $b->{$key})) } @$addrs; return; } sub mime_guess { my ($self, $msg) = @_; my $image; if (!ref $msg) { if ($msg =~ /\.([^.]+)$/) { return $MIME_EXT{lc $1}; } else { return; } } # If we have a filename with an extention use that my $p = substr($msg->{msgdata_filename}, 0, 1) . '/' . substr($msg->{msgdata_filename}, 1, 1) . '/' . substr($msg->{msgdata_filename}, 2, 1); my $file = "$CFG->{location}->{path}->{data}/msgs/$p/$msg->{msgdata_filename}"; if ($msg->{msgdata_suggestedname} and $msg->{msgdata_suggestedname} =~ /\.([^.]+)$/ and exists $MIME_EXT{lc $1}) { $image = $MIME_EXT{lc $1}; } elsif (exists $MIME_TYPE{lc $msg->{msgdata_type}}) { $image = $MIME_TYPE{lc $msg->{msgdata_type}}; } elsif (-B $file) { $image = 'binary.gif'; } elsif ($msg->{msgdata_suggestedname} and lc($msg->{msgdata_suggestedname}) =~ /readme/) { $image = 'readme.gif'; } elsif (-T _) { $image = 'txt.gif'; } else { $image = 'unknown.gif'; } return $image; } 1;