# ================================================================== # Gossamer Mail - enhanced email management system # # Website : http://gossamer-threads.com/ # Support : http://gossamer-threads.com/scripts/support/ # Revision : $Id: Messages.pm,v 1.141 2002/08/01 19:41:55 brewt Exp $ # # Copyright (c) 2001 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 %COMPILE $AUTOLOAD %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/; # 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', ); sub AUTOLOAD { # ------------------------------------------------------------------- # Autoload methods that are used. # my ($self, $param) = @_; my ($attrib) = $AUTOLOAD =~ /::([^:]+)$/; if (exists $COMPILE{$attrib}) { eval qq{\n# line 0 "GMail::Messages::$attrib"\n$COMPILE{$attrib}}; if ($@) { die "GMail::Messages: Can't compile '$attrib'. Reason: $@"; } goto &$attrib; } else { die "Unknown method GMail::Messages::$attrib"; } } $COMPILE{info} = <<'END_OF_CODE'; 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_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} || INBOX; my ($name, $sth); # Find the folder id based on a name if ($fid =~ /\D/) { $fid = $self->_find_folder($fid); } $sth = $DB->table('folders')->select({ folders_fid => $fid, folders_userid => $USER->{userid}, }); my $folder = $sth->fetchrow_hashref(); # Temporary and partial fix for the root/parent message in another folder bug. # This problem mostly occurs in the INBOX, so we'll disable threaded mode if # the current folder is the INBOX. if ($fid == INBOX and $folder->{folders_display_threaded}) { $folder->{folders_display_threaded} = 0; } # 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'); # Do not want the ID in the query $sth = $tb->query_sth($opt); my $hits = $tb->hits() || 0; my $unread = $DB->table('msgtrack')->count({ msgtrack_userid => $USER->{userid}, msgtrack_fid => $fid, msgtrack_status => 'New', }); # Go through the message and produce the list my ($msg_size, @list) = (0); if ($sth) { my $pos = ($opt->{nh} - 1) * $opt->{mh}; while (my $msg = $sth->fetchrow_hashref()) { $pos++; $msg_size += $msg->{msgs_size}; $self->format_msgs_row($msg); $msg->{msgs_pos} = $pos; push @list, $msg; } } # 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}}; } } # If there are enough messaqe produce the toolbar my $toolbar = ''; my $maxhits = $opt->{mh} || $folder->{folders_per_page} || S_MH_DEFAULT; my $nh = ($opt->{nh} || 1); if ($hits > $opt->{mh}) { 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/; my $html = $DB->html($tb, $IN); $toolbar = $html = $html->toolbar($nh, $maxhits, $hits, $url); } 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 => $opt->{nh} || '', msgtrack_fid => $cgi->{msgtrack_fid}, msgs_list => \@list, msgs_list_num => scalar @list, msgs_toolbar => \$toolbar, 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_CODE $COMPILE{view} = <<'END_OF_CODE'; 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} || INBOX; 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_CODE $COMPILE{format_msgs_row} = <<'END_OF_CODE'; sub format_msgs_row { my ($self, $msg) = @_; # Get the name of the person that the email was from ($msg->{msgs_sent_from_name}, $msg->{msgs_sent_from_email}) = $self->parse_email($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}; } 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 ($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}]); } if (defined($USER->{opts}->{display}->{date_offset}) || defined $CFG->{date_offset}) { my $offset_cfg = defined($USER->{opts}->{display}->{date_offset}) ? $USER->{opts}->{display}->{date_offset} : $CFG->{date_offset}; my $offset; ($offset, undef) = split /\|/ => $offset_cfg; $time += ($offset * 60); } if ((localtime($time))[8]) { $time += 3600; } $msg->{msgs_sent} = date_get($time, $format); $msg->{msgs_size} = $self->format_size($msg->{msgs_size}); } END_OF_CODE $COMPILE{_find_folder} = <<'END_OF_CODE'; 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) = @_; if (uc($fid) eq 'INBOX') { $fid = INBOX; } elsif (uc($fid) eq 'SENT') { $fid = SENT; } elsif (uc($fid) eq 'TRASH') { $fid = TRASH; } 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 = INBOX; } } else { $fid = INBOX; } return $fid; } END_OF_CODE $COMPILE{_disp_opts} = <<'END_OF_CODE'; sub _disp_opts { # ------------------------------------------------------------------- # Internal method to format cgi input for displaying a list of # messages ot 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_CODE $COMPILE{header} = <<'END_OF_CODE'; 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}; $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, "$!"); my $header = ''; while () { last if (/^\r?\n$/); $header .= $_; } close FILE; $IN->html_escape(\$header); if ($cgi->{highlight}) { my $start = $IN->param('highlight_start'); my $stop = $IN->param('highlight_stop'); if (!$start or !$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->{$_}; } if (@head) { for (@head) { next unless defined and length; $header =~ s/(\Q$_\E)/$start$1$stop/ig; } } } return { msgsearch_header => \$header }; } END_OF_CODE $COMPILE{print_source} = <<'END_OF_CODE'; 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_CODE $COMPILE{print_attach} = <<'END_OF_CODE'; 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}"; 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'; # Open it, print the proper header and display it -e $data or return $self->error('ATTACHERR_EXIST', 'WARN', $data); 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_CODE 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(@_); } 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(@_); } $COMPILE{delete} = <<'END_OF_CODE'; 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}; # 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_id, $id) = $sth->fetchrow()) { if ($folder_id == TRASH or !$delete_to_trash) { push @trash, $id; } else { push @del, $id; } } if (@del) { my @ret = $self->move(TRASH, @del) or return; $cnt = $ret[1]; } if (@trash) { $fid = TRASH; @del_list = @trash; } else { return { message => 'MSG_DEL' }, $cnt; } } else { $fid =~ /^\d+$/ or return $self->error('MSGERR_DEL_FOLDID', 'WARN', $fid); } # Either move to trash or delete if ($fid == TRASH or !$delete_to_trash) { # Annoying, I have to count because of FK reltions $cnt += $tb->count({ msgtrack_id => \@del_list, msgtrack_userid => $USER->{userid} }); # Delete the message. $tb->delete({ msgtrack_id => \@del_list, msgtrack_userid => $USER->{userid} }, 'cleanup'); } else { my @ret = $PLG->dispatch('GMail::Messages::move', sub { $self->move(@_) }, TRASH, @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_CODE $COMPILE{change_status} = <<'END_OF_CODE'; 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} } ); # 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_CODE sub move_group { shift->move(@_); } sub move_message { shift->move(@_); } $COMPILE{move} = <<'END_OF_CODE'; 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+$/ 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_CODE $COMPILE{move_all} = <<'END_OF_CODE'; 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_CODE $COMPILE{move_folder} = <<'END_OF_CODE'; 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_CODE $COMPILE{delete_folder} = <<'END_OF_CODE'; sub delete_folder { # ------------------------------------------------------------------- # This method deletes all messages in a given folder. The folder ID # to delete from can be passed in as the first argument. If it is # not, it will be pulled from cgi input as folders_fid. All messages # in the folder will be moved to the trash folder. If the folder # specified is the trash folder the messages will be delete # perminantly from the system. # 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); # Delete the message. This cascads to msgdata. my $cnt; if ($fid != TRASH) { my @r = $PLG->dispatch('GMail::Messages::move_folder', sub { $self->move_folder(@_) }, $fid, TRASH) or return; $cnt = $r[1]; } else { # Annoying, because of FK relations I have to select to see how many # messages I am deleting my $tb = $DB->table('msgtrack'); $cnt = $tb->count({ msgtrack_fid => $fid, msgtrack_userid => $USER->{userid} }); $tb->delete({ msgtrack_fid => $fid, msgtrack_userid => $USER->{userid} }, 'cleanup'); # Update the folders list $PLG->dispatch('GMail::Folder::update', sub { GMail::Folders->update(@_) }, $fid); } # Update folders here return { message => 'MSG_FOLD_DEL' }, $cnt; } END_OF_CODE $COMPILE{delete_folder_duplicates} = <<'END_OF_CODE'; 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_CODE $COMPILE{format_message} = <<'END_OF_CODE'; 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_CODE $COMPILE{insert_data} = <<'END_OF_CODE'; 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 =~ s/[\r\n]//g; 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_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') || ''), 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->touch("$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->touch($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') { $msg_data =~ s///sg; my @tokens = split /(<[^>"']*(?:(?:(?:"[^"]*"[^>"]*)|(?:'[^']*'[^>']*)))*>)/, $msg_data; $msg_data = join ' ' => map { $tokens[$_] } grep { not $_ % 2 } 0 .. $#tokens; } $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_CODE $COMPILE{insert_user} = <<'END_OF_CODE'; 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; 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(); } END_OF_CODE $COMPILE{message_exists} = <<'END_OF_CODE'; 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_CODE $COMPILE{parse_date} = <<'END_OF_CODE'; 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; 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_CODE $COMPILE{validate} = <<'END_OF_CODE'; 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 ($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 ($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_CODE sub get_message_checksum { # ------------------------------------------------------------------- my ( $self, $head, $ch_header, $ch_size ) = @_; $ch_size -= length($1) while $ch_header =~ s/^(Date:.*\n)//im; $ch_size -= length $1 while $ch_header =~ s/^(Delivered-To:.*\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. # my ($self, $id) = @_; 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; if ($attachlist[0]->{msgs_content} and $attachlist[0]->{msgs_content} =~ /(?:alternative)|(?:related)/i and $USER->{opts}->{display}->{email_part}) { for (0 .. $#attachlist) { next if ($attachlist[$_]->{msgdata_disposition} and $attachlist[$_]->{msgdata_disposition} eq 'attachment'); if ($USER->{opts}->{display}->{email_part} eq 'text' and $attachlist[$_]->{msgdata_type} =~ m,text/plain,) { $body = splice(@attachlist, $_, 1); last; } elsif ($USER->{opts}->{display}->{email_part} eq 'html' and $attachlist[$_]->{msgdata_type} =~ m,text/html,) { $body = splice(@attachlist, $_, 1); last; } } } my ($has_non_viewable, $has_viewable, $has_viewable_attach, $has_non_viewable_attach, $first_part); $USER->{opts}->{display}->{email_part} ||= 'text'; 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/gif 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 $USER->{opts}->{display}->{email_part} eq 'text') { $body = $attachlist[$i - 1]; $remove = $i - 1; } elsif (($_->{msgdata_type} eq 'text/html') and $USER->{opts}->{display}->{email_part} 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_email($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_email { my ($self, $email_from) = @_; my ($name, $email) = ('', ''); if ($email_from =~ /"?([^<"]+)"?\s*<([^>]+)>/) { $name = $1; $email = $2; $name =~ s/^\s*$//; } elsif ($email_from =~ /<([^>]+)>/) { $email = $1; } else { $email = $email_from || ''; $email =~ s/\([^)]+\)//g; } return ($name, $email); } 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; } # Preload methods under mod_perl if ($PERSIST) { foreach my $sub (keys %COMPILE) { eval qq{\n# line 0 "GMail::Messages::$sub"\n$COMPILE{$sub}}; if ($@) { die "GMail::Messages: Unable to compile: $sub ($@)"; } } } 1;