# $Id: Message.pm,v 1.13 2002/05/19 06:20:47 muhri Exp $
# -*- perl -*-
package Pronto::Data::Message;
use Pronto::Crypt::GPG;
use strict;
use vars qw ( %undo );
%undo = ();
## get the raw source (including headers) of this message
## inputs : msgid
## outputs: message source
sub get_source {
my ($msgid) = @_;
my $msg_src;
if ($main::prefs{"MsgInDB"} ne "y") {
my $filename = &get_filename($msgid);
open (FILE, '<'. $filename) || return undef;
undef $/;
$msg_src = <FILE>;
$/ = "\n";
close (FILE);
}
else {
my $sql = "select bodytext from message_sources where id = $msgid";
my $query = $main::conn->prepare($sql);
$query->execute();
$msg_src = $query->fetchrow_array();
}
return $msg_src;
}
## get the raw source of this message as an IO:Handle (read-only)
## inputs : msgid
## outputs: io handle that reads the message source
sub get_source_io_handle {
my ($msgid) = @_;
my ($io,$filename);
if ($main::prefs{'MsgInDB'} eq "n") {
$filename = &get_filename($msgid);
$io = new IO::File $filename, "r";
} else {
my $source = get_source($msgid);
open(TMP,">$main::prefs{'MailDir'}/tmp/dump");
print TMP $source;
close(TMP);
$filename = "$main::prefs{'MailDir'}/tmp/dump";
$io = new IO::File $filename, "r";
}
return $io;
}
## get the parsed headers for this message
## inputs : msgid
## outputs: hash ref of headers, keys are header names (lowercased), values are header values
sub get_headers {
my ($msgid) = @_;
my $rawheaders = &get_raw_headers($msgid);
# unwrap multiline header fields
$rawheaders =~ s/\n\s+//g;
# make hash using all-lowercase names
my @lines = split (/\n/, $rawheaders);
my $headers = +{};
foreach my $line (@lines) {
if ($line =~ m/(.+?):\s*(.*)/){
my $name = $1;
my $value = $2;
$name =~ tr/A-Z/a-z/;
$headers->{$name} = $value;
}
}
# TODO decode RFC-1522 fields - for all, some, or no fields?
# TODO do something more intelligent with fields that occur more than once, maybe?
return $headers;
}
## get the raw headers for this message
## inputs : msgid
## outputs: raw headers
sub get_raw_headers {
my ($msgid) = @_;
my ($rawheaders);
# read file up to end of headers only
if ($main::prefs{'MsgInDB'} eq "n") {
my $filename = &get_filename($msgid);
open (FILE, '<'.$filename) || return undef;
$/ = "\n\n";
$rawheaders = <FILE>;
$/ = "\n";
close (FILE);
} else {
my $source = &get_source($msgid);
open(TMP,">$main::prefs{'MailDir'}/tmp/dump");
print TMP $source;
close(TMP);
open(TMP,"<$main::prefs{'MailDir'}/tmp/dump");
$/ = "\n\n";
$rawheaders = <TMP>;
$/ = "\n";
close(TMP);
}
return $rawheaders;
}
## delete one or more messages
## inputs : array of msgids
## outputs: none
## (note: this really completely deletes the messages, it doesn't move them to the trash)
sub delete {
my (@msgids) = @_;
my ($sql2);
my $sql = "delete from messages where id = ?";
my $query = $main::conn->prepare($sql);
foreach my $msgid (@msgids) {
$query->execute($msgid);
if ($main::prefs{'MsgInDB'} ne "y") {
unlink( &get_filename($msgid) );
}
else {
$sql2 = "delete from message_sources where id = $msgid";
$main::conn->do($sql2);
}
}
}
## move one or more messages
## inputs : folder id, array of msgids
## outputs: none
sub move {
my ($folder_id, @msgids) = @_;
return if (!$folder_id || $folder_id == 0 || $folder_id >= 1000);
return if (!@msgids);
undef %undo;
my $sql = "update messages set boxid = ? where id = ?";
my $query = $main::conn->prepare($sql);
foreach my $msgid (@msgids) {
if ($main::prefs{'UndoEnabled'}) {
my $undoSQL = "select boxid from messages where id = ?";
my $undoQuery = $main::conn->prepare($undoSQL);
$undoQuery->execute($msgid);
$undo{$msgid} = $undoQuery->fetchrow_array();
}
$query->execute($folder_id, $msgid);
if ($main::prefs{'DeleteMarksAsRead'} eq "y" && $folder_id == 4) {
my $sql2 = "update messages set newmsg = 'n' where id = $msgid";
$main::conn->do($sql2);
}
}
}
sub Undo
{
my $ret = 0;
my %dupe=();
if (!$main::prefs{'UndoEnabled'}) {
&main::err_dialog(_("Undo is not enabled!"));
return $ret;
}
if (!%undo) {
&main::err_dialog(_("No undo stack available!"));
return $ret;
}
foreach(keys(%undo)) {
$dupe{$_} = $undo{$_};
}
foreach(keys(%dupe)) {
&move($dupe{$_},$_);
}
undef %undo;
undef %dupe;
return $ret + 1;
}
## copy one or more messages
## inputs : folder id, array of msgids
## outputs: none
sub copy {
my ($folder_id, @msgids) = @_;
my $sql = "select accountid, date, sentto, sentfrom, subject, contenttype,
contentxferencode, mimeversion, precedence, approvedby,
inreplyto, replyto, listsub, listunsub, status, xorigip, cc,
sender, returnpath, priority, xmailer, xuidl, xsender, msgid, replyf,
friendly, newmsg, localdate, ref,serverstat from messages where id = ?";
my $query = $main::conn->prepare($sql);
my $sql2 = "insert into messages (id, boxid, accountid, date, sentto,
sentfrom, subject, contenttype, contentxferencode, mimeversion,
precedence, approvedby, inreplyto, replyto, listsub, listunsub,
status, xorigip, cc, sender, returnpath, priority, xmailer,
xuidl, xsender, msgid, replyf, friendly, newmsg, localdate, ref,serverstat)
values
(?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?,
?, ?, ?, ?, ?, ?, ?,?)";
my $query2 = $main::conn->prepare($sql2);
foreach my $msgid (@msgids) {
# copy the database entry
$query->execute($msgid);
my @row=$query->fetchrow_array();
my $newid = &main::newid('messages', $main::conn);
$query2->execute($newid, $folder_id, @row);
# copy the file
if ($main::prefs{'MsgInDB'} eq "n") {
my $filename = &get_filename($msgid);
my $new_filename = &get_filename($newid);
File::Copy::copy($filename, $new_filename);
} else {
my $sql3 = "insert into message_sources (id,bodytext) values (?,?)";
my $source = &get_source($msgid);
my $query3 = $main::conn->prepare($sql3);
$query3->execute($newid,$source);
}
}
}
sub apply_filters
{
my ($action,$boxid,$isnew,$filterref,$account,$sentfrom,$sentto,$cc,$subject,$replyto,$rawheader)=@_;
my ($newsentto,$newsubject,$newsentfrom,$newcc,$newreplyto) = (undef,undef,undef,undef,undef);
my ($regex,$sql,$query);
my $match = 0;
my $score = 0;
my %filter = %{$filterref};
foreach my $filterkey (sort numerically (keys(%filter))) {
my $regex = $filter{$filterkey}->{regex};
if ($filter{$filterkey}->{type} == 0) { next; }
if ( (! defined $filter{$filterkey}->{trueregex} || $filter{$filterkey}->{trueregex} != 1) &&
$filter{$filterkey}->{type} != 1 )
{
my $wildcardtoken = '981754871289340233412354';
$regex =~ s!(.?)\*! ($1 eq '\\' ? '*' : $wildcardtoken ) !ge;
$regex = quotemeta($regex);
$regex =~ s!$wildcardtoken!(.*)!g;
}
eval { "" =~ /$regex/ };
if ($@) {
print STDERR "Error in filter regular expression: ", $regex, "\n"; next;
};
if ($filter{$filterkey}->{type} == 1 && $regex == $account->{'id'}) {
$match = 1;
} elsif ($filter{$filterkey}->{type} == 2 && ($sentto =~ /$regex/i || $cc =~ /$regex/i)) {
$match = 1;
} elsif ($filter{$filterkey}->{type} == 3 && $subject =~ /$regex/i) {
$match = 1;
} elsif ($filter{$filterkey}->{type} == 4 && $sentfrom =~ /$regex/i) {
$match = 1;
} elsif (($filter{$filterkey}->{type} == 5 || $filter{$filterkey}->{type} == 6) && defined $rawheader && $rawheader =~ /$regex/im) {
$match = 1;
}
if ($match == 1) {
if ($filter{$filterkey}->{type} != 6) {
$boxid = $filter{$filterkey}->{boxid};
}
# TODO consider stopping processing of filters with the first one that matches - otherwise later filters override earlier ones
if ($filter{$filterkey}->{type} != 6 && $boxid == 2) {
$newsentto = $filter{$filterkey}->{addr};
$newsubject = "Fw: " . $subject;
$newsentfrom = "$account->{'friendly'} <$account->{'reply'}>";
$newcc = "";
$newreplyto = $account->{'reply'};
} elsif ($filter{$filterkey}->{type} != 6 && $boxid == 4 && $main::prefs{'DeleteMarksAsRead'} eq "y") {
$isnew = "n";
} elsif ($filter{$filterkey}->{type} == 6) {
$score+=$filter{$filterkey}->{boxid};
} else {
$newsentto = $sentto;
$newsubject = $subject;
$newsentfrom = $sentfrom;
$newcc = $cc;
$newreplyto = $replyto;
}
if ($filter{$filterkey}->{count} >= 0) {
$filter{$filterkey}->{count}++;
$sql = "update filters set count = ? where id = ?";
$query = $main::conn->prepare($sql);
$query->execute($filter{$filterkey}->{count},$filter{$filterkey}->{id});
}
}
$match = 0;
}
return $boxid,$isnew,$score,$newsentto,$newsubject,$newsentfrom,$newcc,$newreplyto;
}
sub make_filter_hash
{
my ($sql,$query,%filter,@row);
$sql = "select sorder, type, boxid, regex, addr, trueregex, count, id from filters order by sorder";
$query=$main::conn->prepare($sql);
$query->execute();
while (@row = $query->fetchrow_array()) {
$filter{$row[0]} = {
'id' => $row[7],
'type' => $row[1],
'boxid' => $row[2],
'regex' => $row[3],
'addr' => $row[4],
'trueregex' => $row[5],
'count' => $row[6]
}
}
return %filter;
}
# get a parsed mime entity for this message
# inputs : msgid
# outputs: a mime entity
sub get_parsed_mime {
my ($msgid) = @_;
my $mime_entity;
if ($main::prefs{'MsgInDB'} ne "y") {
my $filename = &get_filename($msgid);
open (FILE,"<$filename");
$mime_entity = $main::parser->read(\*FILE);
close(FILE);
} else {
my $msg_src = &Pronto::Data::Message::get_source($msgid);
open(TMP,">$main::prefs{'MailDir'}/tmp/dump");
print TMP $msg_src;
close(TMP);
open(TMP,"<$main::prefs{'MailDir'}/tmp/dump");
$mime_entity = $main::parser->read(\*TMP);
close(TMP);
}
return $mime_entity;
}
### private ###
sub get_filename {
my ($msgid) = @_;
my @digits = split(//, $msgid);
if ($#digits == 0) {
$digits[1] = $digits[0];
$digits[0] = 0;
$msgid = "0$digits[1]";
}
my $mail_dir = $main::prefs{'MailDir'};
my $first_dir = $digits[$#digits];
my $second_dir = $digits[($#digits-1)];
mkdir("$mail_dir/$first_dir", 0700);
mkdir("$mail_dir/$first_dir/$second_dir", 0700);
return "$mail_dir/$first_dir/$second_dir/$msgid.msg";
}
### end proposed interface ###
use File::Copy qw( mv cp );
use Text::Wrap;
my $gpg_object = new Pronto::Crypt::GPG(); ## Create an object
sub forget_passphrase
{
$gpg_object->{'passphrase'} = undef;
}
sub verify
{
if (-f $main::prefs{'gpgpath'}) {
$gpg_object->set_path($main::prefs{'gpgpath'});
return $gpg_object->verify($_[0]);
}
}
sub decrypt
{
if (-f $main::prefs{'gpgpath'}) {
$gpg_object->set_path($main::prefs{'gpgpath'});
return $gpg_object->decrypt($_[0]);
}
}
sub refilter
{
my ($type) = @_; # folder refilter or message refilter?
my ($changed,%filter,@ids,$curbox,$sql,$query,$boxid,$score,$account);
$changed = 0;
%filter = make_filter_hash();
$curbox = &Pronto::FolderTree::get_folder_id();
if (!$curbox) { return 1 }
if ($type && $type eq "folder") {
&Pronto::MessageList::rw_select_all();
}
@ids = &Pronto::MessageList::get_selected_msgids();
if (!@ids) { return 1 }
$sql = "select id,friendly,reply from accounts where def = 'y'";
$query = $main::conn->prepare($sql);
$query->execute();
($account->{'id'},$account->{'friendly'},$account->{'reply'}) = $query->fetchrow_array();
foreach my $id (@ids) {
$sql = "select sentto,subject,sentfrom,cc,newmsg,replyto,score from messages where id = $id";
$query = $main::conn->prepare($sql);
$query->execute;
while (my ($sentto,$subject,$sentfrom,$cc,$isnew,$replyto,$score) = $query->fetchrow_array()) {
if (!$sentto) { $sentto = '' }
if (!$subject) { $subject = '' }
if (!$cc) { $cc = '' }
if (!$isnew) { $isnew = "n" }
if (!$replyto) { $replyto = '' }
if (!$sentfrom) { $sentfrom = '' }
($boxid,$isnew,$score) = &apply_filters("refilter",$curbox,$isnew,\%filter,$account,$sentfrom,$sentto,$cc,$subject,$replyto);
if ($boxid != $curbox) {
$changed = 1;
my $sql2 = "update messages set boxid = $boxid, score = $score, newmsg = '$isnew' where id = $id";
$main::conn->do($sql2);
}
}
}
if ($changed == 1) {
&Pronto::FolderTree::refresh_folder_tree();
if ($main::prefs{'messageview'} eq "clist") {
&Pronto::MessageList::refresh_messages();
} else {
&Pronto::MessageList::refresh_ctree("switch");
}
}
if ($type && $type eq "folder") {
&Pronto::MessageList::clear_selection();
}
return 1;
}
# TODO break up into a sub that creates a mime-compliant message body, a part of data::message::save to store it in the database and/or on disk, and a handle_send sub that does the ui stuff
sub send_message {
my ($widget, $msg_window, $in_refto,$forrep, $pbody, $pfrom, $pto, $psubject, $pacctid, $pattachments) = @_;
my ($from, $to, $cc, , $bcc, $subj, $body, $sender) = ("","","","","","","","");
my (@entry, $sql, $query, @row, $acctid, @attachments, $arrtmp, $tmp, $mimemail, $mimetype, $mimeencode, $defaultmime, $defaultenc, $ownkey, @keys);
$defaultmime="application/x-unknown";
$defaultenc="base64";
if (defined $msg_window){
$from = $msg_window->{'fromCombo'}->entry->get_text;
$sql = "select id, friendly, reply from accounts where descr=?";
$query=$main::conn->prepare($sql);
$query->execute($from);
if (@row=$query->fetchrow_array()) {
$acctid = $row[0];
$from = "\"$row[1]\" <$row[2]>";
} else {
&main::err_dialog(_("You must choose an account to send from!"));
return 1;
}
$to = $msg_window->{'ToEntry'}->get_text;
$cc = $msg_window->{'CcEntry'}->get_text;
$subj = $msg_window->{'SubjEntry'}->get_text;
$bcc = $msg_window->{'BccEntry'}->get_text;
if (!$to && !$bcc) {
&main::err_dialog(_("You must specify at least one recipient!"));
return 1;
}
if (!$subj) { $subj = " "; } # allow blank subjects
$body = $msg_window->{'mailText'}->get_chars(0,-1);
if (!$body) {
&main::err_dialog(_("Message has no body!"));
return 1;
}
} else {
$sql = "select friendly, reply from accounts where id=?";
$query=$main::conn->prepare($sql);
$query->execute($pacctid);
if (@row=$query->fetchrow_array()) {
$from = "\"$row[0]\" <$row[1]>";
} else {
$from=$pfrom;
}
$acctid=$pacctid;
$to=$pto;
$subj=$psubject;
$body=$pbody;
}
$Text::Wrap::columns = $main::prefs{'WrapAfter'};
$body =~ s!(^[^>|+#}=):\%\@\$\?\r\n].*$)! &Text::Wrap::wrap("","",$1) !gem;
if (((defined $msg_window && $msg_window->{'Encrypt'} == 1) || ($main::prefs{'Sign'})) && (-f $main::prefs{'gpgpath'})) {
$gpg_object->set_path($main::prefs{'gpgpath'});
my $sth1 = $main::conn->prepare("select public_key from addresses where address=?");
$body = "\n".$body; ## For some reason the first line is lost
if (defined $msg_window && $msg_window->{'Encrypt'}) {
my @email_addresses;
push(@email_addresses, $gpg_object->get_addresses_from_string($to));
push(@email_addresses, $gpg_object->get_addresses_from_string($cc));
if ($main::prefs{'EncToSelf'}) {
push(@email_addresses, $gpg_object->get_addresses_from_string($from));
}
foreach my $check_email (@email_addresses) {
$sth1->execute($check_email);
my @raw_return = $sth1->fetchrow_array;
my $key = $raw_return[0];
if (not defined $key) {
&main::err_dialog(_("No key specified in addressbook for\n$check_email.\nOpen Addressbook and specify the key there."),"y");
return 1;
} else {
push(@keys, $key);
}
}
}
if ($main::prefs{'Sign'}) {
$sth1->execute($gpg_object->get_addresses_from_string($from));
$ownkey = $sth1->fetchrow_array;
if (not defined $ownkey) {
&main::err_dialog(_("I dont have a key specified for myself - No signing available"),"y");
return 1;
}
}
my $encryptFlag=0;
if (defined $msg_window && $msg_window->{'Encrypt'} == 1) {
$encryptFlag = 1;
}
my ($stdout, $sterr) = $gpg_object->encrypt(\@keys, [$body],$encryptFlag, $main::prefs{'Sign'}, $ownkey);
if (!$stdout) {
&main::err_dialog(_("Encryption did not complete with the following errors: .")."\n @$sterr","y");
return 1;
}
if (grep(/BAD_PASSPHRASE/, @$sterr)) {
&main::err_dialog(_("Appearntly you entered a bad passphrase for your key $ownkey\n@$sterr\nEnter it again then retry sending"),"y");
$gpg_object->{'passphrase'} = undef;
$gpg_object->obtain_passphrase();
return 1;1
}
$body = join('', @$stdout);
if (!$body) {
&main::err_dialog(_("Something went wrong during encrypt/sign!\n@$sterr"),"y");
return 1;
}
} elsif (((defined $msg_window && $msg_window->{'Encrypt'}) || ($main::prefs{'Sign'})) && !-f $main::prefs{'gpgpath'}) {
&main::err_dialog(_("You have selected to either encrypt or sign the message, however the gpg path is not set correctly. Please correct it from Pronto's options"), "y");
return 1;
}
my $date = &main::date_now;
my $localdate = &main::date_to_localdate($date);
my $msgid = scalar(localtime) . "\@$from";
# build the time..
# Assemble the mail body and the headers....
# encode attachments as necessary
$mimemail=build MIME::Entity( From=>$from,
To=>$to,
CC=>$cc,
Subject=>$subj,
'X-Mailer'=>"Pronto ".$main::version. " On ". $^O."/".$main::prefs{'DatabaseDriver'},
Type=>"text/plain",
Charset=>$main::prefs{'CharSet'},
Encoding=>'-SUGGEST',
# Date=>&main::UnixDate(&main::ParseDateString("epoch ".time()),"%d %b %Y %H:%M:%S %Z"),
#Remco Lubbers <rpl@wanadoo.nl> said the above line is not RFC822 cmpliant
Date=>&main::UnixDate(&main::ParseDateString("epoch ".time()),"%a, %e %b %Y %H:%M:%S %z"),
Data=>$body);
$mimemail->head->add('Reply-To',$from) if ($main::prefs{'IncludeReplyTo'});
# check if a reciept is requested
if ((defined $msg_window) && ($msg_window->{'receiptCheck'}->active)){
my $frommail=$from;
$frommail=~s/(.+) \<(.+)\>/\<$2\>/;
$mimemail->head->add('Disposition-Notification-To',$frommail);
$mimemail->head->add('Return-Receipt-To',$frommail);
}
if (defined $in_refto) {
if (defined $forrep and $forrep == 1 or $forrep == 5) {
#set the right in-ref-to;
my $sql2 = "select msgid,ref from messages where id = '$in_refto'";
my $query2 = $main::conn->prepare($sql2);
$query2->execute;
my ($replyid,$ref) = $query2->fetchrow_array();
$mimemail->head->add('In-Reply-To',$replyid);
if (!$ref) {
$mimemail->head->add('References',$replyid);
} else {
$mimemail->head->add('References',$ref . " " . $replyid);
}
}
}
# check if priority is not normal, then set the header field
my @priolist=("1 (Highest)","2 (High)","3 (Normal)","4 (Low)","5 (Lowest)");
my $priority = $priolist[3];
if ((defined $msg_window) && (!$msg_window->{'priorityRadio'}[2]->active)){
my $tmp;
for ($tmp=0;$tmp<scalar(@priolist);$tmp++){
last if ($msg_window->{'priorityRadio'}[$tmp]->active);
}
$mimemail->head->add('X-Priority',$priolist[$tmp]);
$priority = $priolist[$tmp];
}
# method to get the names of attachments
@attachments=();
if (defined $msg_window){
if ($msg_window->{'attachClist'}->rows>0){
for (my $tmp=0;$tmp<$msg_window->{'attachClist'}->rows;$tmp++){
push @attachments, $msg_window->{'attachClist'}->get_text($tmp, 0);
}
}
} else {
@attachments=@{$pattachments};
}
if (@attachments && scalar(@attachments)>0){
for ($tmp=0;$tmp<scalar(@attachments);$tmp++){
($mimetype,$mimeencode)=MIME::Types::by_suffix($attachments[$tmp]);
if (!defined $mimetype || $mimetype eq ""){
$mimetype=$defaultmime;
$mimeencode=$defaultenc;
}
$mimemail->attach( Path=>$attachments[$tmp],
Type=>$mimetype,
Encoding=>$mimeencode);
}
}
#$mimemail->sign;
$body=$mimemail->as_string;
# new body= the assembled mimemail
my $folder;
if (defined $msg_window && defined $msg_window->{'folder'}) {
$folder = $msg_window->{'folder'};
} else {
$folder = 2;
}
if ($main::prefs{'MsgInDB'} ne "y") {
$sql = "insert into messages (id, accountid, sentfrom, sentto, subject, cc, bcc,
localdate, boxid, contenttype, date, msgid, friendly, priority) values
(?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?)";
$query=$main::conn->prepare($sql);
my $newid = &main::newid('messages', $main::conn);
$query->execute($newid, $acctid, $from, $to, $subj, $cc, $bcc, $localdate, $folder, $mimemail->mime_type(), $date,
$msgid, &main::process_from($to),$priority);
$tmp = &main::filename_to_tree("$main::prefs{'MailDir'}/$newid");
open(TMP,">$tmp");
print TMP $body;
close(TMP);
} else {
$sql = "insert into messages (id, accountid, sentfrom, sentto, subject, cc, bcc,
localdate, boxid, contenttype, date, msgid, friendly, priority) values
(?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?)";
$query=$main::conn->prepare($sql);
my $newid = &main::newid('messages', $main::conn);
$query->execute($newid, $acctid, $from, $to, $subj, $cc, $bcc, $localdate, $folder, $mimemail->mime_type(), $date,
$msgid, &main::process_from($to),$priority);
$sql = "insert into message_sources (id, bodytext) values (?,?)";
$query = $main::conn->prepare($sql);
$query->execute($newid,$body);
}
#if reply no quote - set the reply pixmap too
if (defined $forrep and $forrep == 5) { $forrep = 1 }
#pixmap reply or forward set.
if (defined $in_refto && $forrep != 0) {
$sql = "update messages set replyf = ? where id = ?";
$query=$main::conn->prepare($sql);
$query->execute($forrep, $in_refto);
if ($main::prefs{'AddReplytoAB'} eq "y") {
$sql = "select sentfrom from messages where id = ?";
$query=$main::conn->prepare($sql);
$query->execute($in_refto);
my ($addfrom) = ($query->fetchrow_array());
&add2ab($addfrom);
}
}
if (defined $forrep && $forrep == 0) {
$sql = "select boxid from messages where id = ?";
$query=$main::conn->prepare($sql);
$query->execute($in_refto);
my ($cur_folder) = ($query->fetchrow_array());
if (defined $cur_folder && ($cur_folder == 5 || $cur_folder == 2)) {
$sql = "delete from messages where id = ?";
$query=$main::conn->prepare($sql);
$query->execute($in_refto);
my $nuke_me = &main::filename_to_tree("$main::prefs{'MailDir'}/$in_refto");
unlink($nuke_me);
if (defined $main::entity{$in_refto}) {
&main::destroy_entity(undef, $in_refto);
}
#refresh if we are running onetime.
if (defined $main::ONETIME && $main::ONETIME == 0) {
&Pronto::MessageList::refresh_messages;}
}
}
#refresh the folders if we aren't runing for one time
if (defined $main::ONETIME && $main::ONETIME == 0) {
&Pronto::FolderTree::refresh_folder_tree;
}
#send those messages cause we are dying
if (defined $main::ONETIME and $main::ONETIME == 1 and $main::prefs{'SendImmediately'} eq "y") { &main::send_out }
if (defined $msg_window){
$msg_window->destroy;
}
if ($main::prefs{'SendImmediately'} eq "y") { &main::send_out; }
return 1;
}
sub numerically { $a <=> $b; }
sub receipt_dialog {
my ($msgid, $subject, $receiptto) = @_;
my ($dlg, $lbl, $ok, $later, $never);
$dlg = new Gtk::Dialog;
$dlg->set_modal(1);
$dlg->position(-mouse);
$dlg->signal_connect("destroy", sub {$dlg->destroy;});
$dlg->signal_connect("delete_event" => \&Gtk::false);
$dlg->set_title("Receipt request");
$dlg->vbox->border_width(5);
$dlg->set_default_size(170, 140);
$lbl = new Gtk::Label "$receiptto requested a receipt for the mail \"$subject\".\n\nDo you want me to send one?";
$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 _("Yes");
$ok->signal_connect("clicked", \&receipt_now, $dlg, $msgid);
$ok->set_usize(55,25);
$ok->show;
$dlg->action_area->pack_start($ok,0,0,0);
$later = new Gtk::Button _("Later");
$later->signal_connect("clicked", \&receipt_later, $dlg);
$later->set_usize(55,25);
$later->show;
$dlg->action_area->pack_start($later,0,0,0);
$never = new Gtk::Button _("Never");
$never->signal_connect("clicked", \&receipt_never, $dlg, $msgid);
$never->set_usize(55,25);
$never->show;
$dlg->action_area->pack_start($never,0,0,0);
$dlg->show;
return 1;
}
sub receipt_never {
my ($widget,$dlg,$msgid)=@_;
my $sql;
if (defined $dlg){
$dlg->destroy;
}
$sql = "update messages set rreceiptto='never' where id = $msgid";
$main::conn->do($sql);
}
sub receipt_later {
my ($widget,$dlg)=@_;
if (defined $dlg){
$dlg->destroy;
}
}
sub receipt_now {
my ($widget,$dlg,$msgid)=@_;
my ($nuke,$file,$sql,$query);
my (@attachment);
if (defined $dlg){
$dlg->destroy;
}
$sql = "select subject, sentfrom, sentto, date, accountid from messages where id=$msgid";
$query=$main::conn->prepare($sql);
$query->execute();
my ($subject, $from, $to, $date, $acctid)=$query->fetchrow_array();
# read the message for inclusion in the reply
if ($main::prefs{'MsgInDB'} eq "n") {
$file = &main::filename_to_tree("$main::prefs{'MailDir'}/$msgid");
} else {
my $source = get_source($msgid);
$file = "$main::prefs{'MailDir'}/tmp/receipt".$msgid;
open(TMP,">$file");
print TMP $source;
close(TMP);
}
push @attachment, $file;
my $tmpmail=<<"ENDOFMSG"
The message sent on $date to $to with subject "$subject" has been displayed.
This is no guarantee that the message has been read or understood.
The original message has been attached.
ENDOFMSG
;
&send_message(undef, undef, undef, undef, $tmpmail, $to, $from, "auto-generated receipt", $acctid, \@attachment);
$sql = "update messages set rreceiptto='sent' where id = $msgid";
$main::conn->do($sql);
}
sub mark_as_read {
my ($flag) = @_;
my (@selection, $msgid, $sql, $query);
@selection = $main::message_clist->selection;
if (!@selection) {
&main::err_dialog(_("Select the message You want to Mark as Read!"));
return 1;
}
foreach (@selection) {
if ($main::prefs{'messageview'} eq "clist") {
$msgid = ${$main::message_clist->get_row_data($_)};
} elsif ($main::prefs{'messageview'} eq "ctree") {
$msgid = ${$main::message_clist->node_get_row_data($_)};
}
if (defined $flag and $flag eq "read") {
$sql = "update messages set newmsg = 'n' where id = $msgid";
} elsif (defined $flag and $flag eq "unread") {
$sql = "update messages set newmsg = 'y' where id = $msgid";
}
$query=$main::conn->prepare($sql);
$query->execute();
}
&Pronto::MessageList::refresh_messages;
&Pronto::FolderTree::refresh_folder_tree();
return 1;
}
sub clist2ab {
my ($widget, $clist) = @_;
my (@selection, $sql, $query, $from);
@selection = $clist->selection;
if (!@selection) {
&main::err_dialog(_("You must select a message first!"));
return 1;
}
$sql = "select sentfrom from messages where id = ?";
$query=$main::conn->prepare($sql);
foreach (@selection) {
if ($main::prefs{'messageview'} eq "clist") {
$query->execute(${$clist->get_row_data($_)});
} elsif ($main::prefs{'messageview'} eq "ctree") {
$query->execute(${$clist->node_get_row_data($_)});
}
($from) = ($query->fetchrow_array());
&add2ab($from);
}
return 1;
}
sub add2ab {
my ($from) = @_;
if (not defined $from) {
&main::err_dialog(_("Could not extract sender address!"));
return 1;
}
my ($sql, $query, @row, $alias, $address, @tmp);
if ($from =~ /^\"?(.+?)\"? ?<(.+)>/) { $alias = $1; $address = $2; }
if ($from =~ /^\"?(.+?)\"? ?\(\"?(.+?)\"?\)/) { $alias = $2; $address=$1; }
if (!$alias) {
$alias = $from;
$address = $from;
}
$sql = "select address from addresses where address like '$address'";
$query = $main::conn->prepare($sql);
$query->execute();
if (@tmp = $query->fetchrow_array()) {
return 1;
}
$sql = "insert into addresses (id, alias, address, public_key)
values (?,?,?,?)";
$query= $main::conn->prepare($sql);
$query->execute(&main::newid('addresses', $main::conn), $alias, $address, " ");
return 1;
}
sub scoring {
my ($widget, $clist, $flag) = @_;
my ($score, $sql, $query, $row, @selection);
if ($main::prefs{'messageview'} eq "clist") {
if (@selection = $clist->selection()) {
$row = $selection[0];
} else {
return 1;
}
$score = $clist->get_text($row, 3);
if ($flag eq "up") { $score++; } else { $score--; }
$sql = "update messages set score = ? where id = ?";
$query=$main::conn->prepare($sql);
$query->execute($score, ${$clist->get_row_data($row)});
if ($score == 0) { $score = " "; }
$clist->set_text($row, 3, $score);
} elsif ($main::prefs{'messageview'} eq "ctree") {
@selection = $main::message_clist->selection;
if (!@selection) { return 1 }
my $id = ${$main::message_clist->node_get_row_data($selection[0])};
$score = $main::message_clist->node_get_text($selection[0],3);
if ($flag eq "up") { $score++; } else { $score--; }
$sql = "update messages set score = ? where id = ?";
$query=$main::conn->prepare($sql);
$query->execute($score,$id);
if ($score == 0) { $score = " "; }
$main::message_clist->node_set_text($selection[0],3,$score);
}
return 1;
}
## Sets the flag of a message regarding its server status
## inputs : msgid setstatus
## outputs: none
## setstatus 0 = Msg not on server
## setstatus 1 = Msg on server and has not been fetched
## setstatus 2 = Msg on server and has been fetched
## setstatus 3 = Msg on server and is flagged to be removed in next send & recieve
## setstatus 4 = Msg on server is flagged to be fetched in next send & recieve
## setstatus 5 = Msg on server is flagged to be fetched and deleted in next send & recieve
## setstatus 6 = Msg on server and has been fetched (same as status 2 but msg
## was originally left to be fetched)
sub set_server_status {
my ($msgid, $setstatus) = @_;
my $sql="update messages set serverstat=? where id=? and serverstat != 0";
my $query=$main::conn->prepare($sql);
$query->execute($setstatus,$msgid);
return 1;
}
## updates the raw source (including headers) of this message
## Used for completing partial downloads...
## inputs : msgid newbody
## outputs:
sub update_message_source {
my ($msgid, $newbody_file) = @_;
if (defined $msgid && defined $newbody_file) {
if ($main::prefs{"MsgInDB"} ne "y") {
my $filename = &get_filename($msgid);
open(NEWBODY, "<$newbody_file");
open (FILE, '>'. $filename) || return undef;
while(<NEWBODY>) {
print FILE $_;
}
close (FILE);
close (NEWBODY);
}
else {
open(NEWBODY, "<$newbody_file");
undef $/;
my $new_msg_src = <NEWBODY>;
$/ = "\n";
close (NEWBODY);
my $sql = "update message_sources set bodytext = ? where id = ?";
my $query = $main::conn->prepare($sql);
$query->execute($new_msg_src, $msgid);
}
}
else {
&main::wr_debug("Pronto::Message::update_message_source was called badly : Not all the necesary parameters were given");
}
}
1;
syntax highlighted by Code2HTML, v. 0.9.1