LIBSOURCES = \
PMG/pmgcfg.pm \
+ PMG/Utils.pm \
+ PMG/SMTPPrinter.pm \
PMG/NoVncIndex.pm \
PMG/Cluster.pm \
PMG/HTTPServer.pm \
PMG/RuleDB/TimeFrame.pm \
PMG/RuleDB/MatchField.pm \
PMG/RuleDB/ContentTypeFilter.pm \
+ PMG/RuleDB/Spam.pm \
PMG/RuleDB/Virus.pm \
+ PMG/RuleDB/Remove.pm \
+ PMG/RuleDB/Notify.pm \
+ PMG/RuleDB/Disclaimer.pm \
+ PMG/RuleDB/Accept.pm \
+ PMG/RuleDB/Block.pm \
PMG/RuleDB.pm \
PMG/CLI/pmgdb.pm \
${CLI_CLASSES} \
CREATE INDEX UserPrefs_MTime_Index ON UserPrefs (MTime);
__EOD
-
+
sub cond_create_dbtable {
my ($dbh, $name, $ctablecmd) = @_;
"WHERE tablename = lower ('$name')";
my $sth = $dbh->prepare ($cmd);
-
+
$sth->execute();
if (!(my $ref = $sth->fetchrow_hashref())) {
$dbh->do ($ctablecmd);
}
-
+
$sth->finish();
$dbh->commit;
$dbh->do ($dbfunction_merge_greylist);
- # make sure we do not use slow sequential scans when upgraing
+ # make sure we do not use slow sequential scans when upgraing
# database (before analyze can gather statistics)
$dbh->do("set enable_seqscan = false");
cond_create_dbtable ($dbh, 'CMailStore', $cmailstore_ctablecmd);
cond_create_dbtable ($dbh, 'UserPrefs', $userprefs_ctablecmd);
cond_create_dbtable ($dbh, 'CGreylist', $cgreylist_ctablecmd);
- cond_create_dbtable ($dbh, 'CStatistic', $cstatistic_ctablecmd);
+ cond_create_dbtable ($dbh, 'CStatistic', $cstatistic_ctablecmd);
cond_create_dbtable ($dbh, 'ClusterInfo', $clusterinfo_ctablecmd);
cond_create_dbtable ($dbh, 'VirusInfo', $virusinfo_stat_ctablecmd);
eval {
$dbh->do ("UPDATE Object " .
"SET value = 'content-type:application/java-vm' ".
- "WHERE objecttype = 3003 " .
+ "WHERE objecttype = 3003 " .
"AND value = 'content-type:application/x-java-vm';");
};
my $obj = PMG::RuleDB::EMail->new ('nomail@fromthisdomain.com');
my $blacklist = $ruledb->create_group_with_obj(
$obj, 'Blacklist', 'Global blacklist');
-
+
# Whitelist
$obj = PMG::RuleDB::EMail->new('mail@fromthisdomain.com');
my $whitelist = $ruledb->create_group_with_obj(
$obj = PMG::RuleDB::ContentTypeFilter->new('application/vnd\.ms-excel');
my $office_content = $ruledb->create_group_with_obj(
$obj, 'Office Files', 'Common Office Files');
-
+
$obj = PMG::RuleDB::ContentTypeFilter->new(
'application/vnd\.ms-powerpoint');
-
+
$ruledb->group_add_object($office_content, $obj);
-
+
$obj = PMG::RuleDB::ContentTypeFilter->new('application/msword');
$ruledb->group_add_object ($office_content, $obj);
-
+
$obj = PMG::RuleDB::ContentTypeFilter->new(
'application/vnd\.openxmlformats-officedocument\..*');
$ruledb->group_add_object($office_content, $obj);
-
+
$obj = PMG::RuleDB::ContentTypeFilter->new(
'application/vnd\.oasis\.opendocument\..*');
$ruledb->group_add_object($office_content, $obj);
$obj = PMG::RuleDB::ContentTypeFilter->new(
'application/vnd\.stardivision\..*');
$ruledb->group_add_object($office_content, $obj);
-
+
$obj = PMG::RuleDB::ContentTypeFilter->new(
'application/vnd\.sun\.xml\..*');
$ruledb->group_add_object($office_content, $obj);
-
+
# Dangerous Content
$obj = PMG::RuleDB::ContentTypeFilter->new(
'application/x-ms-dos-executable');
my $exe_content = $ruledb->create_group_with_obj(
$obj, 'Dangerous Content', 'executable files and partial messages');
-
+
$obj = PMG::RuleDB::ContentTypeFilter->new('application/x-java');
$ruledb->group_add_object($exe_content, $obj);
$obj = PMG::RuleDB::ContentTypeFilter->new('application/javascript');
$ruledb->group_add_object($exe_content, $obj);
# Virus
- $obj = Proxmox::RuleDB::Virus->new ();
- my $virus = $ruledb->create_group_with_obj ($obj, 'Virus',
- 'Matches virus infected mail');
+ $obj = PMG::RuleDB::Virus->new();
+ my $virus = $ruledb->create_group_with_obj(
+ $obj, 'Virus', 'Matches virus infected mail');
+
# WHAT Objects
# Spam
- $obj = Proxmox::RuleDB::Spam->new (3);
- my $spam3 = $ruledb->create_group_with_obj ($obj, 'Spam (Level 3)',
- 'Matches possible spam mail');
- $obj = Proxmox::RuleDB::Spam->new (5);
- my $spam5 = $ruledb->create_group_with_obj ($obj, 'Spam (Level 5)',
- 'Matches possible spam mail');
- $obj = Proxmox::RuleDB::Spam->new (10);
- my $spam10 = $ruledb->create_group_with_obj ($obj, 'Spam (Level 10)',
- 'Matches possible spam mail');
+ $obj = PMG::RuleDB::Spam->new(3);
+ my $spam3 = $ruledb->create_group_with_obj(
+ $obj, 'Spam (Level 3)', 'Matches possible spam mail');
-
-# $obj = Proxmox::RuleDB::MatchField->new ('content-type', 'application/pdf');
-# $ct_filter = $ruledb->create_group_with_obj ($obj, 'Content Type Filter',
-# 'Content Type Filter');
-
+ $obj = PMG::RuleDB::Spam->new(5);
+ my $spam5 = $ruledb->create_group_with_obj(
+ $obj, 'Spam (Level 5)', 'Matches possible spam mail');
+
+ $obj = PMG::RuleDB::Spam->new(10);
+ my $spam10 = $ruledb->create_group_with_obj(
+ $obj, 'Spam (Level 10)', 'Matches possible spam mail');
# ACTIONS
- # Mark Spam
- $obj = Proxmox::RuleDB::ModField->new ('X-SPAM-LEVEL', '__SPAM_INFO__');
- my $mod_spam_level = $ruledb->create_group_with_obj ($obj, 'Modify Spam Level',
- 'Mark mail as spam by adding a header tag.');
+ # Mark Spam
+ $obj = PMG::RuleDB::ModField->new('X-SPAM-LEVEL', '__SPAM_INFO__');
+ my $mod_spam_level = $ruledb->create_group_with_obj(
+ $obj, 'Modify Spam Level',
+ 'Mark mail as spam by adding a header tag.');
# Mark Spam
- $obj = Proxmox::RuleDB::ModField->new ('subject', 'SPAM: __SUBJECT__');
- my $mod_spam_subject = $ruledb->create_group_with_obj ($obj, 'Modify Spam Subject',
- 'Mark mail as spam by modifying the subject.');
+ $obj = PMG::RuleDB::ModField->new('subject', 'SPAM: __SUBJECT__');
+ my $mod_spam_subject = $ruledb->create_group_with_obj(
+ $obj, 'Modify Spam Subject',
+ 'Mark mail as spam by modifying the subject.');
+
# Remove matching attachments
- $obj = Proxmox::RuleDB::Remove->new (0);
- my $remove = $ruledb->create_group_with_obj ($obj, 'Remove attachments',
- 'Remove matching attachments');
+ $obj = PMG::RuleDB::Remove->new(0);
+ my $remove = $ruledb->create_group_with_obj(
+ $obj, 'Remove attachments', 'Remove matching attachments');
+
# Remove all attachments
- $obj = Proxmox::RuleDB::Remove->new (1);
- my $remove_all = $ruledb->create_group_with_obj ($obj,
- 'Remove all attachments',
- 'Remove all attachments');
+ $obj = PMG::RuleDB::Remove->new(1);
+ my $remove_all = $ruledb->create_group_with_obj(
+ $obj, 'Remove all attachments', 'Remove all attachments');
# Accept
- $obj = Proxmox::RuleDB::Accept->new ();
- my $accept = $ruledb->create_group_with_obj ($obj, 'Accept', 'Accept mail for Delivery');
+ $obj = PMG::RuleDB::Accept->new();
+ my $accept = $ruledb->create_group_with_obj(
+ $obj, 'Accept', 'Accept mail for Delivery');
# Block
- $obj = Proxmox::RuleDB::Block->new ();
- my $block = $ruledb->create_group_with_obj ($obj, 'Block', 'Block mail');
+ $obj = PMG::RuleDB::Block->new ();
+ my $block = $ruledb->create_group_with_obj($obj, 'Block', 'Block mail');
# Quarantine
- $obj = Proxmox::RuleDB::Quarantine->new ();
- my $quarantine = $ruledb->create_group_with_obj ($obj, 'Quarantine', 'Move mail to quarantine');
-
- # Spam Counter
- #$obj = Proxmox::RuleDB::Counter->new (0);
- #my $count_spam = $ruledb->create_group_with_obj ($obj, 'Count Spam',
- # 'Count spam mails');
- # Virus Counter
- #$obj = Proxmox::RuleDB::Counter->new (0);
- #my $count_virus = $ruledb->create_group_with_obj ($obj, 'Count Viruses',
- # 'Count virus mails');
- # BCC dietmar
- #$obj = Proxmox::RuleDB::BCC->new ('dietmar@maurer-it.com');
- #$bcc = $ruledb->create_group_with_obj ($obj, 'BCC dietmar', 'send bcc');
-
- # Store in quarantine
- #$obj = Proxmox::RuleDB::Store->new ('quarantine', 'O');
- #$storeq = $ruledb->create_group_with_obj ($obj, 'Quarantine', ' Store in quarantine');
+ $obj = PMG::RuleDB::Quarantine->new();
+ my $quarantine = $ruledb->create_group_with_obj(
+ $obj, 'Quarantine', 'Move mail to quarantine');
# Notify Admin
- $obj = Proxmox::RuleDB::Notify->new ('__ADMIN__');
- my $notify_admin = $ruledb->create_group_with_obj ($obj, 'Notify Admin',
- 'Send notification');
+ $obj = PMG::RuleDB::Notify->new('__ADMIN__');
+ my $notify_admin = $ruledb->create_group_with_obj(
+ $obj, 'Notify Admin', 'Send notification');
# Notify Sender
- $obj = Proxmox::RuleDB::Notify->new ('__SENDER__');
- my $notify_sender = $ruledb->create_group_with_obj ($obj, 'Notify Sender',
- 'Send notification');
+ $obj = PMG::RuleDB::Notify->new('__SENDER__');
+ my $notify_sender = $ruledb->create_group_with_obj(
+ $obj, 'Notify Sender', 'Send notification');
# Add Disclaimer
- $obj = Proxmox::RuleDB::Disclaimer->new ();
- my $add_discl = $ruledb->create_group_with_obj ($obj, 'Disclaimer',
- 'Add Disclaimer');
+ $obj = PMG::RuleDB::Disclaimer->new ();
+ my $add_discl = $ruledb->create_group_with_obj(
+ $obj, 'Disclaimer', 'Add Disclaimer');
# Attach original mail
#$obj = Proxmox::RuleDB::Attach->new ();
- #my $attach_orig = $ruledb->create_group_with_obj ($obj, 'Attach Original Mail',
+ #my $attach_orig = $ruledb->create_group_with_obj ($obj, 'Attach Original Mail',
# 'Attach Original Mail');
####################### RULES ##################################
$ruledb->rule_add_what_group ($rule, $virus);
$ruledb->rule_add_action ($rule, $notify_admin);
-
+
if ($testmode) {
$ruledb->rule_add_action ($rule, $block);
} else {
$ruledb->rule_add_action ($rule, $notify_sender);
$ruledb->rule_add_action ($rule, $notify_admin);
$ruledb->rule_add_action ($rule, $block);
-
+
## Blacklist
$rule = PMG::RuleDB::Rule->new ('Blacklist', 98, 1, 0);
$ruledb->save_rule ($rule);
--- /dev/null
+package PMG::RuleDB::Accept;
+
+use strict;
+use warnings;
+use Carp;
+use DBI;
+
+use PVE::SafeSyslog;
+use Digest::SHA;
+
+use PMG::Utils;
+use PMG::ModGroup;
+use PMG::RuleDB::Object;
+
+use base qw(PMG::RuleDB::Object);
+
+sub otype {
+ return 4000;
+}
+
+sub oclass {
+ return 'action';
+}
+
+sub otype_text {
+ return 'Accept';
+}
+
+sub oicon {
+ return 'accept.gif';
+}
+
+sub oinfo {
+ return 'Accept mail for delivery.';
+}
+
+sub oisedit {
+ return 0;
+}
+
+sub final {
+ return 1;
+}
+
+sub priority {
+ return 99;
+}
+
+sub new {
+ my ($type, $ogroup) = @_;
+
+ my $class = ref($type) || $type;
+
+ my $self = $class->SUPER::new(otype(), $ogroup);
+
+ return $self;
+}
+
+sub load_attr {
+ my ($type, $ruledb, $id, $ogroup, $value) = @_;
+
+ my $class = ref($type) || $type;
+
+ my $obj = $class->new($ogroup);
+ $obj->{id} = $id;
+
+ $obj->{digest} = Digest::SHA::sha1_hex($id, $ogroup);
+
+ return $obj;
+}
+
+sub save {
+ my ($self, $ruledb) = @_;
+
+ defined($self->{ogroup}) || return undef;
+
+ if (defined($self->{id})) {
+ # update
+
+ # nothing to update
+
+ } else {
+ # insert
+
+ my $sth = $ruledb->{dbh}->prepare(
+ "INSERT INTO Object (Objectgroup_ID, ObjectType) VALUES (?, ?);");
+
+ $sth->execute($self->ogroup, $self->otype);
+
+ $self->{id} = PMG::Utils::lastid($ruledb->{dbh}, 'object_id_seq');
+ }
+
+ return $self->{id};
+}
+
+sub execute {
+ my ($self, $queue, $ruledb, $mod_group, $targets,
+ $msginfo, $vars, $marks) = @_;
+
+ my $subgroups = $mod_group->subgroups($targets, 1);
+
+ foreach my $ta (@$subgroups) {
+ my ($tg, $entity) = (@$ta[0], @$ta[1]);
+
+ PMG::Utils::remove_marks($entity);
+
+ if ($msginfo->{testmode}) {
+ my $fh = $msginfo->{test_fh};
+ print $fh "accept from: $msginfo->{sender}\n";
+ printf $fh "accept to: %s\n", join (',', @$tg);
+ print $fh "accept content:\n";
+
+ $entity->print($fh);
+ print $fh "accept end\n";
+ $queue->set_status($tg, 'delivered');
+ } else {
+ my ($qid, $code, $mess) = PMG::Utils::reinject_mail(
+ $entity, $msginfo->{sender}, $tg,
+ $msginfo->{xforward}, $msginfo->{fqdn});
+ if ($qid) {
+ foreach (@$tg) {
+ syslog('info', "%s: accept mail to <%s> (%s)", $queue->{logid}, $_, $qid);
+ }
+ $queue->set_status ($tg, 'delivered', $qid);
+ } else {
+ foreach (@$tg) {
+ syslog('err', "%s: reinject mail to <%s> failed", $queue->{logid}, $_);
+ }
+ if ($code) {
+ my $resp = substr($code, 0, 1);
+ if ($resp eq '4' || $resp eq '5') {
+ $queue->set_status($tg, 'error', $code, $mess);
+ }
+ }
+ }
+ }
+ }
+
+ # warn if no subgroups
+}
+
+sub short_desc {
+ my $self = shift;
+
+ return "";
+}
+
+1;
+__END__
+
+=head1 PMG::RuleDB::Accept
+
+Accept a message.
--- /dev/null
+package PMG::RuleDB::Block;
+
+use strict;
+use warnings;
+use Carp;
+use DBI;
+use Digest::SHA;
+
+use PVE::SafeSyslog;
+
+use PMG::Utils;
+use PMG::ModGroup;
+use PMG::RuleDB::Object;
+
+use base qw(PMG::RuleDB::Object);
+
+sub otype {
+ return 4001;
+}
+
+sub oclass {
+ return 'action';
+}
+
+sub otype_text {
+ return 'Block';
+}
+
+sub oicon {
+ return 'block.gif';
+}
+
+sub oisedit {
+ return 0;
+}
+
+sub final {
+ return 1;
+}
+
+sub priority {
+ return 98;
+}
+
+sub new {
+ my ($type, $ogroup) = @_;
+
+ my $class = ref($type) || $type;
+
+ my $self = $class->SUPER::new (otype(), $ogroup);
+
+ return $self;
+}
+
+sub load_attr {
+ my ($type, $ruledb, $id, $ogroup, $value) = @_;
+
+ my $class = ref($type) || $type;
+
+ my $obj = $class->new ($ogroup);
+ $obj->{id} = $id;
+
+ $obj->{digest} = Digest::SHA::sha1_hex($id, $ogroup);
+
+ return $obj;
+}
+
+sub save {
+ my ($self, $ruledb) = @_;
+
+ defined($self->{ogroup}) || return undef;
+
+ if (defined ($self->{id})) {
+ # update
+
+ # nothing to update
+
+ } else {
+ # insert
+
+ my $sth = $ruledb->{dbh}->prepare(
+ "INSERT INTO Object (Objectgroup_ID, ObjectType) VALUES (?, ?);");
+
+ $sth->execute($self->ogroup, $self->otype);
+
+ $self->{id} = PMG::Utils::lastid($ruledb->{dbh}, 'object_id_seq');
+ }
+
+ return $self->{id};
+}
+
+sub execute {
+ my ($self, $queue, $ruledb, $mod_group, $targets,
+ $msginfo, $vars, $marks) = @_;
+
+ if ($msginfo->{testmode}) {
+ my $fh = $msginfo->{test_fh};
+ print $fh "block from: $msginfo->{sender}\n";
+ printf $fh "block to: %s\n", join (',', @$targets);
+ }
+
+ foreach my $to (@$targets) {
+ syslog('info', "%s: block mail to <%s>", $queue->{logid}, $to);
+ }
+
+ $queue->set_status($targets, 'blocked');
+}
+
+sub short_desc {
+ my $self = shift;
+
+ return "block message";
+}
+
+1;
+
+__END__
+
+=head1 PMG::RuleDB::Block
+
+Block a message.
--- /dev/null
+package PMG::RuleDB::Disclaimer;
+
+use strict;
+use warnings;
+use Carp;
+use DBI;
+use Digest::SHA;
+use HTML::Parser;
+use HTML::Entities;
+use MIME::Body;
+use IO::File;
+use Encode;
+
+use PMG::Utils;
+use PMG::ModGroup;
+use PMG::RuleDB::Object;;
+
+use base qw(PMG::RuleDB::Object);
+
+sub otype {
+ return 4009;
+}
+
+sub oclass {
+ return 'action';
+}
+
+sub otype_text {
+ return 'Disclaimer';
+}
+
+sub oicon {
+ return 'attach.gif';
+}
+
+sub oconfigsite {
+ return '';
+}
+
+sub oinfo {
+ return 'Add a Disclaimer';
+}
+
+sub oisedit {
+ return 1;
+}
+
+sub final {
+ return 0;
+}
+
+sub priority {
+ return 49;
+}
+
+my $std_discl = <<_EOD_;
+This e-mail and any attached files are confidential and may be legally privileged. If you are not the addressee, any disclosure, reproduction, copying, distribution, or other dissemination or use of this communication is strictly prohibited. If you have received this transmission in error please notify the sender immediately and then delete this mail.<br>
+E-mail transmission cannot be guaranteed to be secure or error free as information could be intercepted, corrupted, lost, destroyed, arrive late or incomplete, or contain viruses. The sender therefore does not accept liability for any errors or omissions in the contents of this message which arise as a result of e-mail transmission or changes to transmitted date not specifically approved by the sender.<br>
+If this e-mail or attached files contain information which do not relate to our professional activity we do not accept liability for such information.
+_EOD_
+
+sub new {
+ my ($type, $value, $ogroup) = @_;
+
+ my $class = ref($type) || $type;
+
+ $value //= $std_discl;
+
+ my $self = $class->SUPER::new(otype(), $ogroup);
+
+ $self->{value} = $value;
+
+ return $self;
+}
+
+sub load_attr {
+ my ($type, $ruledb, $id, $ogroup, $value) = @_;
+
+ my $class = ref($type) || $type;
+
+ defined($value) || croak "undefined object attribute: ERROR";
+
+ my $obj = $class->new($value, $ogroup);
+
+ $obj->{id} = $id;
+
+ $obj->{digest} = Digest::SHA::sha1_hex($id, $value, $ogroup);
+
+ return $obj;
+}
+
+sub save {
+ my ($self, $ruledb) = @_;
+
+ defined($self->{ogroup}) || croak "undefined object attribute: ERROR";
+ defined($self->{value}) || croak "undefined object attribute: ERROR";
+
+ if (defined ($self->{id})) {
+ # update
+
+ $ruledb->{dbh}->do(
+ "UPDATE Object SET Value = ? WHERE ID = ?",
+ undef, $self->{value}, $self->{id});
+
+ } else {
+ # insert
+
+ my $sth = $ruledb->{dbh}->prepare(
+ "INSERT INTO Object (Objectgroup_ID, ObjectType, Value) " .
+ "VALUES (?, ?, ?);");
+
+ $sth->execute($self->ogroup, $self->otype, $self->{value});
+
+ $self->{id} = PMG::Utils::lastid($ruledb->{dbh}, 'object_id_seq');
+ }
+
+ return $self->{id};
+}
+
+sub add_data {
+ my ($self, $entity, $data) = @_;
+
+ $entity->bodyhandle || return undef;
+
+ my $fh;
+
+ # always use the decoded data
+ if (my $path = $entity->{PMX_decoded_path}) {
+ $fh = IO::File->new("<$path");
+ } else {
+ $fh = $entity->open("r");
+ }
+
+ return undef if !$fh;
+
+ # in memory (we cant modify the file, because
+ # a.) that would modify all entities (see ModGroup)
+ # b.) bad performance
+ my $body = new MIME::Body::InCore || return undef;
+
+ my $newfh = $body->open ("w") || return undef;
+
+ while (defined($_ = $fh->getline())) {
+ $newfh->print($_); # copy contents
+ }
+
+ $newfh->print("\n"); # add final \n
+
+ $newfh->print($data);
+
+ $newfh->close || return undef;
+
+ $entity->bodyhandle($body);
+
+ return 1;
+}
+
+sub sign {
+ my ($self, $entity, $html, $text) = @_;
+
+ my $found = 0;
+
+ if ($entity->head->mime_type =~ m{multipart/alternative}) {
+ foreach my $p ($entity->parts) {
+ $found = 1 if $self->sign ($p, $html, $text);
+ }
+ } elsif ($entity->head->mime_type =~ m{multipart/}) {
+ foreach my $p ($entity->parts) {
+ if ($self->sign ($p, $html, $text)) {
+ $found = 1;
+ last;
+ }
+ }
+ } elsif ($entity->head->mime_type =~ m{text/}) {
+ if ($entity->head->mime_type =~ m{text/html}) {
+ $self->add_data ($entity, $html);
+ $found = 1;
+ } elsif ($entity->head->mime_type =~ m{text/plain}) {
+ my $cs = $entity->head->mime_attr("content-type.charset");
+ eval {
+ my $enc_text = encode($cs, $text, Encode::FB_CROAK);
+ $self->add_data($entity, $enc_text);
+ };
+ # simply ignore if we can't represent the disclainer
+ # with that encoding
+ $found = 1;
+ } else {
+ # do nothing - unknown format
+ }
+ }
+
+ return $found;
+}
+
+sub execute {
+ my ($self, $queue, $ruledb, $mod_group, $targets,
+ $msginfo, $vars, $marks) = @_;
+
+ my $subgroups = $mod_group->subgroups($targets);
+
+ foreach my $ta (@$subgroups) {
+ my ($tg, $entity) = (@$ta[0], @$ta[1]);
+
+ my $html = "<br>--<br>" . PMG::Utils::subst_values ($self->{value}, $vars);
+
+ my $text = "";
+ my $parser = HTML::Parser->new(
+ api_version => 3, text_h => [ sub {$text .= shift;}, "dtext" ]);
+
+ my $tmp = $html;
+ $tmp =~ s/\r?\n//g;
+ $tmp =~ s/<br>/\n/g;
+
+ $parser->parse($tmp);
+ $parser->eof;
+
+ $self->sign($entity, "$html\n", "$text\n");
+
+ return;
+ }
+}
+
+sub short_desc {
+ my $self = shift;
+
+ return "disclaimer";
+}
+
+
+1;
+
+__END__
+
+=head1 PMG::RuleDB::Disclaimer
+
+Add disclaimer.
use Digest::SHA;
use MIME::Words;
+use PMG::Utils;
use PMG::RuleDB::Object;
use base qw(PMG::RuleDB::Object);
$sth->execute($self->ogroup, $self->otype, $new_value);
- $self->{id} = PMG::RuleDB::lastid($ruledb->{dbh}, 'object_id_seq');
+ $self->{id} = PMG::Utils::lastid($ruledb->{dbh}, 'object_id_seq');
}
return $self->{id};
--- /dev/null
+package PMG::RuleDB::ModField;
+
+use strict;
+use warnings;
+use Carp;
+use DBI;
+use Digest::SHA;
+
+use PMG::Utils;
+use PMG::ModGroup;
+use PMG::RuleDB::Object;
+
+use base qw(PMG::RuleDB::Object);
+
+sub otype {
+ return 4003;
+}
+
+sub oclass {
+ return 'action';
+}
+
+sub otype_text {
+ return 'Header Attribute';
+}
+
+sub oicon {
+ return 'modfield.gif';
+}
+
+sub final {
+ return 0;
+}
+
+sub priority {
+ return 10;
+}
+
+sub new {
+ my ($type, $field, $field_value, $ogroup) = @_;
+
+ my $class = ref($type) || $type;
+
+ my $self = $class->SUPER::new(otype(), $ogroup);
+
+ $self->{field} = $field;
+ $self->{field_value} = $field_value;
+
+ return $self;
+}
+
+sub load_attr {
+ my ($type, $ruledb, $id, $ogroup, $value) = @_;
+
+ my $class = ref($type) || $type;
+
+ defined($value) || return undef;
+
+ my ($field, $field_value) = $value =~ m/^([^\:]*)\:(.*)$/;
+
+ (defined($field) && defined($field_value)) || return undef;
+
+ my $obj = $class->new($field, $field_value, $ogroup);
+ $obj->{id} = $id;
+
+ $obj->{digest} = Digest::SHA::sha1_hex($id, $field, $field_value, $ogroup);
+
+ return $obj;
+}
+
+sub save {
+ my ($self, $ruledb) = @_;
+
+ defined($self->{ogroup}) || return undef;
+
+ my $new_value = "$self->{field}:$self->{field_value}";
+
+ if (defined ($self->{id})) {
+ # update
+
+ $ruledb->{dbh}->do(
+ "UPDATE Object SET Value = ? WHERE ID = ?",
+ undef, $new_value, $self->{id});
+
+ } else {
+ # insert
+
+ my $sth = $ruledb->{dbh}->prepare(
+ "INSERT INTO Object (Objectgroup_ID, ObjectType, Value) " .
+ "VALUES (?, ?, ?);");
+
+ $sth->execute($self->ogroup, $self->otype, $new_value);
+
+ $self->{id} = PMG::Utils::lastid($ruledb->{dbh}, 'object_id_seq');
+ }
+
+ return $self->{id};
+}
+
+sub execute {
+ my ($self, $queue, $ruledb, $mod_group, $targets,
+ $msginfo, $vars, $marks) = @_;
+
+ my $fvalue = PMG::Utils::subst_values ($self->{field_value}, $vars);
+
+ # support for multiline values (i.e. __SPAM_INFO__)
+ $fvalue =~ s/\r?\n/\n\t/sg; # indent content
+ $fvalue =~ s/\n\s*\n//sg; # remove empty line
+ $fvalue =~ s/\n?\s*$//s; # remove trailing spaces
+
+ my $subgroups = $mod_group->subgroups($targets);
+
+ foreach my $ta (@$subgroups) {
+ my ($tg, $e) = (@$ta[0], @$ta[1]);
+ $e->head->replace($self->{field}, $fvalue);
+ }
+}
+
+sub short_desc {
+ my $self = shift;
+
+ return "modify field: $self->{field}:$self->{field_value}";
+}
+
+1;
+
+__END__
+
+=head1 PMG::RuleDB::ModField
+
+Modify fields of a message.
--- /dev/null
+package PMG::RuleDB::Notify;
+
+use strict;
+use warnings;
+use Carp;
+use DBI;
+use MIME::Body;
+use MIME::Head;
+use MIME::Entity;
+
+use PVE::SafeSyslog;
+
+use PMG::Utils;
+use PMG::ModGroup;
+use PMG::RuleDB::Object;
+
+use base qw(PMG::RuleDB::Object);
+
+sub otype {
+ return 4002;
+}
+
+sub oclass {
+ return 'action';
+}
+
+sub otype_text {
+ return 'Notification';
+}
+
+sub oicon {
+ return 'notify.gif';
+}
+
+sub oinfo {
+ return 'Send a notification Mail';
+}
+
+sub final {
+ return 0;
+}
+
+sub priority {
+ return 89;
+}
+
+sub new {
+ my ($type, $to, $subject, $body, $attach, $ogroup) = @_;
+
+ my $class = ref($type) || $type;
+
+ my $self = $class->SUPER::new(otype(), $ogroup);
+
+ $to //= '__ADMIN__';
+ $attach //= 'N';
+ $subject //= 'Notification: __SUBJECT__';
+
+ if (!defined($body)) {
+ $body = <<EOB;
+Proxmox Notification:
+
+Sender: __SENDER__
+Receiver: __RECEIVERS__
+Targets: __TARGETS__
+
+Subject: __SUBJECT__
+
+Matching Rule: __RULE__
+
+__RULE_INFO__
+
+__VIRUS_INFO__
+__SPAM_INFO__
+EOB
+ }
+ $self->{to} = $to;
+ $self->{subject} = $subject;
+ $self->{body} = $body;
+ $self->{attach} = $attach;
+
+ return $self;
+}
+
+sub load_attr {
+ my ($type, $ruledb, $id, $ogroup, $value) = @_;
+
+ my $class = ref($type) || $type;
+
+ defined($value) || croak "undefined object attribute: ERROR";
+
+ my ($subject, $body, $attach);
+
+ my $sth = $ruledb->{dbh}->prepare(
+ "SELECT * FROM Attribut WHERE Object_ID = ?");
+
+ $sth->execute($id);
+
+ while (my $ref = $sth->fetchrow_hashref()) {
+ $subject = $ref->{value} if $ref->{name} eq 'subject';
+ $body = $ref->{value} if $ref->{name} eq 'body';
+ $attach = $ref->{value} if $ref->{name} eq 'attach';
+ }
+
+ $sth->finish();
+
+ my $obj = $class->new($value, $subject, $body, $attach, $ogroup);
+ $obj->{id} = $id;
+
+ $obj->{digest} = Digest::SHA::sha1_hex(
+ $id, $value, $subject, $body, $attach, $ogroup);
+
+ return $obj;
+}
+
+sub save {
+ my ($self, $ruledb, $no_trans) = @_;
+
+ defined($self->{ogroup}) || croak "undefined object attribute: ERROR";
+ defined($self->{to}) || croak "undefined object attribute: ERROR";
+ defined($self->{subject}) || croak "undefined object attribute: ERROR";
+ defined($self->{body}) || croak "undefined object attribute: ERROR";
+
+ if (defined ($self->{id})) {
+ # update
+
+ eval {
+ $ruledb->{dbh}->begin_work if !$no_trans;
+
+ $ruledb->{dbh}->do(
+ "UPDATE Object SET Value = ? WHERE ID = ?",
+ undef, $self->{to}, $self->{id});
+
+ $ruledb->{dbh}->do(
+ "UPDATE Attribut SET Value = ? " .
+ "WHERE Name = ? and Object_ID = ?",
+ undef, $self->{subject}, 'subject', $self->{id});
+
+ $ruledb->{dbh}->do(
+ "UPDATE Attribut SET Value = ? " .
+ "WHERE Name = ? and Object_ID = ?",
+ undef, $self->{body}, 'body', $self->{id});
+
+ $ruledb->{dbh}->do(
+ "UPDATE Attribut SET Value = ? " .
+ "WHERE Name = ? and Object_ID = ?",
+ undef, $self->{attach}, 'attach', $self->{id});
+
+ $ruledb->{dbh}->commit if !$no_trans;
+ };
+ if (my $err = $@) {
+ die $err if !$no_trans;
+ $ruledb->{dbh}->rollback;
+ syslog('err', $err);
+ return undef;
+ }
+
+ } else {
+ # insert
+
+ $ruledb->{dbh}->begin_work if !$no_trans;
+
+ eval {
+
+ my $sth = $ruledb->{dbh}->prepare(
+ "INSERT INTO Object (Objectgroup_ID, ObjectType, Value) " .
+ "VALUES (?, ?, ?);");
+
+ $sth->execute($self->ogroup, $self->otype, $self->{to});
+
+ $self->{id} = PMG::Utils::lastid($ruledb->{dbh}, 'object_id_seq');
+
+ $sth->finish();
+
+ $ruledb->{dbh}->do("INSERT INTO Attribut " .
+ "(Object_ID, Name, Value) " .
+ "VALUES (?, ?, ?)", undef,
+ $self->{id}, 'subject', $self->{subject});
+ $ruledb->{dbh}->do("INSERT INTO Attribut " .
+ "(Object_ID, Name, Value) " .
+ "VALUES (?, ?, ?)", undef,
+ $self->{id}, 'body', $self->{body});
+ $ruledb->{dbh}->do("INSERT INTO Attribut " .
+ "(Object_ID, Name, Value) " .
+ "VALUES (?, ?, ?)", undef,
+ $self->{id}, 'attach', $self->{attach});
+
+ $ruledb->{dbh}->commit if !$no_trans;
+ };
+ if (my $err = $@) {
+ die $err if !$no_trans;
+ $ruledb->{dbh}->rollback;
+ syslog('err', $err);
+ return undef;
+ }
+ }
+
+ return $self->{id};
+}
+
+sub execute {
+ my ($self, $queue, $ruledb, $mod_group, $targets,
+ $msginfo, $vars, $marks) = @_;
+
+ my $original;
+
+ my $from = 'postmaster';
+
+ my $body = PMG::Utils::subst_values($self->{body}, $vars);
+ my $subject = PMG::Utils::subst_values($self->{subject}, $vars);
+ my $to = PMG::Utils::subst_values($self->{to}, $vars);
+
+ if ($to =~ m/^\s*$/) {
+ # this happens if a notification is triggered by bounce mails
+ # which notifies the sender <> - we just log and then ignore it
+ syslog('info', "%s: notify <> (ignored)", $queue->{logid});
+ return;
+ }
+
+ $to =~ s/[;,]/ /g;
+ $to =~ s/\s+/,/g;
+
+ my $top = MIME::Entity->build(
+ From => $from,
+ To => $to,
+ Subject => $subject,
+ Data => $body);
+
+ if ($self->{attach} eq 'O') {
+ # attach original mail
+ my $path = "/var/spool/proxmox/active/$queue->{uid}";
+ $original = $top->attach(
+ Path => $path,
+ Filename => "original_message.eml",
+ Type => "message/rfc822",);
+ }
+
+ if ($msginfo->{testmode}) {
+ my $fh = $msginfo->{test_fh};
+ print $fh "notify: $self->{to}\n";
+ print $fh "notify content:\n";
+
+ if ($self->{attach} eq 'O') {
+ # make result reproducable for regression testing
+ $top->head->replace('content-type',
+ 'multipart/mixed; boundary="---=_1234567"');
+ }
+ $top->print ($fh);
+ print $fh "notify end\n";
+ } else {
+ my @targets = split(/\s*,\s*/, $to);
+ my $qid = PMG::Utils::reinject_mail(
+ $top, $from, \@targets, undef, $msginfo->{fqdn});
+ foreach (@targets) {
+ if ($qid) {
+ syslog('info', "%s: notify <%s> (%s)", $queue->{logid}, $_, $qid);
+ } else {
+ syslog ('err', "%s: notify <%s> failed", $queue->{logid}, $_);
+ }
+ }
+ }
+}
+
+sub to {
+ my ($self, $v) = @_;
+
+ if (defined ($v)) {
+ $self->{to} = $v;
+ }
+
+ $self->{to};
+}
+
+sub subject {
+ my ($self, $v) = @_;
+
+ if (defined ($v)) {
+ $self->{subject} = $v;
+ }
+
+ $self->{subject};
+}
+
+sub body {
+ my ($self, $v) = @_;
+
+ if (defined ($v)) {
+ $self->{body} = $v;
+ }
+
+ $self->{body};
+}
+
+sub attach {
+ my ($self, $v) = @_;
+
+ if (defined ($v)) {
+ $self->{attach} = $v;
+ }
+
+ $self->{attach};
+}
+
+sub short_desc {
+ my $self = shift;
+
+ return "notify $self->{to}";
+}
+
+1;
+
+__END__
+
+=head1 PMG::RuleDB::Notify
+
+Notifications.
use Carp;
use DBI;
+use PMG::Utils;
+
sub new {
my ($type, $otype, $ogroup) = @_;
use Digest::SHA;
use PVE::SafeSyslog;
-use PMG::RuleDB;
+
+use PMG::Utils;
+use PMG::ModGroup;
use PMG::RuleDB::Object;
use base qw(PMG::RuleDB::Object);
$sth->execute($self->ogroup, $self->otype);
- $self->{id} = PMG::RuleDB::lastid($ruledb->{dbh}, 'object_id_seq');
+ $self->{id} = PMG::Utils::lastid($ruledb->{dbh}, 'object_id_seq');
}
return $self->{id};
sub execute {
my ($self, $queue, $ruledb, $mod_group, $targets,
$msginfo, $vars, $marks, $ldap) = @_;
-
- die "fixme";
my $subgroups = $mod_group->subgroups($targets, 1);
foreach my $ta (@$subgroups) {
my ($tg, $entity) = (@$ta[0], @$ta[1]);
- Proxmox::Utils::remove_marks ($entity);
+ PMG::Utils::remove_marks($entity);
if ($queue->{vinfo}) {
if (my $qid = $queue->quarantine_mail($ruledb, 'V', $entity, $tg, $msginfo, $vars, $ldap)) {
--- /dev/null
+package PMG::RuleDB::Remove;
+
+use strict;
+use warnings;
+use Carp;
+use DBI;
+use Digest::SHA;
+use MIME::Words;
+use MIME::Entity;
+use Encode;
+
+use PVE::SafeSyslog;
+
+use PMG::Utils;
+use PMG::ModGroup;
+use PMG::RuleDB::Object;
+
+use base qw(PMG::RuleDB::Object);
+
+sub otype {
+ return 4007;
+}
+
+sub otype_text {
+ return 'Remove attachments';
+}
+
+sub oclass {
+ return 'action';
+}
+
+sub oicon {
+ return 'remove.gif';
+}
+
+sub oinfo {
+ return 'Remove attachments';
+}
+
+sub oisedit {
+ return 1;
+}
+
+sub final {
+ return 0;
+}
+
+sub priority {
+ return 40;
+}
+
+sub new {
+ my ($type, $all, $text, $ogroup) = @_;
+
+ my $class = ref($type) || $type;
+
+ $all = 0 if !defined ($all);
+
+ my $self = $class->SUPER::new(otype(), $ogroup);
+
+ $self->{all} = $all;
+ $self->{text} = $text;
+
+ return $self;
+}
+
+sub load_attr {
+ my ($type, $ruledb, $id, $ogroup, $value) = @_;
+
+ my $class = ref($type) || $type;
+
+ defined ($value) || croak "undefined value: ERROR";
+
+ my $obj;
+
+ if ($value =~ m/^([01])(\:(.*))?$/s) {
+ $obj = $class->new($1, $3, $ogroup);
+ } else {
+ $obj = $class->new(0, undef, $ogroup);
+ }
+
+ $obj->{id} = $id;
+
+ $obj->{digest} = Digest::SHA::sha1_hex($id, $value, $ogroup);
+
+ return $obj;
+}
+
+sub save {
+ my ($self, $ruledb) = @_;
+
+ defined($self->{ogroup}) || croak "undefined ogroup: ERROR";
+
+ my $value = $self->{all} ? '1' : '0';
+
+ if ($self->{text}) {
+ $value .= ":$self->{text}";
+ }
+
+ if (defined ($self->{id})) {
+ # update
+
+ $ruledb->{dbh}->do(
+ "UPDATE Object SET Value = ? WHERE ID = ?",
+ undef, $value, $self->{id});
+
+ } else {
+ # insert
+
+ my $sth = $ruledb->{dbh}->prepare(
+ "INSERT INTO Object (Objectgroup_ID, ObjectType, Value) " .
+ "VALUES (?, ?, ?);");
+
+ $sth->execute($self->ogroup, $self->otype, $value);
+
+ $self->{id} = PMG::Utils::lastid($ruledb->{dbh}, 'object_id_seq');
+ }
+
+ return $self->{id};
+}
+
+sub delete_marked_parts {
+ my ($self, $queue, $entity, $html, $rtype, $marks) = @_;
+
+ my $nparts = [];
+
+ my $pn = $entity->parts;
+ for (my $i = 0; $i < $pn; $i++) {
+ my $part = $entity->parts($i);
+
+ my ($id, $found);
+
+ if ($id = $part->head->mime_attr('x-proxmox-tmp-aid')) {
+ chomp $id;
+
+ if ($self->{all}) {
+ my $ctype_part = $part->head->mime_type;
+ if (!($i == 0 && $ctype_part =~ m|text/.*|i)) {
+ $found = 1;
+ }
+ } else {
+ foreach my $m (@$marks) {
+ $found = 1 if $m eq $id;
+ }
+ }
+
+ }
+
+ if ($found) {
+
+ my $on = PMG::Utils::extract_filename($part->head) || '';
+
+ my $text = PMG::Utils::subst_values($html, { FILENAME => $on } );
+
+ my $fname = "REMOVED_ATTACHMENT_$id." . ($rtype eq "text/html" ? "html" : "txt");
+
+ my $ent = MIME::Entity->build(
+ Type => $rtype,
+ Charset => 'UTF-8',
+ Encoding => "quoted-printable",
+ Filename => $fname,
+ Disposition => "attachment",
+ Data => encode('UTF-8', $text));
+
+ push (@$nparts, $ent);
+
+ syslog ('info', "%s: removed attachment $id ('%s')",
+ $queue->{logid}, $on);
+
+ } else {
+ $self->delete_marked_parts($queue, $part, $html, $rtype, $marks);
+ push (@$nparts, $part);
+ }
+ }
+
+ $entity->parts ($nparts);
+}
+
+sub execute {
+ my ($self, $queue, $ruledb, $mod_group, $targets,
+ $msginfo, $vars, $marks) = @_;
+
+ if (!$self->{all} && ($#$marks == -1)) {
+ # no marks
+ return;
+ }
+
+ my $subgroups = $mod_group->subgroups ($targets);
+
+ my $html = PMG::Utils::subst_values($self->{text}, $vars);
+
+ $html = "This attachment was removed: __FILENAME__\n" if !$html;
+
+ my $rtype = "text/plain";
+
+ if ($html =~ m/\<\w+\>/s) {
+ $rtype = "text/html";
+ }
+
+ foreach my $ta (@$subgroups) {
+ my ($tg, $entity) = (@$ta[0], @$ta[1]);
+
+ # handle singlepart mails
+ my $ctype = $entity->head->mime_type;
+ if (!$entity->is_multipart && (!$self->{all} || $ctype !~ m|text/.*|i)) {
+ $entity->make_multipart();
+ my $first_part = $entity->parts(0);
+ $first_part->head->mime_attr('x-proxmox-tmp-aid' => $entity->head->mime_attr('x-proxmox-tmp-aid'));
+ $entity->head->delete('x-proxmox-tmp-aid');
+ }
+
+ $self->delete_marked_parts($queue, $entity, $html, $rtype, $marks);
+
+ if ($msginfo->{testmode}) {
+ $entity->head->mime_attr('Content-type.boundary' => '------=_TEST123456') if $entity->is_multipart;
+ }
+ }
+}
+
+sub short_desc {
+ my $self = shift;
+
+ if ($self->{all}) {
+ return "remove all attachments";
+ } else {
+ return "remove matching attachments";
+ }
+}
+
+
+1;
+__END__
+
+=head1 PMG::RuleDB::Remove
+
+Remove attachments.
--- /dev/null
+package PMG::RuleDB::Spam;
+
+use strict;
+use warnings;
+use Carp;
+use DBI;
+use Digest::SHA;
+use Time::HiRes qw (gettimeofday);
+
+use PVE::SafeSyslog;
+use Mail::SpamAssassin;
+
+use PMG::Utils;
+use PMG::RuleDB::Object;
+
+use base qw(PMG::RuleDB::Object);
+
+sub otype {
+ return 3000;
+}
+
+sub oclass {
+ return 'what';
+}
+
+sub otype_text {
+ return 'Spam Filter';
+}
+
+sub oicon {
+ return 'spam.gif';
+}
+
+
+sub oinfo {
+ return 'Mark all Spam-Emails.';
+}
+
+sub new {
+ my ($type, $level, $ogroup) = @_;
+
+ my $class = ref($type) || $type;
+
+ my $self = $class->SUPER::new(otype(), $ogroup);
+
+ $level = 5 if !defined ($level);
+
+ $self->{level} = $level;
+
+ return $self;
+}
+
+sub load_attr {
+ my ($type, $ruledb, $id, $ogroup, $value) = @_;
+
+ my $class = ref($type) || $type;
+
+ defined($value) || croak "undefined value: ERROR";
+
+ my $obj = $class->new($value, $ogroup);
+ $obj->{id} = $id;
+
+ $obj->{digest} = Digest::SHA::sha1_hex($id, $value, $ogroup);
+
+ return $obj;
+}
+
+sub save {
+ my ($self, $ruledb) = @_;
+
+ defined($self->{ogroup}) || croak "undefined ogroup: ERROR";
+ defined($self->{level}) || croak "undefined spam level: ERROR";
+
+ if (defined ($self->{id})) {
+ # update
+
+ $ruledb->{dbh}->do(
+ "UPDATE Object SET Value = ? WHERE ID = ?",
+ undef, $self->{level}, $self->{id});
+
+ } else {
+ # insert
+
+ my $sth = $ruledb->{dbh}->prepare(
+ "INSERT INTO Object (Objectgroup_ID, ObjectType, Value) " .
+ "VALUES (?, ?, ?);");
+
+ $sth->execute($self->ogroup, $self->otype, $self->{level});
+
+ $self->{id} = PMG::Utils::lastid ($ruledb->{dbh}, 'object_id_seq');
+ }
+
+ return $self->{id};
+}
+
+sub parse_addrlist {
+ my ($list) = @_;
+
+ my $adlist = {};
+
+ foreach my $addr (split ('\s*,\s*', $list)) {
+ $addr = lc $addr;
+ my $regex = $addr;
+ # SA like checks
+ $regex =~ s/[\000\\\(]/_/gs; # is this really necessasry ?
+ $regex =~ s/([^\*\?_a-zA-Z0-9])/\\$1/g; # escape possible metachars
+ $regex =~ tr/?/./; # replace "?" with "."
+ $regex =~ s/\*+/\.\*/g; # replace "*" with ".*"
+
+ # we use a hash for extra fast testing
+ $adlist->{$addr} = "^${regex}\$";
+ }
+
+ return $adlist;
+}
+
+sub check_addrlist {
+ my ($list, $addrlst) = @_;
+
+ foreach my $addr (@$addrlst) {
+
+ $addr = lc $addr;
+
+ return 1 if defined ($list->{$addr});
+
+ study $addr;
+
+ foreach my $r (values %{$list}) {
+ if ($addr =~ qr/$r/i) {
+ return 1;
+ }
+ }
+ }
+
+ return 0;
+}
+
+sub get_blackwhite {
+ my ($dbh, $entity, $msginfo) = @_;
+
+ my $target_info = {};
+
+ my $targets = $msginfo->{targets};
+
+ my $cond = '';
+ foreach my $r (@$targets) {
+ my $pmail = $msginfo->{pmail}->{$r} || lc ($r);
+ my $qr = $dbh->quote ($pmail);
+ $cond .= " OR " if $cond;
+ $cond .= "pmail = $qr";
+ }
+
+ eval {
+ my $query = "SELECT * FROM UserPrefs WHERE " .
+ "($cond) AND (Name = 'BL' OR Name = 'WL')";
+ my $sth = $dbh->prepare($query);
+
+ $sth->execute();
+
+ while (my $ref = $sth->fetchrow_hashref()) {
+ my $pmail = lc ($ref->{pmail});
+ if ($ref->{name} eq 'WL') {
+ $target_info->{$pmail}->{whitelist} =
+ parse_addrlist($ref->{data});
+ } elsif ($ref->{name} eq 'BL') {
+ $target_info->{$pmail}->{blacklist} =
+ parse_addrlist($ref->{data});
+ }
+ }
+
+ $sth->finish;
+ };
+ if (my $err = $@) {
+ syslog('err', $err);
+ }
+
+ return $target_info;
+}
+
+sub what_match_targets {
+ my ($self, $queue, $entity, $msginfo, $dbh) = @_;
+
+ my $target_info;
+
+ if (!$queue->{spam_analyzed}) {
+ $self->analyze_spam($queue, $entity, $msginfo);
+ $queue->{blackwhite} = get_blackwhite($dbh, $entity, $msginfo);
+ $queue->{spam_analyzed} = 1;
+ }
+
+ if ($msginfo->{testmode}) {
+ $queue->{sa_score} = 100 if $queue->{sa_score} > 100;
+ my $data;
+ foreach my $s (@{$queue->{sa_data}}) {
+ next if $s->{rule} eq 'AWL';
+ push @$data, $s;
+ }
+ $queue->{sa_data} = $data;
+ }
+
+ if (defined($queue->{sa_score}) && $queue->{sa_score} >= $self->{level}) {
+
+ my $info = {
+ sa_score => $queue->{sa_score},
+ sa_max => $self->{level},
+ sa_data => $queue->{sa_data},
+ sa_hits => $queue->{sa_hits}
+ };
+
+ foreach my $t (@{$msginfo->{targets}}) {
+ my $list;
+ my $pmail = $msginfo->{pmail}->{$t} || $t;
+ if ($queue->{blackwhite}->{$pmail} &&
+ ($list = $queue->{blackwhite}->{$pmail}->{whitelist}) &&
+ check_addrlist($list, $queue->{all_from_addrs})) {
+ syslog('info', "%s: sender in user (%s) whitelist",
+ $queue->{logid}, $pmail);
+ } else {
+ $target_info->{$t}->{marks} = []; # never add additional marks here
+ $target_info->{$t}->{spaminfo} = $info;
+ }
+ }
+
+ } else {
+
+ foreach my $t (@{$msginfo->{targets}}) {
+ my $info = {
+ sa_score => 100,
+ sa_max => $self->{level},
+ sa_data => [{
+ rule => 'USER_IN_BLACKLIST',
+ score => 100,
+ desc => 'From: address is in the user black-list',
+ }],
+ sa_hits => 'USER_IN_BLACKLIST',
+ };
+
+ my $list;
+ my $pmail = $msginfo->{pmail}->{$t} || $t;
+ if ($queue->{blackwhite}->{$pmail} &&
+ ($list = $queue->{blackwhite}->{$pmail}->{blacklist}) &&
+ check_addrlist($list, $queue->{all_from_addrs})) {
+ $target_info->{$t}->{marks} = [];
+ $target_info->{$t}->{spaminfo} = $info;
+ syslog ('info', "%s: sender in user (%s) blacklist",
+ $queue->{logid}, $pmail);
+ }
+ }
+ }
+
+ return $target_info;
+}
+
+sub level {
+ my ($self, $v) = @_;
+
+ if (defined ($v)) {
+ $self->{level} = $v;
+ }
+
+ $self->{level};
+}
+
+sub short_desc {
+ my $self = shift;
+
+ return "Level $self->{level}";
+}
+
+sub __get_addr {
+ my ($head, $name) = @_;
+
+ my $result = $head->get($name);
+
+ return '' if !$result;
+
+ # copied from Mail::Spamassassin:PerMsgStatus _get()
+
+ $result =~ s/^[^:]+:(.*);\s*$/$1/gs; # 'undisclosed-recipients: ;'
+ $result =~ s/\s+/ /g; # reduce whitespace
+ $result =~ s/^\s+//; # leading whitespace
+ $result =~ s/\s+$//; # trailing whitespace
+
+ # Get the email address out of the header
+ # All of these should result in "jm@foo":
+ # jm@foo
+ # jm@foo (Foo Blah)
+ # jm@foo, jm@bar
+ # display: jm@foo (Foo Blah), jm@bar ;
+ # Foo Blah <jm@foo>
+ # "Foo Blah" <jm@foo>
+ # "'Foo Blah'" <jm@foo>
+ #
+ # strip out the (comments)
+ $result =~ s/\s*\(.*?\)//g;
+ # strip out the "quoted text", unless it's the only thing in the string
+ if ($result !~ /^".*"$/) {
+ $result =~ s/(?<!<)"[^"]*"(?!@)//g; #" emacs
+ }
+ # Foo Blah <jm@xxx> or <jm@xxx>
+ $result =~ s/^[^"<]*?<(.*?)>.*$/$1/;
+ # multiple addresses on one line? remove all but first
+ $result =~ s/,.*$//;
+
+ return $result;
+}
+
+# implement our own all_from_addrs()
+# because we do not call spamassassin in canes of commtouch match
+# see Mail::Spamassassin:PerMsgStatus for details
+sub __all_from_addrs {
+ my ($head) = @_;
+
+ my @addrs;
+
+ my $resent = $head->get('Resent-From');
+ if (defined($resent) && $resent =~ /\S/) {
+ @addrs = Mail::SpamAssassin->find_all_addrs_in_line($resent);
+ } else {
+ @addrs = map { tr/././s; $_ } grep { $_ ne '' }
+ (__get_addr($head, 'From'), # std
+ __get_addr($head, 'Envelope-Sender'), # qmail: new-inject(1)
+ __get_addr($head, 'Resent-Sender'), # procmailrc manpage
+ __get_addr($head, 'X-Envelope-From'), # procmailrc manpage
+ __get_addr($head, 'EnvelopeFrom')); # SMTP envelope
+ }
+
+ # Remove duplicate addresses
+ my %addrs = map { $_ => 1 } @addrs;
+ @addrs = keys %addrs;
+
+ return @addrs;
+}
+
+sub analyze_spam {
+ my ($self, $queue, $entity, $msginfo) = @_;
+
+ my $maxspamsize = $msginfo->{maxspamsize};
+
+ $maxspamsize = 200*1024 if !$maxspamsize;
+
+ my ($sa_score, $sa_max, $sa_scores, $sa_sumary, $list, $autolearn, $bayes);
+ $list = '';
+ $bayes = 'undefined';
+ $autolearn = 'no';
+ $sa_score = 0;
+ $sa_max = 5;
+
+ # do not run SA if license is not valid
+ if (!$queue->{lic_valid}) {
+ $queue->{sa_score} = 0;
+ return 0;
+ }
+
+ my $fromhash = { $queue->{from} => 1 };
+ foreach my $f (__all_from_addrs($entity->head())) {
+ $fromhash->{$f} = 1;
+ }
+ $queue->{all_from_addrs} = [ keys %$fromhash ];
+
+ my ($csec, $usec) = gettimeofday ();
+
+ my $spamtest = $queue->{sa};
+
+ # only run SA in testmode or when commtouch did not confirm spam (score < 5)
+ # do not run SA if mail is too large
+ if (($queue->{bytes} <= $maxspamsize) &&
+ ($msginfo->{testmode} || ($sa_score < 5))) {
+
+ # save and disable alarm (SA forgets to clear alarm in some cases)
+ my $previous_alarm = alarm (0);
+
+ my $pid = $$;
+
+ eval {
+ $queue->{fh}->seek (0, 0);
+
+ *SATMP = \*{$queue->{fh}};
+ my $mail = $spamtest->parse(\*SATMP);
+
+ # hack: pass envelope sender to spamassassin
+ $mail->header('X-Proxmox-Envelope-From', $queue->{from});
+
+ my $status = $spamtest->check ($mail);
+
+ #my $fromhash = { $queue->{from} => 1 };
+ #foreach my $f ($status->all_from_addrs()) {
+ #$fromhash->{$f} = 1;
+ #}
+ #$queue->{all_from_addrs} = [ keys %$fromhash ];
+
+ $sa_score += $status->get_score();
+ $sa_max = $status->get_required_score();
+ $autolearn = $status->get_autolearn_status();
+
+ $bayes = defined($status->{bayes_score}) ?
+ $status->{bayes_score} : "undefined";
+
+ my $salist = $status->get_names_of_tests_hit();
+
+ foreach my $rule (split (/,/, $salist)) {
+ $list .= $list ? ",$rule" : $rule;
+ my $score = $status->{conf}->{scores}->{$rule};
+ my $desc = $status->{conf}->get_description_for_rule($rule);
+ push @$sa_scores, { score => $score, rule => $rule, desc => $desc };
+ }
+
+ $status->finish();
+ $mail->finish();
+
+ alarm 0; # avoid race conditions
+ };
+ my $err = $@;
+
+ alarm ($previous_alarm);
+
+ # just to be sure - exit if SA produces a child process
+ if ($$ != $pid) {
+ syslog ('err', "WARNING: detected SA produced process - exiting");
+ POSIX::_exit (-1); # exit immediately
+ }
+
+ if ($err) {
+ syslog('err', $err);
+ $queue->{errors} = 1;
+ }
+ }
+
+ $sa_score = int ($sa_score);
+ $sa_score = 0 if $sa_score < 0;
+
+ my ($csec_end, $usec_end) = gettimeofday();
+ $queue->{ptime_spam} =
+ int (($csec_end-$csec)*1000 + ($usec_end - $usec)/1000);
+
+ syslog ('info', "%s: SA score=%s/%s time=%0.3f bayes=%s autolearn=%s hits=%s",
+ $queue->{logid}, $sa_score, $sa_max, $queue->{ptime_spam}/1000.0,
+ $bayes, $autolearn, $list);
+
+ $queue->{sa_score} = $sa_score;
+ $queue->{sa_max} = $sa_max;
+ $queue->{sa_data} = $sa_scores;
+ $queue->{sa_hits} = $list;
+
+ return ($sa_score >= $sa_max);
+}
+
+1;
+
+__END__
+
+=head1 PVE::RuleDB::Spam
+
+Spam level filter
use DBI;
use Digest::SHA;
+use PMG::Utils;
use PMG::RuleDB::Object;
use base qw(Proxmox::RuleDB::Object);
$sth->execute($self->ogroup, $self->otype, $v);
- $self->{id} = PMG::RuleDB::lastid($ruledb->{dbh}, 'object_id_seq');
+ $self->{id} = PMG::Utils::lastid($ruledb->{dbh}, 'object_id_seq');
}
return $self->{id};
use DBI;
use Digest::SHA;
+use PMG::Utils;
use PMG::RuleDB::Object;
use base qw(PMG::RuleDB::Object);
$sth->execute($self->ogroup, $self->otype);
- $self->{id} = Proxmox::RuleDB::lastid($ruledb->{dbh}, 'object_id_seq');
+ $self->{id} = PMG::Utils::lastid($ruledb->{dbh}, 'object_id_seq');
}
return $self->{id};
use DBI;
use Digest::SHA;
+use PMG::Utils;
use PMG::RuleDB::Object;
use base qw(PMG::RuleDB::Object);
$sth->execute($self->{ogroup}, $self->otype, $adr);
- $self->{id} = PMG::RuleDB::lastid($ruledb->{dbh}, 'object_id_seq');
+ $self->{id} = PMG::Utils::lastid($ruledb->{dbh}, 'object_id_seq');
}
return $self->{id};
--- /dev/null
+package PMG::SMTPPrinter;
+
+use strict;
+use warnings;
+
+sub new {
+ my ($class, $smtp) = @_;
+
+ my $self = { smtp => $smtp };
+
+ return bless $self;
+}
+
+sub print {
+ my ($self, $line) = @_;
+
+ $self->{smtp}->datasend ($line);
+}
+
+1;
--- /dev/null
+package PMG::Utils;
+
+use strict;
+use warnings;
+use Carp;
+use DBI;
+use Net::SMTP;
+
+use MIME::Words;
+use MIME::Parser;
+
+use PVE::SafeSyslog;
+
+sub lastid {
+ my ($dbh, $seq) = @_;
+
+ return $dbh->last_insert_id(
+ undef, undef, undef, undef, { sequence => $seq});
+}
+
+sub extract_filename {
+ my ($head) = @_;
+
+ if (my $value = $head->recommended_filename()) {
+ chomp $value;
+ if (my $decvalue = MIME::Words::decode_mimewords($value)) {
+ $decvalue =~ s/\0/ /g;
+ $decvalue = trim ($decvalue);
+ return $decvalue;
+ }
+ }
+
+ return undef;
+}
+
+sub remove_marks {
+ my ($entity, $add_id, $id) = @_;
+
+ $id //= 1;
+
+ foreach my $tag (grep {/^x-proxmox-tmp/i} $entity->head->tags) {
+ $entity->head->delete ($tag);
+ }
+
+ $entity->head->replace('X-Proxmox-tmp-AID', $id) if $add_id;
+
+ foreach my $part ($entity->parts) {
+ $id = remove_marks($part, $add_id, $id + 1);
+ }
+
+ return $id;
+}
+
+sub subst_values {
+ my ($body, $dh) = @_;
+
+ return if !$body;
+
+ foreach my $k (keys %$dh) {
+ my $v = $dh->{$k};
+ if (defined ($v)) {
+ $body =~ s/__${k}__/$v/gs;
+ }
+ }
+
+ return $body;
+}
+
+sub reinject_mail {
+ my ($entity, $sender, $targets, $xforward, $me, $nodsn) = @_;
+
+ my $smtp;
+ my $resid;
+ my $rescode;
+ my $resmess;
+
+ eval {
+ my $smtp = Net::SMTP->new('127.0.0.1', Port => 10025, Hello => $me) ||
+ die "unable to connect to localhost at port 10025";
+
+ if (defined($xforward)) {
+ my $xfwd;
+
+ foreach my $attr (keys %{$xforward}) {
+ $xfwd .= " $attr=$xforward->{$attr}";
+ }
+
+ if ($xfwd && $smtp->command("XFORWARD", $xfwd)->response() != CMD_OK) {
+ syslog('err', "xforward error - got: %s %s", $smtp->code, scalar($smtp->message));
+ }
+ }
+
+ if (!$smtp->mail($sender)) {
+ syslog('err', "smtp error - got: %s %s", $smtp->code, scalar ($smtp->message));
+ die "smtp from: ERROR";
+ }
+
+ my $dsnopts = $nodsn ? {Notify => ['NEVER']} : {};
+
+ if (!$smtp->to (@$targets, $dsnopts)) {
+ syslog ('err', "smtp error - got: %s %s", $smtp->code, scalar($smtp->message));
+ die "smtp to: ERROR";
+ }
+
+ # Output the head:
+ #$entity->sync_headers ();
+ $smtp->data();
+
+ my $out = PMG::SMTPPrinter->new($smtp);
+ $entity->print($out);
+
+ # make sure we always have a newline at the end of the mail
+ # else dataend() fails
+ $smtp->datasend("\n");
+
+ if ($smtp->dataend()) {
+ my @msgs = $smtp->message;
+ $resmess = $msgs[$#msgs];
+ ($resid) = $resmess =~ m/Ok: queued as ([0-9A-Z]+)/;
+ $rescode = $smtp->code;
+ if (!$resid) {
+ die sprintf("unexpected SMTP result - got: %s %s : WARNING", $smtp->code, $resmess);
+ }
+ } else {
+ my @msgs = $smtp->message;
+ $resmess = $msgs[$#msgs];
+ $rescode = $smtp->code;
+ die sprintf("sending data failed - got: %s %s : ERROR", $smtp->code, $resmess);
+ }
+ };
+ my $err = $@;
+
+ $smtp->quit if $smtp;
+
+ if ($err) {
+ syslog ('err', $err);
+ }
+
+ return wantarray ? ($resid, $rescode, $resmess) : $resid;
+}
+
+
+1;
Section: perl
Priority: optional
Maintainer: Proxmox Support Team <support@proxmox.com>
-Build-Depends: debhelper (>= 9), perl (>= 5.10.0-19), dh-systemd, libdbi-perl, libdbd-pg-perl, postgresql-9.6
+Build-Depends: debhelper (>= 9), perl (>= 5.10.0-19), dh-systemd, libdbi-perl, libdbd-pg-perl, postgresql-9.6, proxmox-spamassassin
Standards-Version: 3.9.5
Homepage: http://www.proxmox.com
Package: proxmox-mailgateway-api
Architecture: all
-Depends: ${perl:Depends}, libpve-common-perl, libpve-http-server-perl, libauthen-pam-perl, proxmox-mailgateway-gui, libtemplate-perl, fonts-font-awesome, novnc-pve, libfile-readbackwards-perl, libnet-ip-perl, libdbi-perl, libdbd-pg-perl, postgresql-9.6, libmime-tools-perl, shared-mime-info
+Depends: ${perl:Depends}, libpve-common-perl, libpve-http-server-perl, libauthen-pam-perl, proxmox-mailgateway-gui, libtemplate-perl, fonts-font-awesome, novnc-pve, libfile-readbackwards-perl, libnet-ip-perl, libdbi-perl, libdbd-pg-perl, postgresql-9.6, libmime-tools-perl, shared-mime-info, proxmox-spamassassin, libhtml-parser-perl
Description: Proxmox Mailgateway API Server Implementation
This implements a REST API to configure Proxmox Mailgateway.
\ No newline at end of file
projects / pmg-api.git / commitdiff