## $Id: prontolib.pl,v 1.23 2002/05/21 00:46:32 muhri Exp $
use vars qw( %prefs $libpath $locale $locale_installed);
use strict;
use DBI;
use Date::Manip;
use MIME::Words;
#locale stuff
($locale, $locale_installed) = 0;
$locale = "use Locale::gettext"; #localized text
eval $locale; $locale_installed = 1 unless $@;
# abreviated call for gettext
sub _
{
return gettext(@_) if ($locale_installed);
return join('',@_) if (!$locale_installed);
}
$locale_installed = 0 if ($ENV{'LC_MESSAGES'} && $ENV{'LC_MESSAGES'} eq "en" || $ENV{'LANG'} && $ENV{'LANG'} eq "C");
if ($locale_installed) {
if (!defined &Gtk::set_locale) {
# print("Gtk->set_locale() call is not avaiable in your version of Gtk::Perl\nPlease upgrade if you want to see Gtk+ common dialogs in your native locale\n");
} else {
Gtk->set_locale();
}
bindtextdomain("pronto", "/usr/share/locale");
textdomain("pronto");
}
#
# Set up default preferences
#
$prefs{'HtmlAllowed'} = 'html head title body body:* body:bgcolor body:text body:link body:alink body:vlink h1 h2 h3 h4 a a:href hr hr:width table table:* table:width table:height table:border table:bgcolor table:cellspacing table:cellpadding tr tr:* tr:width tr:height tr:bgcolor tr:border tr:align tr:valign td:* td td:width td:height td:bgcolor td:rowspan td:colspan td:border td:align td:valign th th:* th:width th:height th:bgcolor b i u strong em font font:* font:color font:face font:style p br div div:align span span:style ul ol li center blockquote img img:* img:src';
# omitted tags: form input select option textarea iframe ilayer layer
$prefs{'User'} = $ENV{"USER"};
$prefs{'MailDir'} = $ENV{"HOME"} . '/.pronto';
$prefs{'HomePage'} = "http://www.muhri.net/pronto";
$prefs{'BoldMsg'} = 0;
$prefs{'AutoCheckTime'}=10; # minutes
$prefs{'MaxFetchSize'} =0; # Kbytes
$prefs{'AddReplytoAB'}="n";
$prefs{'SortCol'} = '6';
$prefs{'SortDir'} = "ascending";
$prefs{'SendImmediately'}="y";
$prefs{'ForwardAttachments'} = "y";
$prefs{'FolderNewBold'}="y";
$prefs{'InlineImages'}="y";
$prefs{'InlineAttachments'}="y";
$prefs{'InlineIcons'}="y";
$prefs{'Scoring'} = "y";
$prefs{'HeaderBar'}="y";
$prefs{'Debug'} = 0;
$prefs{'DebugFile'} = "$prefs{'MailDir'}/pronto.debug";
$prefs{'DocDir'} = $libpath . '/docs';
$prefs{'PixmapDir'} = $libpath . '/pixmaps/penguin';
$prefs{'DatabaseDriver'} = "CSV";
$prefs{'DatabaseUser'} = "";
$prefs{'DatabaseHost'} = "localhost";
$prefs{'MySQLPort'} = 3306;
$prefs{'PgSQLPort'} = 5432;
$prefs{'MsgInDB'} = "n";
$prefs{'FontUIBold'} = '-adobe-helvetica-bold-r-normal-*-*-120-*-*-p-*-iso8859-1';
$prefs{'FontMLBold'} = '-adobe-helvetica-bold-r-normal-*-*-120-*-*-p-*-iso8859-1';
$prefs{'FontMessages'} = '-adobe-helvetica-medium-r-normal-*-*-120-*-*-p-*-iso8859-1';
$prefs{'FontMLNormal'} = '-adobe-helvetica-medium-r-normal-*-*-120-*-*-p-*-iso8859-1';
$prefs{'FontComposer'} = '-adobe-helvetica-medium-r-normal-*-*-120-*-*-p-*-iso8859-1';
$prefs{'MsgFontFace'} = 'helvetica';
$prefs{'FontSwitch'} = 0;
$prefs{'MarkAsReadDelay'} = 2; # seconds
$prefs{'QuoteHeader'} = "On %d, %n said:";
$prefs{'WrapAfter'} = 80; #columns
$prefs{'DateDisplayFormat'} = '%M/%d/%y %h:%m';
# %M = month, %d = day, %y = 2 digit year, %Y = 4 digit year, %m = minute, %h = hour, %s = seconds
$prefs{'ViewerPath'} = "/usr/bin/netscape";
$prefs{'SendReceipt'} = "ask";
$prefs{'PrintCommand'} = "lpr";
$prefs{'QuoteWith'} = "> ";
$prefs{'saveSize'} = "y";
$prefs{'PlaySound'} = "n";
$prefs{'DeleteMarksAsRead'} = "n";
$prefs{'import'} = "n";
$prefs{'checkDupeOnAll'}='n';
$prefs{'ForwardHeader'}='y';
$prefs{'ispellpath'} = "/usr/bin/ispell";
$prefs{'autospell'} = "n";
$prefs{'toolbar'} = "y";
$prefs{'toolbarstyle'} = "both";
$prefs{'useAlternateViewer'} = "n";
$prefs{'attachLeftView'} = "n";
$prefs{'UseMessageColors'} = "y";
$prefs{'UseMessageColorsMaxLength'} = "36000";
$prefs{'MessageColor'} = "000000";
$prefs{'QuoteColor1'} = "FF0000";
$prefs{'QuoteColor2'} = "0000FF";
$prefs{'QuoteColor3'} = "FF00FF";
$prefs{'QuoteSymbols'} = "> ,> ,>";
$prefs{'MessageBgColor'} = "FFFFFF";
$prefs{'startin'} = "None";
$prefs{'CheckMailOnStartup'} = "n";
$prefs{'NoHTML'} = "n";
$prefs{'viewpane'} = "y";
$prefs{'useGtkFontComposer'} = "y";
$prefs{'msgcolumn'} = "y";
$prefs{'newcolumn'} = "y";
$prefs{'onfolderchange'} = "No";
$prefs{'prioritycolumn'} = "y";
$prefs{'attachcolumn'} = "y";
$prefs{'msgnewcolumn'} = "y";
$prefs{'servercolumn'} = "y";
$prefs{'messageview'} = "clist";
$prefs{'threadstyle'} = "solid";
$prefs{'threadpref'} = "expanded";
$prefs{'popalwaysnew'} = "n";
$prefs{'RecMsgCount'} = "n";
$prefs{'AutoCheckProgress'} = 0; #0 for no, 1 for yes.
$prefs{'GuessRejectThreads'} = "y";
$prefs{'Layout'} = 1; # 1 for standard - 2 for folder tree runs through the whole screen
$prefs{'gpgpath'} = "/usr/local/bin/gpg";
$prefs{'forkget'} = 1;
$prefs{'forksend'} = 1;
$prefs{'threadbysubject'} = "n";
$prefs{'arrowthreads'} = "n";
$prefs{'threadarrow'} = " -->";
$prefs{'expander'} = "triangle";
$prefs{'empty_trash_on_exit'} = 0;
$prefs{'ExternalSig'} = 0;
$prefs{'CharSet'} = "iso-8859-1";
$prefs{'IncludeReplyTo'} = 1;
$prefs{'POP3Verbose'} = 1;
$prefs{'Splash'} = 1;
$prefs{'SliceSig'} = 0;
$prefs{'EmptyNoBlock'} = 0;
$prefs{'Drag'} = 1;
$prefs{'autosave'} = 1;
$prefs{'FTDetached'} = 0;
$prefs{'ToolTips'} = 1;
$prefs{'AddybookSort'} = 0;
$prefs{'use_http_proxy'} = 0; #get pop3 via http_proxy?
#toolbar buttons
$prefs{'ButtonSAndR'} = 1;
$prefs{'ButtonNew'} = 1;
$prefs{'ButtonReply'} = 1;
$prefs{'ButtonReplyAll'} = 1;
$prefs{'ButtonForward'} = 1;
$prefs{'ButtonDelete'} = 1;
$prefs{'ButtonAddyBook'} = 1;
$prefs{'UndoEnabled'} = 0;
$prefs{'dictionary'} = "";
$prefs{'forget_passphrase'} = 1;
## End Default Prefs.
sub numerically { $a <=> $b; }
sub process_from
{
my $result;
my $from = $_[0];
$from =~ /\((.+)\)$/ and $result = $1;
$from =~ /^(.+) <.+>/ and $result = $1;
$from =~ /^\"(.+)\"/ and $result = $1;
if (!$result) { $result = $from; }
return $result;
}
sub save_prefs
{
open(FILE_PREFS, '>'. $ENV{"HOME"} . '/.prontorc');
my $key;
foreach $key (sort keys %prefs) {
print FILE_PREFS "$key: $prefs{$key}\n";
};
close(FILE_PREFS);
chmod(0600, $ENV{"HOME"} . '/.prontorc');
}
# &err_dialog("your error here"); and you'll get a nice
# dialog popup... add a "y" for a modal dialog to block the parent process esp.
# in prontosend and prontoget.
sub err_dialog
{
my ($error,$modal,$title) = @_;
my ($dlg, $lbl, $ok);
$dlg = new Gtk::Dialog;
if (defined $modal and $modal eq "y") {
$dlg->set_modal(1);
}
$dlg->signal_connect("destroy" => sub { $dlg->destroy; });
$dlg->signal_connect("delete_event" => \&Gtk::false);
if (not defined $title) {
$dlg->set_title(_("Error"));
} else {
$dlg->set_title($title);
}
$dlg->border_width(10);
$dlg->position(-mouse);
$dlg->set_default_size(150, 100);
$lbl = new Gtk::Label "$error";
$lbl->set_alignment(0.5,0.5);
$lbl->set_line_wrap(1);
$dlg->vbox->pack_start($lbl,1,1,5);
$lbl->show;
$ok = new Gtk::Button "Ok";
if (defined $modal and $modal eq "y") {
$ok->signal_connect("clicked", sub { $dlg->destroy; Gtk->main_quit(); });
} else {
$ok->signal_connect("clicked", sub { $dlg->destroy; });
}
$ok->set_usize(55,25);
$ok->show;
$dlg->action_area->pack_start($ok,0,0,5);
$dlg->show;
$ok->grab_focus();
if (defined $modal and $modal eq "y") {
main Gtk;
} else {
return 1;
}
}
sub read_prefs
{
open(FILE_PREFS, $ENV{"HOME"} . '/.prontorc') || return 0;
while (<FILE_PREFS>) {
if (m/^#/) { next; }
if (m/^(\w+):\s+(.*)$/) { $prefs{$1} = $2; };
}
return 1;
}
## Added debug and command-line flag handling <red@madhouse.org.uk>
## wr_debug("sometext") - appends a line or more to debug file.
sub wr_debug
{
if (!($prefs{'Debug'})) { return; }
my $line_in = join('', @_);
if ($prefs{'Debug'} & 2) {
open(FILE_FD, '>>'.$prefs{'DebugFile'}) || die "Can't open debug file for writing: $!";
print(FILE_FD "$line_in\n");
close(FILE_FD);
}
if ($prefs{'Debug'} & 1) { print("$line_in\n"); }
}
## $tree = filename_to_tree($original_filename, $check_path); <red@madhouse.org.uk>
# Function that translates the original filename into tree format.
# Tree format is required as filesystems are horrifically inefficient
# when we reach large numbers of files in a single directory.
#
# DEPRECIATED use Pronto::Data::Message::get_* if possible
sub filename_to_tree
{
my ($message_number, $first_dir, $second_dir, $filename, $start_path, @digits);
my ($original_filename) = @_;
$original_filename =~ /(.*)\/(\d+)/;
$start_path = $1;
$message_number = $2;
@digits = split(//, $message_number);
if ($#digits == 0) {
$digits[1] = $digits[0];
$digits[0] = 0;
$message_number = "0$digits[1]";
}
$first_dir = $digits[$#digits];
$second_dir = $digits[($#digits-1)];
mkdir("$start_path/$first_dir", 0700);
mkdir("$start_path/$first_dir/$second_dir", 0700);
return("$start_path/$first_dir/$second_dir/$message_number.msg");
}
sub date_to_localdate
{
my ($date) = @_;
$date =~ s/\r//g;
$date =~ s/\\//g;
$date =~ s/:(\d):/:0$1:/;
$date =~ s/ (\d):/ 0$1:/;
$date =~ s/:(\d)(\s|$)/:0$1$2/;
$date =~ s/PM//i;
$date =~ s/ 100 / 2000 /; # mutt?
$date =~ s/ 0100 / 2000 /; # yeah there are some broken like that...
$date =~ s/Pacific Daylight Time/PDT/i;
$date =~ s/Eastern Standard Time/EST/i;
$date =~ s/Eastern Daylight Time/EDT/i;
$date =~ s/\"GMT\"/GMT/i;
$date =~ s/US\/EASTERN/EST/i;
$date =~ s/ -(\d\d\d)(\s|$)/ -0$1$2/i;
$date =~ s/ fr/ GMT/i;
$date =~ s/GMT([+|-])(\d)\b/${1}0${2}00/;
$date =~ s/GMT([+|-])(\d\d)\b/${1}${2}00/;
$date =~ s/\(\)//;
my $localdate = &UnixDate($date, "%s");
if ($localdate) {
return $localdate;
} else {
return &UnixDate("now","%s");
}
}
sub localdate_to_displaydate
{
my ($localdate) = @_;
my $datestr = $prefs{'DateDisplayFormat'};
if (defined $localdate && $localdate =~ /^\d+$/) {
my @tm = localtime($localdate);
$tm[4]++; # increment month, it is originally 0-based
my $shortyear = $tm[5] % 100; # convert year to two-digit
$tm[5]+=1900;
for (my $i = 0; $i<5; $i++) {
$tm[$i] = sprintf("%.2d", $tm[$i]);
}
$shortyear = sprintf("%.2d", $shortyear);
$datestr =~ s/%d/$tm[3]/g;
$datestr =~ s/%M/$tm[4]/g;
$datestr =~ s/%y/$shortyear/g;
$datestr =~ s/%Y/$tm[5]/g;
$datestr =~ s/%h/$tm[2]/g;
$datestr =~ s/%m/$tm[1]/g;
$datestr =~ s/%s/$tm[0]/g;
return($datestr);
}
return _("Invalid Date");
}
sub date_now
{
return &UnixDate("now", "%g");
}
sub open_db_conn
{
my ($test_conn) = @_; #dont die if we are only testing.
my $conn = undef;
if ($prefs{'DatabaseDriver'} eq 'CSV') {
$conn = DBI->connect("DBI:$prefs{'DatabaseDriver'}:f_dir=$prefs{'MailDir'}", {AutoCommit => 1}); #or die "Cannot create message database files in $prefs{'MailDir'}";
} elsif ($prefs{'DatabaseDriver'} eq "mysql") {
$conn = DBI->connect("DBI:$prefs{'DatabaseDriver'}:dbname=$prefs{'User'};host=$prefs{'DatabaseHost'};port=$prefs{'MySQLPort'}",$prefs{'DatabaseUser'},$prefs{'DatabasePassword'}, {AutoCommit => 1}); #or die "Cannot connect to database $prefs{'User'} using $prefs{'DatabaseDriver'}. Make sure that you have installed and configured DBI drivers on this machine.";
} elsif ($prefs{'DatabaseDriver'} eq "Pg") {
$conn = DBI->connect("DBI:$prefs{'DatabaseDriver'}:dbname=$prefs{'User'};host=$prefs{'DatabaseHost'};port=$prefs{'PgSQLPort'}",$prefs{'DatabaseUser'},$prefs{'DatabasePassword'}, {AutoCommit => 1});# or die "Cannot connect to daabase $prefs{'User'} using $prefs{'DatabaseDriver'}. Make sure that you have installed and configured DBI drivers on this machine.";
}
if (!$conn && !$test_conn) {
err_dialog(_("Error while trying to connect to the database"),"y",_("Fatal Error"));
exit(0);
}
my $d = "DBD::$prefs{'DatabaseDriver'}"; # keep the driver version handy for checks of things that a certain version cant do.
$prefs{'DriverVersion'} = $d->VERSION();
return $conn;
}
# generate a unique id for that table fast
sub newid
{
my ($table_name, $conn)=@_;
my ($query, @row);
$query=$conn->prepare("select id from $table_name order by id desc");
$query->execute();
@row=$query->fetchrow_array();
return $row[0]+1 if ($row[0]);
return 1 if (!$row[0])
}
#folder must use this
sub newid_folder
{
my ($table_name, $conn) = @_;
my ($query, @row);
my $last = 0;
$query=$conn->prepare("select id from $table_name order by id");
$query->execute();
while (@row=$query->fetchrow_array()) {
if ($last == $row[0] || $last+1 == $row[0]) { $last = $row[0]; next; }
return $last+1;
}
return $last+1;
}
#for vfolder
sub newid1000
{
my ($table_name, $conn)=@_;
my ($query, @row);
$query=$conn->prepare("select id from $table_name order by id desc");
$query->execute();
@row=$query->fetchrow_array();
return $row[0]+1;
}
## $isdupe=&checkForDupe($dbconnection, $messageid, $accountid);
##
## checks if the message $messageid is already dawnloaded (in $accountid)
## returns undef if it's no dupe
sub checkForDupe
{
my ($conn, $msgid, $accountid, $size)=@_;
my ($query, $sql, $row, $dupes);
# okay, now lets check if the mail already exists
if (defined $prefs{'checkDupeOnAll'} && $prefs{'checkDupeOnAll'} eq "y"){
$sql="select serverstat from messages where msgid=?";
$query=$conn->prepare($sql);
$query->execute($msgid);
} else {
$sql="select serverstat from messages where msgid=? and accountid=?";
$query=$conn->prepare($sql);
$query->execute($msgid, $accountid);
}
$row=$query->fetchall_arrayref;
$dupes=scalar(@{$row});
&wr_debug("-- dupeCheck: $msgid ->".$dupes." dupes found");
my $actionflag = undef;
if ($dupes==0){
$dupes=undef;
} else {
my $serverstat = @{@{$row}[0]}[0];
my $changestat = undef;
if (defined $serverstat && $serverstat == 4) {
$actionflag = 2; # Fetch the msg.
$changestat = 2;
} elsif (defined $serverstat && $serverstat == 3) {
$actionflag = 1; # Delete the msg.
$changestat = 0;
} elsif (defined $serverstat && $serverstat == 5) {
$actionflag = 3; # Fetch & Delete the msg.
$changestat = 0;
} elsif (defined $serverstat && $serverstat == 2) {
# Set status of msg...nothing else.
$changestat = 2;
$changestat = 6 if ($size > ($main::prefs{'MaxFetchSize'} * 1000) && $main::prefs{'MaxFetchSize'} != 0);
} elsif (defined $serverstat && $serverstat == 0) {
# Set status of msg...nothing else.
$changestat = 2;
}
if (defined $changestat) {
if (defined $prefs{'checkDupeOnAll'} && $prefs{'checkDupeOnAll'} eq "y"){
$sql="update messages set serverstat=? where msgid=?";
$query=$conn->prepare($sql);
$query->execute($changestat,$msgid);
} else {
$sql="update messages set serverstat=? where msgid=? and accountid=?";
$query=$conn->prepare($sql);
$query->execute($changestat,$msgid, $accountid);
}
}
}
return $actionflag, $dupes;
}
## $isdupe=&checkForDupeUIDL($dbconnection, $messageid, $accountid);
##
## checks if the message $messageid is already dawnloaded (in $accountid)
## returns undef if it's no dupe
sub checkForDupeUIDL
{
my ($conn, $uidl, $accountid, $size)=@_;
my ($query, $sql, $row, $dupes);
# okay, now lets check if the mail already exists
if (defined $prefs{'checkDupeOnAll'} && $prefs{'checkDupeOnAll'} eq "y"){
$sql="select serverstat from messages where xuidl=?";
$query=$conn->prepare($sql);
$query->execute($uidl);
} else {
$sql="select serverstat from messages where xuidl=? and accountid=?";
$query=$conn->prepare($sql);
$query->execute($uidl, $accountid);
}
$row=$query->fetchall_arrayref;
$dupes=scalar(@{$row});
&wr_debug("-- dupeCheck: $uidl ->".$dupes." dupes found\n");
my $actionflag = undef;
if ($dupes==0){
$dupes=undef;
} else {
my $serverstat = @{@{$row}[0]}[0];
my $changestat = undef;
if (defined $serverstat && $serverstat == 4) {
$actionflag = 2; # Fetch the msg.
$changestat = 2;
} elsif (defined $serverstat && $serverstat == 3) {
$actionflag = 1; # Delete the msg.
$changestat = 0;
} elsif (defined $serverstat && $serverstat == 5) {
$actionflag = 3; # Fetch & Delete the msg.
$changestat = 0;
} elsif (defined $serverstat && $serverstat == 2) {
# Set status of msg...nothing else.
$changestat = 2;
$changestat = 6 if ($size > ($main::prefs{'MaxFetchSize'} * 1000) && $main::prefs{'MaxFetchSize'} != 0);
} elsif (defined $serverstat && $serverstat == 0) {
# Set status of msg...nothing else.
$changestat = 2;
}
if (defined $changestat) {
if (defined $prefs{'checkDupeOnAll'} && $prefs{'checkDupeOnAll'} eq "y"){
$sql="update messages set serverstat=? where xuidl=?";
$query=$conn->prepare($sql);
$query->execute($changestat,$uidl);
} else {
$sql="update messages set serverstat=? where xuidl=? and accountid=?";
$query=$conn->prepare($sql);
$query->execute($changestat,$uidl, $accountid);
}
}
}
return $actionflag, $dupes;
}
## ($headerHash, $mailbody)=&parseHeader($rawmail)
##
## parses a email and return a hash for the header in style of
## $hash->{'subject'}="a subject";
## and the mail body in a string
## it returns undef on error
sub parseHeader
{
my ($rawmail)=@_;
my ($rawheader, @rawheader, $header,$rawbody,$tmp);
# parse out win crlf, you never know :)
$rawmail=~s/\r\n/\n/g;
if ($rawmail=~/(.+?)\n\n(.*)/s){
$rawheader=$1;
$rawbody=$2;
} else {
return undef;
}
# parse out trailing spaces (there shouldn't be ?)
$rawheader=~ s/\n\s+/\n/g;
@rawheader=split(/\n/, $rawheader);
foreach (@rawheader){
if (/(.+?):\s*(.*)/){
$tmp=$1;
$tmp=~tr/A-Z/a-z/;
# fill the hash
$header->{$tmp}=$2;
} else {
&wr_debug("invalid header line $_");
}
}
return ($header, $rawbody);
}
sub save_message
{
my ($conn, $rawbody, $filterref, $account, $sent_items, $serverstat, $size) = @_;
my ($query, $query2, $sql, $boxid, $match, $newsentfrom, $newsentto, $newsubject, $newcc, $newreplyto, $sql2, $tmp, $newid, @rawheader, $rawheader);
my ($msgid, $date, $sentto, $sentfrom, $subject, $contenttype, $contentxferencode, $mimeversion, $precedence, $approvedby, $inreplyto, $replyto, $listsub, $listunsub, $status, $xorigip, $cc, $sender, $returnpath, $priority, $xmailer, $xuidl, $xsender, $sf_friendly, $localdate, $isnew,$receiptto,$score,$ref) = ('', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '', '',0,'');
if (!$serverstat) {
$serverstat = 0;
};
$rawbody =~ s/^content-type:\s*text(\s)/Content-Type: text\/plain$1/im;
$rawbody =~ /(.+?)([\r\n]{4}|\n{2})/s and $rawheader = $1;
#$rawbody =~ /(.+?)\n\n/s and $rawheader = $1;
$rawheader =~ s/\n\s+//g;
@rawheader = split /\n/, $rawheader;
foreach (@rawheader) {
/^Message-Id:\s*(.+)/i and $msgid = $1;
/^From:\s*(.+)/i and $sentfrom = $1;
/^Date:\s*(.+)/i and $date = $1;
/^To:\s*(.+)/i and $sentto = $1;
/^Subject:\s*(.+)/i and $subject = $1;
/^Content-Type:\s*(.+)/i and $contenttype = $1;
/^Content-Transfer-Encoding:\s*(.+)/i and $contentxferencode = $1;
/^Mime-Version:\s*(.+)/i and $mimeversion = $1;
/^Precedence:\s*(.+)/i and $precedence = $1;
/^Approved-By:\s*(.+)/i and $approvedby = $1;
/^In-Reply-To:\s*(.+)/i and $inreplyto = $1;
/^Reply-To:\s*(.+)/i and $replyto = $1;
/^List-Subscribe:\s*(.+)/i and $listsub = $1;
/^List-Unsubscribe:\s*(.+)/i and $listunsub = $1;
/^Status:\s*(.+)/i and $status = $1;
/^X-Originating-IP:\s*[(.+)]/i and $xorigip = $1;
/^Cc:\s*(.+)/i and $cc = $1;
/^Sender:\s*(.+)/i and $sender = $1;
/^Return-Path:\s*<(.+)>/i and $returnpath = $1;
/^X-MSMail-Priority:\s*(.+)/i and $priority = $1;
/^X-Priority:\s*(.+)/i and $priority = $1;
/^X-mailer:\s*(.+)/i and $xmailer = $1;
/^X-UIDL:\s*(.+)/i and $xuidl = &uidlcleanup($1);
/^X-Sender:\s*(.+)/i and $xsender = $1;
/^References:\s*(.+)/i and $ref = $1;
if(/^Disposition-Notification-To:\s*(.+)/i && $receiptto eq "") { $receiptto=$1; }
if(/^Return-Receipt-To:\s*(.+)/i && $receiptto eq "") { $receiptto=$1; }
if(/^Read-Receipt-To:\s*(.+)/i && $receiptto eq "") { $receiptto=$1; }
if(/^X-Confirm-reading-to:\s*(.+)/i && $receiptto eq "") { $receiptto=$1; }
if(/^Return-Receipt-Requested:\s*(.+)/i && $receiptto eq "") { $receiptto=$1; }
if(/^Register-Mail-Reply-Requested-By:\s*(.+)/i && $receiptto eq "") { $receiptto=$1; }
}
# test if message has already been downloaded
# some POP servers set the Status: field in the header
# i test for R or O (R message is read or downloaded./O message is old
# but not deleted.
# the mighty dupecheck follows...
if (defined $account->{'dupecheck'} && $account->{'dupecheck'} eq 'y'){
# we want dupecheck...
unless (defined $account->{'dupeworked'} && $account->{'dupeworked'} eq 'y'){
# if we already dupe-checked, don't do it again
if (defined $size) {
if (defined &checkForDupe($conn, $msgid, $account->{'id'}, $size)){
# the message is a dupe... return successfully, so messages will get deleted...
return "success";
}
} else {
if (defined &checkForDupe($conn, $msgid, $account->{'id'})){
# the message is a dupe... return successfully, so messages will get deleted...
return "success";
}
}
}
}
if ($status =~ /R/ || $status =~ /O/) {
if ($prefs{'popalwaysnew'} eq "n") {
$isnew="n";
} else {
$isnew="y";
}
} else {
$isnew="y";
}
if (!$contenttype) { $contenttype = "text/plain"; }
if ($sent_items && $sent_items eq "yes") {
$sentto = MIME::Words::decode_mimewords($sentto);
$sf_friendly = &process_from($sentto);
} else {
if ($sentfrom) {
$sentfrom = MIME::Words::decode_mimewords($sentfrom);
$sf_friendly = &process_from($sentfrom);
}
}
if ($subject) {
$subject = MIME::Words::decode_mimewords($subject);
}
if (!$msgid) { $msgid = scalar(localtime) . " " . $prefs{'User'} }
$localdate = &date_to_localdate($date);
$boxid =1;
#apply filters
($boxid,$isnew,$score,$newsentto,$newsubject,$newsentfrom,$newcc,$newreplyto) =
&Pronto::Data::Message::apply_filters("save",$boxid,$isnew,$filterref,$account,$sentfrom,$sentto,$cc,$subject,$replyto,$rawheader);
if ($newsubject) {$subject = $newsubject;}
if ($newsentfrom) {$sentfrom = $newsentfrom;}
if ($newcc) {$cc = $newcc;}
if ($newreplyto) {$replyto = $newreplyto;}
if ($newsentto) { $sentto=$newsentto;}
# some fields can be huge, e.g. sentto, and dbd:csv will not truncate them
# most real sql databases will truncate quietly to the size of varchar
if ($prefs{'DatabaseDriver'} eq "CSV") {
$sentto = substr($sentto, 0, 255);
$cc = substr($cc, 0, 255);
}
# FIXME MsgInDB should be reset to n when DatabaseDriver is CSV
if ($prefs{'MsgInDB'} eq "n" or $prefs{'DatabaseDriver'} eq "CSV") {
$newid = &newid('messages', $conn);
$sql2 = "insert into messages (id, msgid, boxid, accountid, date, sentto, sentfrom, subject, contenttype, contentxferencode, mimeversion, precedence, approvedby, inreplyto, replyto, listsub, listunsub, status, xorigip, cc, sender, returnpath, priority, xmailer, xuidl, xsender, localdate, newmsg, friendly, rreceiptto, score,ref, serverstat)
values
(?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?,?,?)";
$query2=$conn->prepare($sql2);
$query2->execute($newid, $msgid, $boxid, $account->{'id'}, $date, $sentto, $sentfrom, $subject, $contenttype, $contentxferencode, $mimeversion, $precedence, $approvedby, $inreplyto, $replyto, $listsub, $listunsub, $status, $xorigip, $cc, $sender, $returnpath, $priority, $xmailer, $xuidl, $xsender, $localdate, $isnew, $sf_friendly, $receiptto, $score,$ref,$serverstat) or return undef;
$tmp = filename_to_tree("$prefs{'MailDir'}/$newid", 1);
wr_debug("Message file to be opened is: $tmp");
open (TMP,">$tmp") or return undef;
print TMP $rawbody or return undef;
close(TMP) or return undef;
return "success";
} elsif ($prefs{'MsgInDB'} eq "y" && $prefs{'DatabaseDriver'} ne "CSV") {
$newid = &newid('messages', $conn);
$sql2 = "insert into messages (id, msgid, boxid, accountid, date, sentto, sentfrom, subject, contenttype, contentxferencode, mimeversion, precedence, approvedby, inreplyto, replyto, listsub, listunsub, status, xorigip, cc, sender, returnpath, priority, xmailer, xuidl, xsender, localdate, newmsg, friendly, rreceiptto, score,ref,serverstat)
values
(?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?,?,?)";
$query2=$conn->prepare($sql2);
$query2->execute($newid, $msgid, $boxid, $account->{'id'}, $date, $sentto, $sentfrom, $subject, $contenttype, $contentxferencode, $mimeversion, $precedence, $approvedby, $inreplyto, $replyto, $listsub, $listunsub, $status, $xorigip, $cc, $sender, $returnpath, $priority, $xmailer, $xuidl, $xsender, $localdate, $isnew, $sf_friendly, $receiptto, $score,$ref,$serverstat) or return undef;
$sql2 = "insert into message_sources (id,bodytext) values (?,?)";
$query2=$conn->prepare($sql2);
$query2->execute($newid, $rawbody) or return undef;
return "success";
}
}
sub read_from_mbox
{
my ($conn, $filterref, $statusbox, $account, $size, $marknew, $importbox, $sent_items)=@_;
my $count = 0;
if (defined $size) { system("prontolock lock $account->{'srvr'}"); }
open(MBOX, "$account->{'srvr'}");
$/ = "\nFrom ";
my ($rawbody);
my $delete_mbox_when_done = 1;
while ($rawbody = <MBOX>) { # the msg can be huge, work with it in-place in a single var
$count+=length($rawbody);
if (defined $statusbox) {
$statusbox->{'progressbar'}->set_value($count/1024);
$statusbox->{'mailprogressbar'}->hide;
while (events_pending Gtk) { main_iteration Gtk; }
}
if (defined $importbox) {
$importbox->{'progressbar'}->set_value($count/1024);
while (events_pending Gtk) { main_iteration Gtk; }
}
$rawbody =~ s/\nFrom $//s; # cut last line
$rawbody =~ s/^.*\n//m; # cut first line
if (defined $marknew && $marknew eq "n") {
my ($header)=&parseHeader($rawbody);
# okay, we don't want to get the messages marked as new
if (defined $header->{'status'}){
# we already have a Status field, lets modify it
$rawbody=~s/\nStatus: (.+)\n/\nStatus: RO\n/;
} else {
$rawbody=~s/\n\n/\nStatus: RO\n\n/;
}
}
my $error;
if (not defined $statusbox and not defined $importbox) { #so that big message be marked right for pop
if ($account->{'dm'} eq "y") {
$error=&save_message($conn,$rawbody,$filterref,$account,undef,0,$size);
} else {
$error=&save_message($conn,$rawbody,$filterref,$account,undef,2,$size);
}
}
elsif ($sent_items and $sent_items eq "yes") {
$error=&save_message($conn, $rawbody, $filterref, $account, $sent_items);
} else {
$error=&save_message($conn, $rawbody, $filterref, $account);
}
if (!defined $error){ $delete_mbox_when_done = 0; };
}
$/ = "\n";
close(MBOX);
if (defined $importbox) {
if(open(TMP,"<$prefs{'MailDir'}/pronto.running")) {
my $proc = <TMP>;
close(TMP);
if(kill(0,$proc)) {
kill('USR2',$proc);
}
}
}
if (($delete_mbox_when_done) and ($account->{'dm'} eq "y")) { open(MBOX, ">$account->{'srvr'}"); truncate(MBOX, 0); };
if (defined $size) { system("prontolock unlock $account->{'srvr'}"); }
if(defined $importbox) { $importbox->destroy; }
}
my ($status_dialog);
sub import_from_mbox
{
my ($widget, $fswin, $list, $conn, $dir, $dirfile, $cscget,$getid, $del)=@_;
my ($sql, $query, $account, @row, %filter);
if (defined $fswin) {
$account->{'srvr'} = $fswin->get_filename();
$fswin->destroy;
} else {
$account->{'srvr'} = "$dir/$dirfile";
}
if (not defined $cscget) {
&init_import_sd;
my ($x,$y,$w,$h);
$status_dialog->{'statuslabel'}->set_text("Importing to Pronto format ...");
my ($percent);
$percent = 0;
$status_dialog->{'progressbar'}->set_value($percent);
while (events_pending Gtk) { main_iteration Gtk; }
my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size)=stat $account->{'srvr'};
$size=$size/1024;
$status_dialog->{'progressbar'}->configure(0,0,$size);
$status_dialog->{'progressbar'}->set_format_string("%v of %u kbytes");
while (events_pending Gtk) { main_iteration Gtk; }
}
%filter = &Pronto::Data::Message::make_filter_hash();
$sql = "select id, friendly, reply from accounts where def = ?";
$query=$conn->prepare($sql);
$query->execute("y");
($account->{'id'}, $account->{'friendly'}, $account->{'reply'}) = $query->fetchrow_array();
($account->{'dm'} = "n");
($account->{'dupecheck'}='y');
unless (defined $account->{'id'} && $account->{'id'}){$account->{'id'}=1;}
if (not defined $cscget) {
my $size;
&read_from_mbox($conn, \%filter, undef, $account,undef,$prefs{'import'}, $status_dialog, $size);
$status_dialog->destroy;
} else {
$account->{'id'} = $getid;
$account->{'dm'} = $del;
&read_from_mbox($conn, \%filter, undef, $account, undef, undef, undef, undef);
}
return 1;
}
sub import_folder
{
my ($widget, $fswin, $list, $conn, $filename, $curfolder)=@_;
my ($sql, $query, $account, @row, %filter);
$account->{'srvr'} = $fswin->get_filename();
$fswin->destroy;
&init_import_sd;
my ($x,$y,$w,$h);
$status_dialog->{'statuslabel'}->set_text(_("Importing to ") . "$curfolder ...");
my ($percent);
$percent = 0;
$status_dialog->{'progressbar'}->set_value($percent);
while (events_pending Gtk) { main_iteration Gtk; }
my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size)=stat $account->{'srvr'};
$size=$size/1024;
$status_dialog->{'progressbar'}->configure(0,0,$size);
$status_dialog->{'progressbar'}->set_format_string("%v of %u kbytes");
while (events_pending Gtk) { main_iteration Gtk; }
$sql = "select id from boxlist where name = '$curfolder'";
$query = $conn->prepare($sql);
$query->execute();
my ($boxid) = $query->fetchrow_array();
#special case for filtering in chosen box.
$filter{'move'}={
'type'=>2,
'boxid'=>$boxid,
'regex'=>'.',
'addr'=>''};
$sql = "select id, friendly, reply from accounts where def = ?";
$query=$conn->prepare($sql);
$query->execute("y");
($account->{'id'}, $account->{'friendly'}, $account->{'reply'}) = $query->fetchrow_array();
($account->{'dm'} = "n");
($account->{'dupecheck'}='y');
unless (defined $account->{'id'} && $account->{'id'}){$account->{'id'}=1;}
if ($boxid == 3) {
my $sent_items = "yes";
&read_from_mbox($conn, \%filter, undef, $account,undef, $prefs{'import'}, $status_dialog, $sent_items);
} else {
&read_from_mbox($conn, \%filter, undef, $account,undef, $prefs{'import'}, $status_dialog);
}
$status_dialog->destroy;
return 1;
}
sub write_to_mbox
{
my ($widget, $fswin, $list, $conn)=@_;
my ($filename, $rawbody, $msgid, $tmp, $count, $i);
my $date = scalar(localtime);
$filename = $fswin->get_filename();
$fswin->destroy;
&init_import_sd;
my ($x,$y,$w,$h);
$status_dialog->{'statuslabel'}->set_text(_("Exporting to MBOX ..."));
my ($percent);
$percent = 0;
$status_dialog->{'progressbar'}->set_value($percent);
while (events_pending Gtk) { main_iteration Gtk; }
my $sql = "select id from messages";
my $query = $conn->prepare($sql);
$query->execute();
$count = $query->rows();
for ($i = 1; $i <= $count; $i++) {
open(MBOX, ">$filename");
while (($msgid) = $query->fetchrow_array()) {
$status_dialog->{'progressbar'}->configure($i++,0,$count);
$status_dialog->{'progressbar'}->set_format_string("%v of %u messages");
while (events_pending Gtk) { main_iteration Gtk; }
$rawbody = &Pronto::Data::Message::get_source($msgid);
print MBOX "From $prefs{'User'} ". $date . "\n";
print MBOX $rawbody;
print MBOX "\n";
}
close(MBOX);
}
$status_dialog->destroy;
}
sub export_folder
{
my ($widget, $fswin, $list, $conn, $curfolder, $foldername)=@_;
my ($filename, $rawbody, $msgid, $tmp, $count, $i);
$filename = $fswin->get_filename();
$fswin->destroy;
&init_import_sd;
my $date = scalar(localtime);
my ($x,$y,$w,$h);
$status_dialog->{'statuslabel'}->set_text(_("Exporting folder ") . "$foldername ...");
my ($percent);
$percent = 0;
$status_dialog->{'progressbar'}->set_value($percent);
while (events_pending Gtk) { main_iteration Gtk; }
if ($curfolder >= 1000) { #messages in vfolder or search
&Pronto::MessageList::rw_select_all();
my @ids=&Pronto::MessageList::get_selected_msgids();
if (!@ids) { return 1 }
&Pronto::MessageList::clear_selection();
$count = scalar(@ids);
open(MBOX, ">$filename/$foldername");
$i = 1;
foreach my $msgid (@ids) {
$status_dialog->{'progressbar'}->configure($i++,0,$count);
$status_dialog->{'progressbar'}->set_format_string("%v of %u messages");
while (events_pending Gtk) { main_iteration Gtk; }
$rawbody = &Pronto::Data::Message::get_source($msgid);
print MBOX "From $prefs{'User'} ". $date . "\n";
print MBOX $rawbody;
print MBOX "\n";
}
close(MBOX);
$status_dialog->destroy;
return 1;
}
my $sql = "select id from messages where boxid = '$curfolder'";
my $query = $conn->prepare($sql);
$query->execute();
$count = $query->rows();
for ($i = 1; $i <= $count; $i++) {
open(MBOX, ">$filename/$foldername");
while (($msgid) = $query->fetchrow_array()) {
$status_dialog->{'progressbar'}->configure($i++,0,$count);
$status_dialog->{'progressbar'}->set_format_string("%v of %u messages");
while (events_pending Gtk) { main_iteration Gtk; }
$rawbody = &Pronto::Data::Message::get_source($msgid);
print MBOX "From $prefs{'User'} ". $date . "\n";
print MBOX $rawbody;
print MBOX "\n";
}
close(MBOX);
}
$status_dialog->destroy;
}
sub text2html
{
my ($message, $arrayref) = @_;
my ($header, $tail, @imageurls, $image, $url);
$image = "";
if (defined $arrayref) {
@imageurls = @{$arrayref};
foreach (@imageurls) {
$url = "$prefs{'MailDir'}/tmp/$_";
$image = $image . "<p>$_<br><img src=\"$url\"></p>";
}
}
if($prefs{'UseMessageColors'} eq 'y') {
$header = "<html>\n<body>\n<body bgcolor=$prefs{'MessageBgColor'}>\n<font color=#$prefs{'MessageColor'}>\n";
$tail = "</font></body>\n</html>\n";
}
else {
$header = "<html>\n<body>\n";
$tail = "</body>\n</html>\n";
}
$message =~ s/</</g;
$message =~ s/>/>/g;
$message =~ s/\t/ /g;
# $message =~ s/ / /g;
$message =~ s/\bhttp:\/\/([-_=&#,;:%a-zA-Z0-9.~\/\?\$\+\@]+)/<a href=http:\/\/$1>http:\/\/$1<\/a>/g;
$message =~ s/\bhttps:\/\/([-_=&#,;:%a-zA-Z0-9.~\/\?\$\+\@]+)/<a href=https:\/\/$1>https:\/\/$1<\/a>/g;
$message =~ s/\bftp:\/\/([-_=&#;:%a-zA-Z0-9.~\/\?\$\+]+)/<a href=ftp:\/\/$1>ftp:\/\/$1<\/a>/g;
$message =~ s/\bmailto:([-_a-zA-Z0-9.]+\@[-_a-zA-Z0-9.]+\.[-_a-zA-Z0-9]+)/<a href=mailto:$1>$1<\/a>/g;
$message =~ s/([\s|;])([-_a-zA-Z0-9.]+\@[-_a-zA-Z0-9.]+\.[-_a-zA-Z0-9]+)/$1<a href=mailto:$2>$2<\/a>/g;
$message =~ s/\.<\/a>/<\/a>\./g;
$message =~ s/>>/>/g;
$message =~ s/><\/a>/<\/a>>/g;
$message =~ s/\"/"/g;
if($prefs{'UseMessageColors'} eq 'y' && length($message) < $prefs{'UseMessageColorsMaxLength'}) {
my(@lines,@symbols,$numSymbols,$symbol,$line,@color,$temp,$continue,$sum,$i,$j);
# $message =~ s/\n/<\/font> <br>\n<font color=#$prefs{'MessageColor'}>/g;
$message =~ s/\n/<\/font> <br>\n<font color=#$prefs{'MessageColor'}>/g;
@symbols = split(/,/,$prefs{'QuoteSymbols'});
$numSymbols = scalar(@symbols);
for($i=1;$i<$numSymbols;$i++) {
for($j=$i;$j>0 && length($symbols[$j]) > length($symbols[$j-1]);$j--) {
$temp = $symbols[$j];
$symbols[$j] = $symbols[$j-1];
$symbols[$j-1] = $temp;
}
}
@lines = split(/\n/,$message);
$color[0] = $prefs{'QuoteColor1'};
$color[1] = $prefs{'QuoteColor2'};
$color[2] = $prefs{'QuoteColor3'};
$message = "";
foreach $line (@lines) {
$sum = 0;
$continue = 1;
$temp = $line;
while($continue) {
$continue = 0;
foreach $symbol (@symbols) {
$symbol =~ s/>/>/g;
$symbol =~ s/</</g;
# $symbol =~ s/ / /g;
if($temp =~ /<font color=#$prefs{'MessageColor'}>$symbol/) {
$temp =~ s/<font color=#$prefs{'MessageColor'}>$symbol/<font color=#$prefs{'MessageColor'}>/g;
$sum++;
$continue = 1;
last;
}
}
}
if($sum!=0) {
$line =~ s/<font color=#$prefs{'MessageColor'}>/<font color=#$color[$sum%3]>/g;
}
$message = "$message$line\n";
}
}
else {
#$message =~ s/\n/ <br>\n/g;
$message =~ s/\n/<br>\n/g;
}
$message = $header . $message . $image . $tail;
return $message;
}
sub text2gtktext
{
my ($message, $font, $widget) = @_;
if (length($message) > $prefs{'UseMessageColorsMaxLength'}) {
$widget->insert($font,"","",$message);
return 1;
}
my(@lines,@symbols,$numSymbols,$symbol,$line,@color,$temp,$continue,$sum,$i,$j,$actcolor,$msgcolor);
@symbols = split(/,/,$prefs{'QuoteSymbols'});
$numSymbols = scalar(@symbols);
for($i=1;$i<$numSymbols;$i++) {
for($j=$i;$j>0 && length($symbols[$j]) > length($symbols[$j-1]);$j--) {
$temp = $symbols[$j];
$symbols[$j] = $symbols[$j-1];
$symbols[$j-1] = $temp;
}
}
@lines = split(/\n/,$message);
#insert (text, font, fg, bg, string)
$msgcolor= Gtk::Gdk::Color->parse_color("#".$prefs{'MessageColor'});
$color[0] = Gtk::Gdk::Color->parse_color("#".$prefs{'QuoteColor1'});
$color[1] = Gtk::Gdk::Color->parse_color("#".$prefs{'QuoteColor2'});
$color[2] = Gtk::Gdk::Color->parse_color("#".$prefs{'QuoteColor3'});
$message = "";
foreach $line (@lines) {
$actcolor=$msgcolor;
$sum = 0;
$continue = 1;
$temp = $line;
while($continue) {
$continue = 0;
foreach $symbol (@symbols) {
if($temp =~ /^(\s*)$symbol/) {
$temp =~ s/$symbol//;
$sum++;
$continue = 1;
last;
}
}
}
if($sum!=0) {
$actcolor=$color[$sum%3];
}
$widget->insert($font,$actcolor,"",$line."\n");
}
return 1;
}
sub init_import_sd
{
my ($sd_pbar, $sd_label, $sd_button, $sd_vbox);
$status_dialog = new Gtk::Dialog;
$status_dialog->signal_connect("destroy" => sub { $status_dialog->destroy; });
$status_dialog->signal_connect("delete_event" => sub { $status_dialog->destroy; });
$status_dialog->set_title(_("Transfer in progress ..."));
$status_dialog->position(-mouse);
$status_dialog->border_width(5);
$sd_vbox=new Gtk::VBox(0,5);
$sd_vbox->border_width(5);
$status_dialog->vbox->pack_start($sd_vbox,1,1,0);
$sd_vbox->show;
$status_dialog->{'statuslabel'}=new Gtk::Label( _("Preparing ...") );
$status_dialog->{'statuslabel'}->set_alignment(0.5,0.5);
$sd_vbox->pack_start($status_dialog->{'statuslabel'},0,1,0);
$status_dialog->{'statuslabel'}->show;
$status_dialog->{'progressbar'}=new Gtk::ProgressBar;
$status_dialog->{'progressbar'}->set_usize(200,20);
$status_dialog->{'progressbar'}->set_show_text(1);
$status_dialog->{'progressbar'}->set_text_alignment(0.5,0.5);
$status_dialog->{'progressbar'}->set_format_string("message %v of %u");
$status_dialog->{'progressbar'}->configure(0,0,0);
$sd_vbox->pack_start($status_dialog->{'progressbar'},1,1,0);
$status_dialog->{'progressbar'}->show;
$sd_button=new Gtk::Button "Hide Status";
$sd_button->signal_connect("clicked" => sub { $status_dialog->destroy; });
$sd_button->can_default(1);
$status_dialog->action_area->pack_start($sd_button,1,1,0);
$sd_button->grab_default;
$sd_button->show;
$status_dialog->show;
while (events_pending Gtk) { main_iteration Gtk; }
return 1;
}
sub uidlcleanup
{
my ($uidl) = @_;
$uidl =~ s/([^a-zA-Z0-9_\-.])/uc sprintf("%%%02x",ord($1))/eg;
return $uidl;
}
1;
syntax highlighted by Code2HTML, v. 0.9.1