Mail-MtPolicyd-2.03000755000000000000 013306510157 13322 5ustar00rootroot000000000000README100644000000000000 54313306510157 14245 0ustar00rootroot000000000000Mail-MtPolicyd-2.03This archive contains the distribution Mail-MtPolicyd, version 2.03: a modular policy daemon for postfix This software is Copyright (c) 2014 by Markus Benning . This is free software, licensed under: The GNU General Public License, Version 2, June 1991 This README file was generated by Dist::Zilla::Plugin::Readme v6.012. t000755000000000000 013306510157 13506 5ustar00rootroot000000000000Mail-MtPolicyd-2.03use.t100755000000000000 54313306510157 14614 0ustar00rootroot000000000000Mail-MtPolicyd-2.03/tuse strict; use warnings; use Test::More; use File::Find; our $count = 0; find(\&find_cb, './lib'); sub find_cb { my $file = $File::Find::name; my $package; if ($file !~ m/\.pm$/) { return; } $package = $file; $package =~ s/^\.\/lib\///; $package =~ s/\.pm$//; $package =~ s/\//::/g; $count++; use_ok($package); } done_testing($count); LICENSE100644000000000000 4353313306510157 14440 0ustar00rootroot000000000000Mail-MtPolicyd-2.03This software is Copyright (c) 2014 by Markus Benning . This is free software, licensed under: The GNU General Public License, Version 2, June 1991 GNU GENERAL PUBLIC LICENSE Version 2, June 1991 Copyright (C) 1989, 1991 Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA Everyone is permitted to copy and distribute verbatim copies of this license document, but changing it is not allowed. Preamble The licenses for most software are designed to take away your freedom to share and change it. By contrast, the GNU General Public License is intended to guarantee your freedom to share and change free software--to make sure the software is free for all its users. This General Public License applies to most of the Free Software Foundation's software and to any other program whose authors commit to using it. (Some other Free Software Foundation software is covered by the GNU Lesser General Public License instead.) You can apply it to your programs, too. When we speak of free software, we are referring to freedom, not price. Our General Public Licenses are designed to make sure that you have the freedom to distribute copies of free software (and charge for this service if you wish), that you receive source code or can get it if you want it, that you can change the software or use pieces of it in new free programs; and that you know you can do these things. To protect your rights, we need to make restrictions that forbid anyone to deny you these rights or to ask you to surrender the rights. These restrictions translate to certain responsibilities for you if you distribute copies of the software, or if you modify it. For example, if you distribute copies of such a program, whether gratis or for a fee, you must give the recipients all the rights that you have. You must make sure that they, too, receive or can get the source code. And you must show them these terms so they know their rights. We protect your rights with two steps: (1) copyright the software, and (2) offer you this license which gives you legal permission to copy, distribute and/or modify the software. Also, for each author's protection and ours, we want to make certain that everyone understands that there is no warranty for this free software. If the software is modified by someone else and passed on, we want its recipients to know that what they have is not the original, so that any problems introduced by others will not reflect on the original authors' reputations. Finally, any free program is threatened constantly by software patents. We wish to avoid the danger that redistributors of a free program will individually obtain patent licenses, in effect making the program proprietary. To prevent this, we have made it clear that any patent must be licensed for everyone's free use or not licensed at all. The precise terms and conditions for copying, distribution and modification follow. GNU GENERAL PUBLIC LICENSE TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION 0. This License applies to any program or other work which contains a notice placed by the copyright holder saying it may be distributed under the terms of this General Public License. The "Program", below, refers to any such program or work, and a "work based on the Program" means either the Program or any derivative work under copyright law: that is to say, a work containing the Program or a portion of it, either verbatim or with modifications and/or translated into another language. (Hereinafter, translation is included without limitation in the term "modification".) Each licensee is addressed as "you". Activities other than copying, distribution and modification are not covered by this License; they are outside its scope. The act of running the Program is not restricted, and the output from the Program is covered only if its contents constitute a work based on the Program (independent of having been made by running the Program). Whether that is true depends on what the Program does. 1. You may copy and distribute verbatim copies of the Program's source code as you receive it, in any medium, provided that you conspicuously and appropriately publish on each copy an appropriate copyright notice and disclaimer of warranty; keep intact all the notices that refer to this License and to the absence of any warranty; and give any other recipients of the Program a copy of this License along with the Program. You may charge a fee for the physical act of transferring a copy, and you may at your option offer warranty protection in exchange for a fee. 2. You may modify your copy or copies of the Program or any portion of it, thus forming a work based on the Program, and copy and distribute such modifications or work under the terms of Section 1 above, provided that you also meet all of these conditions: a) You must cause the modified files to carry prominent notices stating that you changed the files and the date of any change. b) You must cause any work that you distribute or publish, that in whole or in part contains or is derived from the Program or any part thereof, to be licensed as a whole at no charge to all third parties under the terms of this License. c) If the modified program normally reads commands interactively when run, you must cause it, when started running for such interactive use in the most ordinary way, to print or display an announcement including an appropriate copyright notice and a notice that there is no warranty (or else, saying that you provide a warranty) and that users may redistribute the program under these conditions, and telling the user how to view a copy of this License. (Exception: if the Program itself is interactive but does not normally print such an announcement, your work based on the Program is not required to print an announcement.) These requirements apply to the modified work as a whole. If identifiable sections of that work are not derived from the Program, and can be reasonably considered independent and separate works in themselves, then this License, and its terms, do not apply to those sections when you distribute them as separate works. But when you distribute the same sections as part of a whole which is a work based on the Program, the distribution of the whole must be on the terms of this License, whose permissions for other licensees extend to the entire whole, and thus to each and every part regardless of who wrote it. Thus, it is not the intent of this section to claim rights or contest your rights to work written entirely by you; rather, the intent is to exercise the right to control the distribution of derivative or collective works based on the Program. In addition, mere aggregation of another work not based on the Program with the Program (or with a work based on the Program) on a volume of a storage or distribution medium does not bring the other work under the scope of this License. 3. You may copy and distribute the Program (or a work based on it, under Section 2) in object code or executable form under the terms of Sections 1 and 2 above provided that you also do one of the following: a) Accompany it with the complete corresponding machine-readable source code, which must be distributed under the terms of Sections 1 and 2 above on a medium customarily used for software interchange; or, b) Accompany it with a written offer, valid for at least three years, to give any third party, for a charge no more than your cost of physically performing source distribution, a complete machine-readable copy of the corresponding source code, to be distributed under the terms of Sections 1 and 2 above on a medium customarily used for software interchange; or, c) Accompany it with the information you received as to the offer to distribute corresponding source code. (This alternative is allowed only for noncommercial distribution and only if you received the program in object code or executable form with such an offer, in accord with Subsection b above.) The source code for a work means the preferred form of the work for making modifications to it. For an executable work, complete source code means all the source code for all modules it contains, plus any associated interface definition files, plus the scripts used to control compilation and installation of the executable. However, as a special exception, the source code distributed need not include anything that is normally distributed (in either source or binary form) with the major components (compiler, kernel, and so on) of the operating system on which the executable runs, unless that component itself accompanies the executable. If distribution of executable or object code is made by offering access to copy from a designated place, then offering equivalent access to copy the source code from the same place counts as distribution of the source code, even though third parties are not compelled to copy the source along with the object code. 4. You may not copy, modify, sublicense, or distribute the Program except as expressly provided under this License. Any attempt otherwise to copy, modify, sublicense or distribute the Program is void, and will automatically terminate your rights under this License. However, parties who have received copies, or rights, from you under this License will not have their licenses terminated so long as such parties remain in full compliance. 5. You are not required to accept this License, since you have not signed it. However, nothing else grants you permission to modify or distribute the Program or its derivative works. These actions are prohibited by law if you do not accept this License. Therefore, by modifying or distributing the Program (or any work based on the Program), you indicate your acceptance of this License to do so, and all its terms and conditions for copying, distributing or modifying the Program or works based on it. 6. Each time you redistribute the Program (or any work based on the Program), the recipient automatically receives a license from the original licensor to copy, distribute or modify the Program subject to these terms and conditions. You may not impose any further restrictions on the recipients' exercise of the rights granted herein. You are not responsible for enforcing compliance by third parties to this License. 7. If, as a consequence of a court judgment or allegation of patent infringement or for any other reason (not limited to patent issues), conditions are imposed on you (whether by court order, agreement or otherwise) that contradict the conditions of this License, they do not excuse you from the conditions of this License. If you cannot distribute so as to satisfy simultaneously your obligations under this License and any other pertinent obligations, then as a consequence you may not distribute the Program at all. For example, if a patent license would not permit royalty-free redistribution of the Program by all those who receive copies directly or indirectly through you, then the only way you could satisfy both it and this License would be to refrain entirely from distribution of the Program. If any portion of this section is held invalid or unenforceable under any particular circumstance, the balance of the section is intended to apply and the section as a whole is intended to apply in other circumstances. It is not the purpose of this section to induce you to infringe any patents or other property right claims or to contest validity of any such claims; this section has the sole purpose of protecting the integrity of the free software distribution system, which is implemented by public license practices. Many people have made generous contributions to the wide range of software distributed through that system in reliance on consistent application of that system; it is up to the author/donor to decide if he or she is willing to distribute software through any other system and a licensee cannot impose that choice. This section is intended to make thoroughly clear what is believed to be a consequence of the rest of this License. 8. If the distribution and/or use of the Program is restricted in certain countries either by patents or by copyrighted interfaces, the original copyright holder who places the Program under this License may add an explicit geographical distribution limitation excluding those countries, so that distribution is permitted only in or among countries not thus excluded. In such case, this License incorporates the limitation as if written in the body of this License. 9. The Free Software Foundation may publish revised and/or new versions of the General Public License from time to time. Such new versions will be similar in spirit to the present version, but may differ in detail to address new problems or concerns. Each version is given a distinguishing version number. If the Program specifies a version number of this License which applies to it and "any later version", you have the option of following the terms and conditions either of that version or of any later version published by the Free Software Foundation. If the Program does not specify a version number of this License, you may choose any version ever published by the Free Software Foundation. 10. If you wish to incorporate parts of the Program into other free programs whose distribution conditions are different, write to the author to ask for permission. For software which is copyrighted by the Free Software Foundation, write to the Free Software Foundation; we sometimes make exceptions for this. Our decision will be guided by the two goals of preserving the free status of all derivatives of our free software and of promoting the sharing and reuse of software generally. NO WARRANTY 11. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION. 12. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES. END OF TERMS AND CONDITIONS How to Apply These Terms to Your New Programs If you develop a new program, and you want it to be of the greatest possible use to the public, the best way to achieve this is to make it free software which everyone can redistribute and change under these terms. To do so, attach the following notices to the program. It is safest to attach them to the start of each source file to most effectively convey the exclusion of warranty; and each file should have at least the "copyright" line and a pointer to where the full notice is found. Copyright (C) This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. Also add information on how to contact you by electronic and paper mail. If the program is interactive, make it output a short notice like this when it starts in an interactive mode: Gnomovision version 69, Copyright (C) year name of author Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'. This is free software, and you are welcome to redistribute it under certain conditions; type `show c' for details. The hypothetical commands `show w' and `show c' should show the appropriate parts of the General Public License. Of course, the commands you use may be called something other than `show w' and `show c'; they could even be mouse-clicks or menu items--whatever suits your program. You should also get your employer (if you work as a programmer) or your school, if any, to sign a "copyright disclaimer" for the program, if necessary. Here is a sample; alter the names: Yoyodyne, Inc., hereby disclaims all copyright interest in the program `Gnomovision' (which makes passes at compilers) written by James Hacker. , 1 April 1989 Ty Coon, President of Vice This General Public License does not permit incorporating your program into proprietary programs. If your program is a subroutine library, you may consider it more useful to permit linking proprietary applications with the library. If this is what you want to do, use the GNU Lesser General Public License instead of this License. CHANGES100644000000000000 1212013306510157 14412 0ustar00rootroot000000000000Mail-MtPolicyd-2.03================================================== Changes from 2017-06-08 00:00:00 +0000 to present. ================================================== ----------------------------------------- version 2.03 at 2018-06-08 14:19:13 +0000 ----------------------------------------- Change: 25d4d7a9ae09d8f68a1d7f83c6b49d59eb10cf92 Author: Markus Benning Date : 2018-06-08 13:31:12 +0000 Remove website and mailing list links from docs Website and mailing lists are no longer available. The website was mostly based on the POD documentation which could also be browsed on metacpan or github. The mailing list was very low traffic. Please use the github bugtracker instead. Change: e9c104a44f49a68385a57b4e5aa422b429c041df Author: Markus Benning Date : 2018-06-08 13:21:26 +0000 Merge branch 'master' of github.com:benningm/mtpolicyd Change: 0aa29d07f32d7e002780db19e01fa99428c314ee Author: Markus Benning Date : 2018-06-08 13:11:54 +0000 Improve LDAP connection error handling In Mail::MtPolicyd::Connection::Ldap: * Add error handler and invalidate connection on connection errors. * Add check before returning handle if underlying socket is in connected state. If the socket is available. This will only detect closed connection if the system knows about it. There are still cases which can only be detected by sending data. In Mail::MtPolicyd::Role::Connection: * Dont cache connection handles. Always ask the connection for it. Test case: * openldap container for tests in docker-compose.yml * test for ldap connection handling in t/connection-ldap.t Change: 8aa7526653ff2ec92b5f67f46d4b0d70264f5849 Author: Markus Benning Date : 2018-06-08 10:54:00 +0000 Remove TravisCI Change: 8fdf3ecb909407c213c9e95359f0af89b2152c43 Author: Markus Benning Date : 2018-06-08 10:51:51 +0000 Mount local source directory in docker environment Change: 5a338763b4c44676e35d30b5315d9b2591de1ac4 Author: Markus Benning Date : 2018-06-08 10:50:33 +0000 Update dependencies Removes Test::Memcached and adds missing File::Slurp. Change: 510a19c25231e0a421be86028703278c6f521d47 Author: Markus Benning Date : 2018-06-08 10:48:00 +0000 Use memcached container instead of Test::Memcached This removes Test::Memcached from tests which will start a background memcached for each tests. Instead the memcached docker container instance is used. Change: a129653219bf13ec9ec3756433c23b1099d3465c Author: Markus Benning Date : 2018-06-08 10:46:36 +0000 Update IP for SBL blocked host Change: f27289c67526b7d10e4f36540e24199edff08a38 Author: Markus Benning Date : 2018-06-08 10:45:13 +0000 Run mtpolicyd with mtpolicyd user in docker Change: 05f7ad91dd94f1f1d88bb59aaf2cec6623883156 Author: Markus Benning Date : 2018-06-07 16:32:32 +0000 Move carton module to external folder in docker This will allow running with an source directory volume without installing modules locally. Change: 8f39be765efd97c1a7a58af1ecc7ff107ba5e563 Author: Markus Benning Date : 2018-06-07 16:31:14 +0000 Dont ignore cpanfile.snapshot Change: 6f5bbfdcb33f2851ac80eb31b124a522dd2148ec Author: Markus Benning Date : 2018-06-07 14:44:17 +0000 Merge pull request #26 from benningm/mysql_engine_option Add support for mysql_engine parameter Change: 46d27d16c207920e331293b00781cc575f0f6809 Author: Markus Benning Date : 2017-11-26 18:52:05 +0000 Add support for mysql_engine parameter Change: db3713ae2eb7d23949b49d26fffddb693155cda8 Author: Markus Benning Date : 2017-11-26 18:51:34 +0000 Update test parameters Change: 75da529d10cd0f94ad7a5607fdbfa7822af02c05 Author: Markus Benning Date : 2017-05-07 18:33:55 +0000 Modularize greylisting storage This modularizes the storage backends of the greylisting plungin and adds support for using Redis as storage for AWL and tickets. Change: 87960600287f3abafa01a116d6259d66b656fa8d Author: Markus Benning Date : 2017-03-25 11:15:35 +0000 Fix spelling errors in PODs fixes #24 Change: 10c1ff8a6e8cb06865873ebc4f5ecddfcb55770c Author: Markus Benning Date : 2017-03-25 11:10:53 +0000 Added new RegexList Plugin Change: 9f91d2b1b827edf8adb7eb081aaf765762e09e84 Author: Markus Benning Date : 2016-08-13 19:00:13 +0000 Implement alternative connection methods for redis This allows to specify a redis server also by unix domain socket or sentinels/service. implements #20 ================================================= Plus 15 releases after 2017-06-08 00:00:00 +0000. ================================================= cpanfile100644000000000000 477513306510157 15124 0ustar00rootroot000000000000Mail-MtPolicyd-2.03#!perl requires 'perl', '5.8.5'; requires 'BerkeleyDB'; requires 'BerkeleyDB::Hash'; requires 'Cache::Memcached'; requires 'Redis'; requires 'Config::General'; requires 'DBI'; requires 'Data::Dumper'; requires 'File::Slurp'; requires 'Geo::IP'; requires 'Getopt::Long'; requires 'HTTP::Request::Common'; requires 'IO::Handle'; requires 'IO::Socket::INET'; requires 'IO::Socket::UNIX'; requires 'JSON'; requires 'LWP::UserAgent'; requires 'Mail::RBL'; requires 'Mail::SPF'; requires 'Moose'; requires 'Moose::Role'; requires 'Moose::Util::TypeConstraints'; requires 'MooseX::Getopt'; requires 'MooseX::Role::Parameterized'; requires 'MooseX::Singleton'; requires 'Net::DNS::Resolver'; requires 'Net::LDAP'; requires 'Net::LDAP::Util'; requires 'Net::SMTP::Verify'; requires 'Net::Server::PreFork'; requires 'NetAddr::IP'; requires 'Tie::IxHash'; requires 'Time::HiRes'; requires 'Time::Piece'; requires 'Time::Seconds'; requires 'namespace::autoclean'; requires 'strict'; requires 'Storable'; on 'test' => sub { requires 'DBD::SQLite'; requires 'File::Find'; requires 'File::ReadBackwards'; requires 'File::Temp'; requires 'IO::File'; requires 'Template'; requires 'Test::BDD::Cucumber::Harness::TestBuilder'; requires 'Test::BDD::Cucumber::Loader'; requires 'Test::Exception'; requires 'Test::RedisDB'; requires 'Test::Mock::Net::Server::Mail'; requires 'Test::Net::LDAP::Mock'; requires 'Test::MockObject'; requires 'Test::More'; requires 'Test::Pod'; requires 'String::Random'; requires 'Test::Deep'; }; on 'develop' => sub { requires 'ExtUtils::MakeMaker'; requires 'Dist::Zilla::Plugin::MetaProvides::Package'; requires 'Dist::Zilla::Plugin::Prereqs::FromCPANfile'; requires 'Dist::Zilla::Plugin::ChangelogFromGit'; requires 'Dist::Zilla::Plugin::ChangelogFromGit::Debian'; requires 'Dist::Zilla::Plugin::FileFinder::ByName'; requires 'Dist::Zilla::Plugin::Git::NextVersion'; requires 'Dist::Zilla::Plugin::MetaJSON'; requires 'Dist::Zilla::Plugin::MetaResources'; requires 'Dist::Zilla::Plugin::OurPkgVersion'; requires 'Dist::Zilla::Plugin::PodSyntaxTests'; requires 'Dist::Zilla::Plugin::PodWeaver'; requires 'Dist::Zilla::Plugin::Prereqs'; requires 'Dist::Zilla::Plugin::PruneFiles'; requires 'Dist::Zilla::Plugin::Template::Tiny'; requires 'Dist::Zilla::Plugin::Test::Perl::Critic'; requires 'Dist::Zilla::Plugin::TravisYML'; requires 'Dist::Zilla::PluginBundle::Basic'; requires 'Dist::Zilla::PluginBundle::Git'; }; feature 'mysql' => sub { recommends 'DBD::mysql'; } dist.ini100755000000000000 147513306510157 15061 0ustar00rootroot000000000000Mail-MtPolicyd-2.03name = Mail-MtPolicyd author = Markus Benning license = GPL_2 copyright_holder = Markus Benning copyright_year = 2014 [Git::NextVersion] first_version = 1.11 [MetaJSON] [MetaResources] bugtracker.web = http://rt.cpan.org/NoAuth/Bugs.html?Dist=Mail-MtPolicyd bugtracker.mailto = bug-mail-mtpolicyd@rt.cpan.org repository.url = https://github.com/benningm/mtpolicyd repository.web = https://github.com/benningm/mtpolicyd.git repository.type = git [MetaProvides::Package] [@Basic] [PodSyntaxTests] [Prereqs::FromCPANfile] [OurPkgVersion] [Test::Perl::Critic] [PodWeaver] [@Git] [ChangelogFromGit] [FileFinder::ByName / rpm] file = rpm/*.tt [Template::Tiny] finder = rpm prune = 1 [PruneFiles] match = ^mtpolicyd_ match = ^README.pod$ match = ^local/ match = ^cpanfile\.snapshot$ cron.t100644000000000000 262513306510157 15001 0ustar00rootroot000000000000Mail-MtPolicyd-2.03/t#!perl package Mail::MtPolicyd::Plugin::CronTest; use Moose; extends 'Mail::MtPolicyd::Plugin'; sub cron { my $self = shift; my $server = shift; my $str = 'cron has been called with '.join(',', @_); $server->{'cron-test-output'} = $str; $server->log(3, $str); if( grep { $_ eq 'die' } @_ ) { die($str); } return; } package main; use strict; use warnings; use Test::More tests => 6; use Test::Exception; use Mail::MtPolicyd; use Mail::MtPolicyd::VirtualHost; my $policyd = Mail::MtPolicyd->new; isa_ok($policyd, 'Mail::MtPolicyd'); $policyd->{'virtual_hosts'}->{'main'} = Mail::MtPolicyd::VirtualHost->new_from_config(12345, { name => 'test-vhost', port => 12345, Plugin => { 'cron-test' => { name => 'cron-test', module => 'CronTest', log_level => 0, }, }, } ); isa_ok($policyd->{'virtual_hosts'}->{'main'}, 'Mail::MtPolicyd::VirtualHost'); lives_ok { $policyd->cron('daily','hourly'); } 'cron() expected to live'; cmp_ok( $policyd->{'cron-test-output'}, 'eq', 'cron has been called with daily,hourly', 'check cron output'); lives_ok { $policyd->cron('daily','hourly','die'); } 'exceptions must be catched if cron of plugin fails'; cmp_ok( $policyd->{'cron-test-output'}, 'eq', 'cron has been called with daily,hourly,die', 'check cron output'); META.yml100644000000000000 2140413306510157 14675 0ustar00rootroot000000000000Mail-MtPolicyd-2.03--- abstract: 'a modular policy daemon for postfix' author: - 'Markus Benning ' build_requires: DBD::SQLite: '0' File::Find: '0' File::ReadBackwards: '0' File::Temp: '0' IO::File: '0' String::Random: '0' Template: '0' Test::BDD::Cucumber::Harness::TestBuilder: '0' Test::BDD::Cucumber::Loader: '0' Test::Deep: '0' Test::Exception: '0' Test::Mock::Net::Server::Mail: '0' Test::MockObject: '0' Test::More: '0' Test::Net::LDAP::Mock: '0' Test::Pod: '0' Test::RedisDB: '0' configure_requires: ExtUtils::MakeMaker: '0' dynamic_config: 0 generated_by: 'Dist::Zilla version 6.012, CPAN::Meta::Converter version 2.150005' license: gpl meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: '1.4' name: Mail-MtPolicyd optional_features: mysql: description: mysql recommends: DBD::mysql: '0' provides: Mail::MtPolicyd: file: lib/Mail/MtPolicyd.pm version: '2.03' Mail::MtPolicyd::AddressList: file: lib/Mail/MtPolicyd/AddressList.pm version: '2.03' Mail::MtPolicyd::Client: file: lib/Mail/MtPolicyd/Client.pm version: '2.03' Mail::MtPolicyd::Client::App: file: lib/Mail/MtPolicyd/Client/App.pm version: '2.03' Mail::MtPolicyd::Client::Request: file: lib/Mail/MtPolicyd/Client/Request.pm version: '2.03' Mail::MtPolicyd::Client::Response: file: lib/Mail/MtPolicyd/Client/Response.pm version: '2.03' Mail::MtPolicyd::Connection: file: lib/Mail/MtPolicyd/Connection.pm version: '2.03' Mail::MtPolicyd::Connection::Ldap: file: lib/Mail/MtPolicyd/Connection/Ldap.pm version: '2.03' Mail::MtPolicyd::Connection::Memcached: file: lib/Mail/MtPolicyd/Connection/Memcached.pm version: '2.03' Mail::MtPolicyd::Connection::Redis: file: lib/Mail/MtPolicyd/Connection/Redis.pm version: '2.03' Mail::MtPolicyd::Connection::Sql: file: lib/Mail/MtPolicyd/Connection/Sql.pm version: '2.03' Mail::MtPolicyd::ConnectionPool: file: lib/Mail/MtPolicyd/ConnectionPool.pm version: '2.03' Mail::MtPolicyd::Plugin: file: lib/Mail/MtPolicyd/Plugin.pm version: '2.03' Mail::MtPolicyd::Plugin::Accounting: file: lib/Mail/MtPolicyd/Plugin/Accounting.pm version: '2.03' Mail::MtPolicyd::Plugin::Action: file: lib/Mail/MtPolicyd/Plugin/Action.pm version: '2.03' Mail::MtPolicyd::Plugin::AddScoreHeader: file: lib/Mail/MtPolicyd/Plugin/AddScoreHeader.pm version: '2.03' Mail::MtPolicyd::Plugin::ClearFields: file: lib/Mail/MtPolicyd/Plugin/ClearFields.pm version: '2.03' Mail::MtPolicyd::Plugin::Condition: file: lib/Mail/MtPolicyd/Plugin/Condition.pm version: '2.03' Mail::MtPolicyd::Plugin::CtIpRep: file: lib/Mail/MtPolicyd/Plugin/CtIpRep.pm version: '2.03' Mail::MtPolicyd::Plugin::DBL: file: lib/Mail/MtPolicyd/Plugin/DBL.pm version: '2.03' Mail::MtPolicyd::Plugin::Eval: file: lib/Mail/MtPolicyd/Plugin/Eval.pm version: '2.03' Mail::MtPolicyd::Plugin::Fail2Ban: file: lib/Mail/MtPolicyd/Plugin/Fail2Ban.pm version: '2.03' Mail::MtPolicyd::Plugin::GeoIPAction: file: lib/Mail/MtPolicyd/Plugin/GeoIPAction.pm version: '2.03' Mail::MtPolicyd::Plugin::GeoIPLookup: file: lib/Mail/MtPolicyd/Plugin/GeoIPLookup.pm version: '2.03' Mail::MtPolicyd::Plugin::Greylist: file: lib/Mail/MtPolicyd/Plugin/Greylist.pm version: '2.03' Mail::MtPolicyd::Plugin::Greylist::AWL::Base: file: lib/Mail/MtPolicyd/Plugin/Greylist/AWL/Base.pm version: '2.03' Mail::MtPolicyd::Plugin::Greylist::AWL::Redis: file: lib/Mail/MtPolicyd/Plugin/Greylist/AWL/Redis.pm version: '2.03' Mail::MtPolicyd::Plugin::Greylist::AWL::Sql: file: lib/Mail/MtPolicyd/Plugin/Greylist/AWL/Sql.pm version: '2.03' Mail::MtPolicyd::Plugin::Greylist::Ticket::Base: file: lib/Mail/MtPolicyd/Plugin/Greylist/Ticket/Base.pm version: '2.03' Mail::MtPolicyd::Plugin::Greylist::Ticket::Memcached: file: lib/Mail/MtPolicyd/Plugin/Greylist/Ticket/Memcached.pm version: '2.03' Mail::MtPolicyd::Plugin::Greylist::Ticket::Redis: file: lib/Mail/MtPolicyd/Plugin/Greylist/Ticket/Redis.pm version: '2.03' Mail::MtPolicyd::Plugin::Honeypot: file: lib/Mail/MtPolicyd/Plugin/Honeypot.pm version: '2.03' Mail::MtPolicyd::Plugin::LdapUserConfig: file: lib/Mail/MtPolicyd/Plugin/LdapUserConfig.pm version: '2.03' Mail::MtPolicyd::Plugin::PostfixMap: file: lib/Mail/MtPolicyd/Plugin/PostfixMap.pm version: '2.03' Mail::MtPolicyd::Plugin::Proxy: file: lib/Mail/MtPolicyd/Plugin/Proxy.pm version: '2.03' Mail::MtPolicyd::Plugin::Quota: file: lib/Mail/MtPolicyd/Plugin/Quota.pm version: '2.03' Mail::MtPolicyd::Plugin::RBL: file: lib/Mail/MtPolicyd/Plugin/RBL.pm version: '2.03' Mail::MtPolicyd::Plugin::RBLAction: file: lib/Mail/MtPolicyd/Plugin/RBLAction.pm version: '2.03' Mail::MtPolicyd::Plugin::RegexList: file: lib/Mail/MtPolicyd/Plugin/RegexList.pm version: '2.03' Mail::MtPolicyd::Plugin::Result: file: lib/Mail/MtPolicyd/Plugin/Result.pm version: '2.03' Mail::MtPolicyd::Plugin::Role::ConfigurableFields: file: lib/Mail/MtPolicyd/Plugin/Role/ConfigurableFields.pm version: '2.03' Mail::MtPolicyd::Plugin::Role::PluginChain: file: lib/Mail/MtPolicyd/Plugin/Role/PluginChain.pm version: '2.03' Mail::MtPolicyd::Plugin::Role::Scoring: file: lib/Mail/MtPolicyd/Plugin/Role/Scoring.pm version: '2.03' Mail::MtPolicyd::Plugin::Role::SqlUtils: file: lib/Mail/MtPolicyd/Plugin/Role/SqlUtils.pm version: '2.03' Mail::MtPolicyd::Plugin::Role::UserConfig: file: lib/Mail/MtPolicyd/Plugin/Role/UserConfig.pm version: '2.03' Mail::MtPolicyd::Plugin::SMTPVerify: file: lib/Mail/MtPolicyd/Plugin/SMTPVerify.pm version: '2.03' Mail::MtPolicyd::Plugin::SPF: file: lib/Mail/MtPolicyd/Plugin/SPF.pm version: '2.03' Mail::MtPolicyd::Plugin::SaAwlAction: file: lib/Mail/MtPolicyd/Plugin/SaAwlAction.pm version: '2.03' Mail::MtPolicyd::Plugin::SaAwlLookup: file: lib/Mail/MtPolicyd/Plugin/SaAwlLookup.pm version: '2.03' Mail::MtPolicyd::Plugin::ScoreAction: file: lib/Mail/MtPolicyd/Plugin/ScoreAction.pm version: '2.03' Mail::MtPolicyd::Plugin::SetField: file: lib/Mail/MtPolicyd/Plugin/SetField.pm version: '2.03' Mail::MtPolicyd::Plugin::SqlList: file: lib/Mail/MtPolicyd/Plugin/SqlList.pm version: '2.03' Mail::MtPolicyd::Plugin::SqlUserConfig: file: lib/Mail/MtPolicyd/Plugin/SqlUserConfig.pm version: '2.03' Mail::MtPolicyd::Plugin::Stress: file: lib/Mail/MtPolicyd/Plugin/Stress.pm version: '2.03' Mail::MtPolicyd::PluginChain: file: lib/Mail/MtPolicyd/PluginChain.pm version: '2.03' Mail::MtPolicyd::Profiler: file: lib/Mail/MtPolicyd/Profiler.pm version: '2.03' Mail::MtPolicyd::Profiler::Timer: file: lib/Mail/MtPolicyd/Profiler/Timer.pm version: '2.03' Mail::MtPolicyd::Request: file: lib/Mail/MtPolicyd/Request.pm version: '2.03' Mail::MtPolicyd::Result: file: lib/Mail/MtPolicyd/Result.pm version: '2.03' Mail::MtPolicyd::Role::Connection: file: lib/Mail/MtPolicyd/Role/Connection.pm version: '2.03' Mail::MtPolicyd::SessionCache: file: lib/Mail/MtPolicyd/SessionCache.pm version: '2.03' Mail::MtPolicyd::SessionCache::Base: file: lib/Mail/MtPolicyd/SessionCache/Base.pm version: '2.03' Mail::MtPolicyd::SessionCache::Memcached: file: lib/Mail/MtPolicyd/SessionCache/Memcached.pm version: '2.03' Mail::MtPolicyd::SessionCache::None: file: lib/Mail/MtPolicyd/SessionCache/None.pm version: '2.03' Mail::MtPolicyd::SessionCache::Redis: file: lib/Mail/MtPolicyd/SessionCache/Redis.pm version: '2.03' Mail::MtPolicyd::VirtualHost: file: lib/Mail/MtPolicyd/VirtualHost.pm version: '2.03' requires: BerkeleyDB: '0' BerkeleyDB::Hash: '0' Cache::Memcached: '0' Config::General: '0' DBI: '0' Data::Dumper: '0' File::Slurp: '0' Geo::IP: '0' Getopt::Long: '0' HTTP::Request::Common: '0' IO::Handle: '0' IO::Socket::INET: '0' IO::Socket::UNIX: '0' JSON: '0' LWP::UserAgent: '0' Mail::RBL: '0' Mail::SPF: '0' Moose: '0' Moose::Role: '0' Moose::Util::TypeConstraints: '0' MooseX::Getopt: '0' MooseX::Role::Parameterized: '0' MooseX::Singleton: '0' Net::DNS::Resolver: '0' Net::LDAP: '0' Net::LDAP::Util: '0' Net::SMTP::Verify: '0' Net::Server::PreFork: '0' NetAddr::IP: '0' Redis: '0' Storable: '0' Tie::IxHash: '0' Time::HiRes: '0' Time::Piece: '0' Time::Seconds: '0' namespace::autoclean: '0' perl: v5.8.5 strict: '0' resources: bugtracker: http://rt.cpan.org/NoAuth/Bugs.html?Dist=Mail-MtPolicyd repository: https://github.com/benningm/mtpolicyd version: '2.03' x_generated_by_perl: v5.24.0 x_serialization_backend: 'YAML::Tiny version 1.73' MANIFEST100644000000000000 777313306510157 14552 0ustar00rootroot000000000000Mail-MtPolicyd-2.03# This file was automatically generated by Dist::Zilla::Plugin::Manifest v6.012. CHANGES Dockerfile LICENSE MANIFEST META.json META.yml Makefile.PL README bin/mtpolicyd bin/policyd-client cpanfile dist.ini docker-compose.yml etc/docker.conf etc/mtpolicyd.conf etc/mtpolicyd.crontab lib/Mail/MtPolicyd.pm lib/Mail/MtPolicyd/AddressList.pm lib/Mail/MtPolicyd/Client.pm lib/Mail/MtPolicyd/Client/App.pm lib/Mail/MtPolicyd/Client/Request.pm lib/Mail/MtPolicyd/Client/Response.pm lib/Mail/MtPolicyd/Connection.pm lib/Mail/MtPolicyd/Connection/Ldap.pm lib/Mail/MtPolicyd/Connection/Memcached.pm lib/Mail/MtPolicyd/Connection/Redis.pm lib/Mail/MtPolicyd/Connection/Sql.pm lib/Mail/MtPolicyd/ConnectionPool.pm lib/Mail/MtPolicyd/Cookbook.pod lib/Mail/MtPolicyd/Cookbook/BasicPlugin.pod lib/Mail/MtPolicyd/Cookbook/ExtendedPlugin.pod lib/Mail/MtPolicyd/Cookbook/HowtoAccountingQuota.pod lib/Mail/MtPolicyd/Cookbook/Installation.pod lib/Mail/MtPolicyd/Plugin.pm lib/Mail/MtPolicyd/Plugin/Accounting.pm lib/Mail/MtPolicyd/Plugin/Action.pm lib/Mail/MtPolicyd/Plugin/AddScoreHeader.pm lib/Mail/MtPolicyd/Plugin/ClearFields.pm lib/Mail/MtPolicyd/Plugin/Condition.pm lib/Mail/MtPolicyd/Plugin/CtIpRep.pm lib/Mail/MtPolicyd/Plugin/DBL.pm lib/Mail/MtPolicyd/Plugin/Eval.pm lib/Mail/MtPolicyd/Plugin/Fail2Ban.pm lib/Mail/MtPolicyd/Plugin/GeoIPAction.pm lib/Mail/MtPolicyd/Plugin/GeoIPLookup.pm lib/Mail/MtPolicyd/Plugin/Greylist.pm lib/Mail/MtPolicyd/Plugin/Greylist/AWL/Base.pm lib/Mail/MtPolicyd/Plugin/Greylist/AWL/Redis.pm lib/Mail/MtPolicyd/Plugin/Greylist/AWL/Sql.pm lib/Mail/MtPolicyd/Plugin/Greylist/Ticket/Base.pm lib/Mail/MtPolicyd/Plugin/Greylist/Ticket/Memcached.pm lib/Mail/MtPolicyd/Plugin/Greylist/Ticket/Redis.pm lib/Mail/MtPolicyd/Plugin/Honeypot.pm lib/Mail/MtPolicyd/Plugin/LdapUserConfig.pm lib/Mail/MtPolicyd/Plugin/PostfixMap.pm lib/Mail/MtPolicyd/Plugin/Proxy.pm lib/Mail/MtPolicyd/Plugin/Quota.pm lib/Mail/MtPolicyd/Plugin/RBL.pm lib/Mail/MtPolicyd/Plugin/RBLAction.pm lib/Mail/MtPolicyd/Plugin/RegexList.pm lib/Mail/MtPolicyd/Plugin/Result.pm lib/Mail/MtPolicyd/Plugin/Role/ConfigurableFields.pm lib/Mail/MtPolicyd/Plugin/Role/PluginChain.pm lib/Mail/MtPolicyd/Plugin/Role/Scoring.pm lib/Mail/MtPolicyd/Plugin/Role/SqlUtils.pm lib/Mail/MtPolicyd/Plugin/Role/UserConfig.pm lib/Mail/MtPolicyd/Plugin/SMTPVerify.pm lib/Mail/MtPolicyd/Plugin/SPF.pm lib/Mail/MtPolicyd/Plugin/SaAwlAction.pm lib/Mail/MtPolicyd/Plugin/SaAwlLookup.pm lib/Mail/MtPolicyd/Plugin/ScoreAction.pm lib/Mail/MtPolicyd/Plugin/SetField.pm lib/Mail/MtPolicyd/Plugin/SqlList.pm lib/Mail/MtPolicyd/Plugin/SqlUserConfig.pm lib/Mail/MtPolicyd/Plugin/Stress.pm lib/Mail/MtPolicyd/PluginChain.pm lib/Mail/MtPolicyd/Profiler.pm lib/Mail/MtPolicyd/Profiler/Timer.pm lib/Mail/MtPolicyd/Request.pm lib/Mail/MtPolicyd/Result.pm lib/Mail/MtPolicyd/Role/Connection.pm lib/Mail/MtPolicyd/SessionCache.pm lib/Mail/MtPolicyd/SessionCache/Base.pm lib/Mail/MtPolicyd/SessionCache/Memcached.pm lib/Mail/MtPolicyd/SessionCache/None.pm lib/Mail/MtPolicyd/SessionCache/Redis.pm lib/Mail/MtPolicyd/VirtualHost.pm rpm/mtpolicyd.init-redhat rpm/mtpolicyd.spec t-data/minimal.conf t-data/plugin-postfixmap-postmap t-data/plugin-postfixmap-postmap.db t-data/spamhaus-rbls.conf t-data/vhost-by-policy-context.conf t/addresslist.t t/author-critic.t t/author-pod-syntax.t t/connection-ldap.t t/cron.t t/execute-cucumber-tests.t t/plugin-accounting-quota.t t/plugin-clearfields.t t/plugin-condition.t t/plugin-ctiprep.t t/plugin-dbl.t t/plugin-greylist.t t/plugin-ldapuserconfig.t t/plugin-postfixmap.t t/plugin-rbl.t t/plugin-regex-list.t t/plugin-role-configurablefields.t t/plugin-role-sqlutils.t t/plugin-sa-awl-action.t t/plugin-sa-awl-lookup.t t/plugin-smtpverify.t t/plugin-spf.t t/plugin-sqllist.t t/plugin-sqluserconfig.t t/profiler-timer.t t/profiler.t t/request.t t/scoring.t t/server-minimal.feature t/server-spamhaus-rbls.feature t/server-vhost-by-policy-context.feature t/session-cache.t t/step_definitions/00test-net-server_steps.pl t/step_definitions/client_steps.pl t/step_definitions/mtpolicyd_run_steps.pl t/use.t t/virtualhost.t META.json100644000000000000 3344213306510157 15052 0ustar00rootroot000000000000Mail-MtPolicyd-2.03{ "abstract" : "a modular policy daemon for postfix", "author" : [ "Markus Benning " ], "dynamic_config" : 0, "generated_by" : "Dist::Zilla version 6.012, CPAN::Meta::Converter version 2.150005", "license" : [ "gpl_2" ], "meta-spec" : { "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", "version" : 2 }, "name" : "Mail-MtPolicyd", "optional_features" : { "mysql" : { "description" : "mysql", "prereqs" : { "runtime" : { "recommends" : { "DBD::mysql" : "0" } } } } }, "prereqs" : { "configure" : { "requires" : { "ExtUtils::MakeMaker" : "0" } }, "develop" : { "requires" : { "Dist::Zilla::Plugin::ChangelogFromGit" : "0", "Dist::Zilla::Plugin::ChangelogFromGit::Debian" : "0", "Dist::Zilla::Plugin::FileFinder::ByName" : "0", "Dist::Zilla::Plugin::Git::NextVersion" : "0", "Dist::Zilla::Plugin::MetaJSON" : "0", "Dist::Zilla::Plugin::MetaProvides::Package" : "0", "Dist::Zilla::Plugin::MetaResources" : "0", "Dist::Zilla::Plugin::OurPkgVersion" : "0", "Dist::Zilla::Plugin::PodSyntaxTests" : "0", "Dist::Zilla::Plugin::PodWeaver" : "0", "Dist::Zilla::Plugin::Prereqs" : "0", "Dist::Zilla::Plugin::Prereqs::FromCPANfile" : "0", "Dist::Zilla::Plugin::PruneFiles" : "0", "Dist::Zilla::Plugin::Template::Tiny" : "0", "Dist::Zilla::Plugin::Test::Perl::Critic" : "0", "Dist::Zilla::Plugin::TravisYML" : "0", "Dist::Zilla::PluginBundle::Basic" : "0", "Dist::Zilla::PluginBundle::Git" : "0", "ExtUtils::MakeMaker" : "0", "Test::Perl::Critic" : "0", "Test::Pod" : "1.41" } }, "runtime" : { "requires" : { "BerkeleyDB" : "0", "BerkeleyDB::Hash" : "0", "Cache::Memcached" : "0", "Config::General" : "0", "DBI" : "0", "Data::Dumper" : "0", "File::Slurp" : "0", "Geo::IP" : "0", "Getopt::Long" : "0", "HTTP::Request::Common" : "0", "IO::Handle" : "0", "IO::Socket::INET" : "0", "IO::Socket::UNIX" : "0", "JSON" : "0", "LWP::UserAgent" : "0", "Mail::RBL" : "0", "Mail::SPF" : "0", "Moose" : "0", "Moose::Role" : "0", "Moose::Util::TypeConstraints" : "0", "MooseX::Getopt" : "0", "MooseX::Role::Parameterized" : "0", "MooseX::Singleton" : "0", "Net::DNS::Resolver" : "0", "Net::LDAP" : "0", "Net::LDAP::Util" : "0", "Net::SMTP::Verify" : "0", "Net::Server::PreFork" : "0", "NetAddr::IP" : "0", "Redis" : "0", "Storable" : "0", "Tie::IxHash" : "0", "Time::HiRes" : "0", "Time::Piece" : "0", "Time::Seconds" : "0", "namespace::autoclean" : "0", "perl" : "v5.8.5", "strict" : "0" } }, "test" : { "requires" : { "DBD::SQLite" : "0", "File::Find" : "0", "File::ReadBackwards" : "0", "File::Temp" : "0", "IO::File" : "0", "String::Random" : "0", "Template" : "0", "Test::BDD::Cucumber::Harness::TestBuilder" : "0", "Test::BDD::Cucumber::Loader" : "0", "Test::Deep" : "0", "Test::Exception" : "0", "Test::Mock::Net::Server::Mail" : "0", "Test::MockObject" : "0", "Test::More" : "0", "Test::Net::LDAP::Mock" : "0", "Test::Pod" : "0", "Test::RedisDB" : "0" } } }, "provides" : { "Mail::MtPolicyd" : { "file" : "lib/Mail/MtPolicyd.pm", "version" : "2.03" }, "Mail::MtPolicyd::AddressList" : { "file" : "lib/Mail/MtPolicyd/AddressList.pm", "version" : "2.03" }, "Mail::MtPolicyd::Client" : { "file" : "lib/Mail/MtPolicyd/Client.pm", "version" : "2.03" }, "Mail::MtPolicyd::Client::App" : { "file" : "lib/Mail/MtPolicyd/Client/App.pm", "version" : "2.03" }, "Mail::MtPolicyd::Client::Request" : { "file" : "lib/Mail/MtPolicyd/Client/Request.pm", "version" : "2.03" }, "Mail::MtPolicyd::Client::Response" : { "file" : "lib/Mail/MtPolicyd/Client/Response.pm", "version" : "2.03" }, "Mail::MtPolicyd::Connection" : { "file" : "lib/Mail/MtPolicyd/Connection.pm", "version" : "2.03" }, "Mail::MtPolicyd::Connection::Ldap" : { "file" : "lib/Mail/MtPolicyd/Connection/Ldap.pm", "version" : "2.03" }, "Mail::MtPolicyd::Connection::Memcached" : { "file" : "lib/Mail/MtPolicyd/Connection/Memcached.pm", "version" : "2.03" }, "Mail::MtPolicyd::Connection::Redis" : { "file" : "lib/Mail/MtPolicyd/Connection/Redis.pm", "version" : "2.03" }, "Mail::MtPolicyd::Connection::Sql" : { "file" : "lib/Mail/MtPolicyd/Connection/Sql.pm", "version" : "2.03" }, "Mail::MtPolicyd::ConnectionPool" : { "file" : "lib/Mail/MtPolicyd/ConnectionPool.pm", "version" : "2.03" }, "Mail::MtPolicyd::Plugin" : { "file" : "lib/Mail/MtPolicyd/Plugin.pm", "version" : "2.03" }, "Mail::MtPolicyd::Plugin::Accounting" : { "file" : "lib/Mail/MtPolicyd/Plugin/Accounting.pm", "version" : "2.03" }, "Mail::MtPolicyd::Plugin::Action" : { "file" : "lib/Mail/MtPolicyd/Plugin/Action.pm", "version" : "2.03" }, "Mail::MtPolicyd::Plugin::AddScoreHeader" : { "file" : "lib/Mail/MtPolicyd/Plugin/AddScoreHeader.pm", "version" : "2.03" }, "Mail::MtPolicyd::Plugin::ClearFields" : { "file" : "lib/Mail/MtPolicyd/Plugin/ClearFields.pm", "version" : "2.03" }, "Mail::MtPolicyd::Plugin::Condition" : { "file" : "lib/Mail/MtPolicyd/Plugin/Condition.pm", "version" : "2.03" }, "Mail::MtPolicyd::Plugin::CtIpRep" : { "file" : "lib/Mail/MtPolicyd/Plugin/CtIpRep.pm", "version" : "2.03" }, "Mail::MtPolicyd::Plugin::DBL" : { "file" : "lib/Mail/MtPolicyd/Plugin/DBL.pm", "version" : "2.03" }, "Mail::MtPolicyd::Plugin::Eval" : { "file" : "lib/Mail/MtPolicyd/Plugin/Eval.pm", "version" : "2.03" }, "Mail::MtPolicyd::Plugin::Fail2Ban" : { "file" : "lib/Mail/MtPolicyd/Plugin/Fail2Ban.pm", "version" : "2.03" }, "Mail::MtPolicyd::Plugin::GeoIPAction" : { "file" : "lib/Mail/MtPolicyd/Plugin/GeoIPAction.pm", "version" : "2.03" }, "Mail::MtPolicyd::Plugin::GeoIPLookup" : { "file" : "lib/Mail/MtPolicyd/Plugin/GeoIPLookup.pm", "version" : "2.03" }, "Mail::MtPolicyd::Plugin::Greylist" : { "file" : "lib/Mail/MtPolicyd/Plugin/Greylist.pm", "version" : "2.03" }, "Mail::MtPolicyd::Plugin::Greylist::AWL::Base" : { "file" : "lib/Mail/MtPolicyd/Plugin/Greylist/AWL/Base.pm", "version" : "2.03" }, "Mail::MtPolicyd::Plugin::Greylist::AWL::Redis" : { "file" : "lib/Mail/MtPolicyd/Plugin/Greylist/AWL/Redis.pm", "version" : "2.03" }, "Mail::MtPolicyd::Plugin::Greylist::AWL::Sql" : { "file" : "lib/Mail/MtPolicyd/Plugin/Greylist/AWL/Sql.pm", "version" : "2.03" }, "Mail::MtPolicyd::Plugin::Greylist::Ticket::Base" : { "file" : "lib/Mail/MtPolicyd/Plugin/Greylist/Ticket/Base.pm", "version" : "2.03" }, "Mail::MtPolicyd::Plugin::Greylist::Ticket::Memcached" : { "file" : "lib/Mail/MtPolicyd/Plugin/Greylist/Ticket/Memcached.pm", "version" : "2.03" }, "Mail::MtPolicyd::Plugin::Greylist::Ticket::Redis" : { "file" : "lib/Mail/MtPolicyd/Plugin/Greylist/Ticket/Redis.pm", "version" : "2.03" }, "Mail::MtPolicyd::Plugin::Honeypot" : { "file" : "lib/Mail/MtPolicyd/Plugin/Honeypot.pm", "version" : "2.03" }, "Mail::MtPolicyd::Plugin::LdapUserConfig" : { "file" : "lib/Mail/MtPolicyd/Plugin/LdapUserConfig.pm", "version" : "2.03" }, "Mail::MtPolicyd::Plugin::PostfixMap" : { "file" : "lib/Mail/MtPolicyd/Plugin/PostfixMap.pm", "version" : "2.03" }, "Mail::MtPolicyd::Plugin::Proxy" : { "file" : "lib/Mail/MtPolicyd/Plugin/Proxy.pm", "version" : "2.03" }, "Mail::MtPolicyd::Plugin::Quota" : { "file" : "lib/Mail/MtPolicyd/Plugin/Quota.pm", "version" : "2.03" }, "Mail::MtPolicyd::Plugin::RBL" : { "file" : "lib/Mail/MtPolicyd/Plugin/RBL.pm", "version" : "2.03" }, "Mail::MtPolicyd::Plugin::RBLAction" : { "file" : "lib/Mail/MtPolicyd/Plugin/RBLAction.pm", "version" : "2.03" }, "Mail::MtPolicyd::Plugin::RegexList" : { "file" : "lib/Mail/MtPolicyd/Plugin/RegexList.pm", "version" : "2.03" }, "Mail::MtPolicyd::Plugin::Result" : { "file" : "lib/Mail/MtPolicyd/Plugin/Result.pm", "version" : "2.03" }, "Mail::MtPolicyd::Plugin::Role::ConfigurableFields" : { "file" : "lib/Mail/MtPolicyd/Plugin/Role/ConfigurableFields.pm", "version" : "2.03" }, "Mail::MtPolicyd::Plugin::Role::PluginChain" : { "file" : "lib/Mail/MtPolicyd/Plugin/Role/PluginChain.pm", "version" : "2.03" }, "Mail::MtPolicyd::Plugin::Role::Scoring" : { "file" : "lib/Mail/MtPolicyd/Plugin/Role/Scoring.pm", "version" : "2.03" }, "Mail::MtPolicyd::Plugin::Role::SqlUtils" : { "file" : "lib/Mail/MtPolicyd/Plugin/Role/SqlUtils.pm", "version" : "2.03" }, "Mail::MtPolicyd::Plugin::Role::UserConfig" : { "file" : "lib/Mail/MtPolicyd/Plugin/Role/UserConfig.pm", "version" : "2.03" }, "Mail::MtPolicyd::Plugin::SMTPVerify" : { "file" : "lib/Mail/MtPolicyd/Plugin/SMTPVerify.pm", "version" : "2.03" }, "Mail::MtPolicyd::Plugin::SPF" : { "file" : "lib/Mail/MtPolicyd/Plugin/SPF.pm", "version" : "2.03" }, "Mail::MtPolicyd::Plugin::SaAwlAction" : { "file" : "lib/Mail/MtPolicyd/Plugin/SaAwlAction.pm", "version" : "2.03" }, "Mail::MtPolicyd::Plugin::SaAwlLookup" : { "file" : "lib/Mail/MtPolicyd/Plugin/SaAwlLookup.pm", "version" : "2.03" }, "Mail::MtPolicyd::Plugin::ScoreAction" : { "file" : "lib/Mail/MtPolicyd/Plugin/ScoreAction.pm", "version" : "2.03" }, "Mail::MtPolicyd::Plugin::SetField" : { "file" : "lib/Mail/MtPolicyd/Plugin/SetField.pm", "version" : "2.03" }, "Mail::MtPolicyd::Plugin::SqlList" : { "file" : "lib/Mail/MtPolicyd/Plugin/SqlList.pm", "version" : "2.03" }, "Mail::MtPolicyd::Plugin::SqlUserConfig" : { "file" : "lib/Mail/MtPolicyd/Plugin/SqlUserConfig.pm", "version" : "2.03" }, "Mail::MtPolicyd::Plugin::Stress" : { "file" : "lib/Mail/MtPolicyd/Plugin/Stress.pm", "version" : "2.03" }, "Mail::MtPolicyd::PluginChain" : { "file" : "lib/Mail/MtPolicyd/PluginChain.pm", "version" : "2.03" }, "Mail::MtPolicyd::Profiler" : { "file" : "lib/Mail/MtPolicyd/Profiler.pm", "version" : "2.03" }, "Mail::MtPolicyd::Profiler::Timer" : { "file" : "lib/Mail/MtPolicyd/Profiler/Timer.pm", "version" : "2.03" }, "Mail::MtPolicyd::Request" : { "file" : "lib/Mail/MtPolicyd/Request.pm", "version" : "2.03" }, "Mail::MtPolicyd::Result" : { "file" : "lib/Mail/MtPolicyd/Result.pm", "version" : "2.03" }, "Mail::MtPolicyd::Role::Connection" : { "file" : "lib/Mail/MtPolicyd/Role/Connection.pm", "version" : "2.03" }, "Mail::MtPolicyd::SessionCache" : { "file" : "lib/Mail/MtPolicyd/SessionCache.pm", "version" : "2.03" }, "Mail::MtPolicyd::SessionCache::Base" : { "file" : "lib/Mail/MtPolicyd/SessionCache/Base.pm", "version" : "2.03" }, "Mail::MtPolicyd::SessionCache::Memcached" : { "file" : "lib/Mail/MtPolicyd/SessionCache/Memcached.pm", "version" : "2.03" }, "Mail::MtPolicyd::SessionCache::None" : { "file" : "lib/Mail/MtPolicyd/SessionCache/None.pm", "version" : "2.03" }, "Mail::MtPolicyd::SessionCache::Redis" : { "file" : "lib/Mail/MtPolicyd/SessionCache/Redis.pm", "version" : "2.03" }, "Mail::MtPolicyd::VirtualHost" : { "file" : "lib/Mail/MtPolicyd/VirtualHost.pm", "version" : "2.03" } }, "release_status" : "stable", "resources" : { "bugtracker" : { "mailto" : "bug-mail-mtpolicyd@rt.cpan.org", "web" : "http://rt.cpan.org/NoAuth/Bugs.html?Dist=Mail-MtPolicyd" }, "repository" : { "type" : "git", "url" : "https://github.com/benningm/mtpolicyd", "web" : "https://github.com/benningm/mtpolicyd.git" } }, "version" : "2.03", "x_generated_by_perl" : "v5.24.0", "x_serialization_backend" : "Cpanel::JSON::XS version 4.02" } Dockerfile100644000000000000 114313306510157 15374 0ustar00rootroot000000000000Mail-MtPolicyd-2.03FROM perl:5.24.0 MAINTAINER Markus Benning ENV PERL_CARTON_PATH /usr/local/lib/carton COPY ./cpanfile /mtpolicyd/cpanfile WORKDIR /mtpolicyd RUN cpanm --notest Carton \ && carton install \ && rm -rf ~/.cpanm RUN addgroup --system mtpolicyd \ && adduser --system --home /mtpolicyd --no-create-home \ --disabled-password --ingroup mtpolicyd mtpolicyd COPY . /mtpolicyd COPY ./etc/docker.conf /etc/mtpolicyd/mtpolicyd.conf EXPOSE 12345 USER mtpolicyd CMD [ "carton", "exec", "perl", "-Mlib=./lib", "bin/mtpolicyd", "-f", "-l", "2", "-c", "/etc/mtpolicyd/mtpolicyd.conf" ] request.t100755000000000000 332013306510157 15524 0ustar00rootroot000000000000Mail-MtPolicyd-2.03/t#!perl use strict; use warnings; use Test::More tests => 9; use Test::MockObject; use Mail::MtPolicyd::Request; my $session = { '_instance' => 'abcd1234', 'user_policy' => 'kaffee-filter', }; my $server = Test::MockObject->new; $server->set_isa('Net::Server'); $server->set_true('log'); my $r = Mail::MtPolicyd::Request->new( attributes => { 'instance' => 'abcd1234', 'request' => 'smtpd_access_policy', 'protocol_state' => 'RCPT', 'protocol_name' => 'SMTP', 'helo_name' => 'some.domain.tld', 'queue_id' => '8045F2AB23', 'sender' => 'foo@bar.tld', 'recipient' => 'bar@foo.tld', 'recipient_count' => '0', 'client_address' => '1.2.3.4', 'client_name' => 'another.domain.tld', 'reverse_client_name' => 'another.domain.tld', }, session => $session, server => $server, ); isa_ok( $r, 'Mail::MtPolicyd::Request'); is($r->type, 'smtpd_access_policy', 'check ->type'); is($r->attr('queue_id'), '8045F2AB23', 'check ->attr'); can_ok($r, 'log', 'new_from_fh'); # retrieve variables with different supported syntax cmp_ok( $r->get('request:queue_id'), 'eq', '8045F2AB23', 'must be able to retrieve request request:queue_id'); cmp_ok( $r->get('r:queue_id'), 'eq', '8045F2AB23', 'must be able to retrieve request r:queue_id'); cmp_ok( $r->get('queue_id'), 'eq', '8045F2AB23', 'must be able to retrieve request queue_id'); cmp_ok( $r->get('session:user_policy'), 'eq', 'kaffee-filter', 'session variable session:user_policy'); cmp_ok( $r->get('s:user_policy'), 'eq', 'kaffee-filter', 'session variable s:user_policy'); scoring.t100755000000000000 536013306510157 15506 0ustar00rootroot000000000000Mail-MtPolicyd-2.03/t#!perl package Mail::MtPolicyd::Plugin::Test::Scoring; use Moose; extends 'Mail::MtPolicyd::Plugin'; with 'Mail::MtPolicyd::Plugin::Role::Scoring'; package main; use strict; use warnings; use Test::More tests => 21; use Test::Exception; use Test::MockObject; use Mail::MtPolicyd::Request; import Mail::MtPolicyd::Plugin::Test::Scoring; use Mail::MtPolicyd::Plugin::ScoreAction; use Mail::MtPolicyd::Plugin::AddScoreHeader; my $plugin = Mail::MtPolicyd::Plugin::Test::Scoring->new( name => 'score-test' ); isa_ok($plugin, 'Mail::MtPolicyd::Plugin::Test::Scoring'); my $session = { '_instance' => 'abcd1234', }; # fake a Server object my $server = Test::MockObject->new; $server->set_isa('Net::Server'); $server->mock( 'log', sub { my ( $self, $level, $message ) = @_; print '# LOG('.$level.'): '.$message."\n" } ); my $r = Mail::MtPolicyd::Request->new( attributes => { 'instance' => 'abcd1234', 'client_address' => '127.0.0.1', }, session => $session, server => $server, ); isa_ok( $r, 'Mail::MtPolicyd::Request'); # add some scores with our dummy scoring plugin lives_ok { $plugin->add_score( $r, 'ZUMSEL' => 5 ); } 'call ->add_score()'; is( $r->session->{'score'}, 5, 'score must be 5'); is( $r->session->{'score_detail'}, 'ZUMSEL=5', 'check score_detail'); lives_ok { $plugin->add_score( $r, 'BLA' => 2.5 ); } 'call ->add_score()'; is( $r->session->{'score'}, 7.5, 'score must be 7.5'); is( $r->session->{'score_detail'}, 'ZUMSEL=5, BLA=2.5', 'check score_detail'); # Test ScoreAction Plugin my $action = Mail::MtPolicyd::Plugin::ScoreAction->new( name => 'score-action', threshold => 10, action => 'reject sender ip %IP% is blocked (score=%SCORE%%SCORE_DETAIL%)', ); isa_ok($action, 'Mail::MtPolicyd::Plugin::ScoreAction'); my $result; lives_ok { $result = $action->run($r); } 'execute request'; is( $result, undef, 'should not match' ); lives_ok { $plugin->add_score( $r, 'BLUB' => 2.5 ); } 'call ->add_score()'; is( $r->session->{'score'}, 10, 'score must be 10'); is( $r->session->{'score_detail'}, 'ZUMSEL=5, BLA=2.5, BLUB=2.5', 'check score_detail'); lives_ok { $result = $action->run($r); } 'execute request'; isa_ok( $result, 'Mail::MtPolicyd::Plugin::Result', 'now it should match' ); is($result->action, 'reject sender ip 127.0.0.1 is blocked (score=10, ZUMSEL=5, BLA=2.5, BLUB=2.5)', 'action must be reject'); # Test AddScoreHeader plugin my $header = Mail::MtPolicyd::Plugin::AddScoreHeader->new( name => 'score-header' ); isa_ok($header, 'Mail::MtPolicyd::Plugin::AddScoreHeader'); lives_ok { $result = $header->run($r); } 'execute request'; isa_ok( $result, 'Mail::MtPolicyd::Plugin::Result', 'should return a Result' ); is($result->action, 'PREPEND X-MtScore: YES score=10 [ZUMSEL=5, BLA=2.5, BLUB=2.5]', 'should prepend a detailed header'); Makefile.PL100644000000000000 736213306510157 15365 0ustar00rootroot000000000000Mail-MtPolicyd-2.03# This file was automatically generated by Dist::Zilla::Plugin::MakeMaker v6.012. use strict; use warnings; use 5.008005; use ExtUtils::MakeMaker; my %WriteMakefileArgs = ( "ABSTRACT" => "a modular policy daemon for postfix", "AUTHOR" => "Markus Benning ", "CONFIGURE_REQUIRES" => { "ExtUtils::MakeMaker" => 0 }, "DISTNAME" => "Mail-MtPolicyd", "EXE_FILES" => [ "bin/mtpolicyd", "bin/policyd-client" ], "LICENSE" => "gpl", "MIN_PERL_VERSION" => "5.008005", "NAME" => "Mail::MtPolicyd", "PREREQ_PM" => { "BerkeleyDB" => 0, "BerkeleyDB::Hash" => 0, "Cache::Memcached" => 0, "Config::General" => 0, "DBI" => 0, "Data::Dumper" => 0, "File::Slurp" => 0, "Geo::IP" => 0, "Getopt::Long" => 0, "HTTP::Request::Common" => 0, "IO::Handle" => 0, "IO::Socket::INET" => 0, "IO::Socket::UNIX" => 0, "JSON" => 0, "LWP::UserAgent" => 0, "Mail::RBL" => 0, "Mail::SPF" => 0, "Moose" => 0, "Moose::Role" => 0, "Moose::Util::TypeConstraints" => 0, "MooseX::Getopt" => 0, "MooseX::Role::Parameterized" => 0, "MooseX::Singleton" => 0, "Net::DNS::Resolver" => 0, "Net::LDAP" => 0, "Net::LDAP::Util" => 0, "Net::SMTP::Verify" => 0, "Net::Server::PreFork" => 0, "NetAddr::IP" => 0, "Redis" => 0, "Storable" => 0, "Tie::IxHash" => 0, "Time::HiRes" => 0, "Time::Piece" => 0, "Time::Seconds" => 0, "namespace::autoclean" => 0, "strict" => 0 }, "TEST_REQUIRES" => { "DBD::SQLite" => 0, "File::Find" => 0, "File::ReadBackwards" => 0, "File::Temp" => 0, "IO::File" => 0, "String::Random" => 0, "Template" => 0, "Test::BDD::Cucumber::Harness::TestBuilder" => 0, "Test::BDD::Cucumber::Loader" => 0, "Test::Deep" => 0, "Test::Exception" => 0, "Test::Mock::Net::Server::Mail" => 0, "Test::MockObject" => 0, "Test::More" => 0, "Test::Net::LDAP::Mock" => 0, "Test::Pod" => 0, "Test::RedisDB" => 0 }, "VERSION" => "2.03", "test" => { "TESTS" => "t/*.t" } ); my %FallbackPrereqs = ( "BerkeleyDB" => 0, "BerkeleyDB::Hash" => 0, "Cache::Memcached" => 0, "Config::General" => 0, "DBD::SQLite" => 0, "DBI" => 0, "Data::Dumper" => 0, "File::Find" => 0, "File::ReadBackwards" => 0, "File::Slurp" => 0, "File::Temp" => 0, "Geo::IP" => 0, "Getopt::Long" => 0, "HTTP::Request::Common" => 0, "IO::File" => 0, "IO::Handle" => 0, "IO::Socket::INET" => 0, "IO::Socket::UNIX" => 0, "JSON" => 0, "LWP::UserAgent" => 0, "Mail::RBL" => 0, "Mail::SPF" => 0, "Moose" => 0, "Moose::Role" => 0, "Moose::Util::TypeConstraints" => 0, "MooseX::Getopt" => 0, "MooseX::Role::Parameterized" => 0, "MooseX::Singleton" => 0, "Net::DNS::Resolver" => 0, "Net::LDAP" => 0, "Net::LDAP::Util" => 0, "Net::SMTP::Verify" => 0, "Net::Server::PreFork" => 0, "NetAddr::IP" => 0, "Redis" => 0, "Storable" => 0, "String::Random" => 0, "Template" => 0, "Test::BDD::Cucumber::Harness::TestBuilder" => 0, "Test::BDD::Cucumber::Loader" => 0, "Test::Deep" => 0, "Test::Exception" => 0, "Test::Mock::Net::Server::Mail" => 0, "Test::MockObject" => 0, "Test::More" => 0, "Test::Net::LDAP::Mock" => 0, "Test::Pod" => 0, "Test::RedisDB" => 0, "Tie::IxHash" => 0, "Time::HiRes" => 0, "Time::Piece" => 0, "Time::Seconds" => 0, "namespace::autoclean" => 0, "strict" => 0 ); unless ( eval { ExtUtils::MakeMaker->VERSION(6.63_03) } ) { delete $WriteMakefileArgs{TEST_REQUIRES}; delete $WriteMakefileArgs{BUILD_REQUIRES}; $WriteMakefileArgs{PREREQ_PM} = \%FallbackPrereqs; } delete $WriteMakefileArgs{CONFIGURE_REQUIRES} unless eval { ExtUtils::MakeMaker->VERSION(6.52) }; WriteMakefile(%WriteMakefileArgs); profiler.t100644000000000000 151113306510157 15653 0ustar00rootroot000000000000Mail-MtPolicyd-2.03/t#!perl use strict; use warnings; use Test::More tests => 5; use_ok('Mail::MtPolicyd::Profiler'); my $p = Mail::MtPolicyd::Profiler->new; isa_ok( $p, 'Mail::MtPolicyd::Profiler', 'test constructor'); $p->reset; isa_ok( $p->root, 'Mail::MtPolicyd::Profiler::Timer', 'root timer must be set'); isa_ok( $p->current, 'Mail::MtPolicyd::Profiler::Timer', 'current timer must be set'); $p->tick('start parsing request'); $p->tick('finished parsing request'); $p->new_timer('start processing plugin chain'); $p->new_timer('plugin 1'); $p->tick('start dns lookup'); $p->tick('finished dns lookup'); $p->stop_current_timer; $p->new_timer('plugin 2'); $p->tick('nothing todo'); $p->stop_current_timer; $p->stop_current_timer; $p->stop_current_timer; my $string = $p->to_string; ok($string =~ /start dns lookup/, 'must contain dns lookup'); bin000755000000000000 013306510157 14013 5ustar00rootroot000000000000Mail-MtPolicyd-2.03mtpolicyd100755000000000000 2343613306510157 16135 0ustar00rootroot000000000000Mail-MtPolicyd-2.03/bin#!/usr/bin/perl use strict; use warnings; our $VERSION = '2.03'; # VERSION # ABSTRACT: the mtpolicyd executable # PODNAME: mtpolicyd use Mail::MtPolicyd; Mail::MtPolicyd->run(); __END__ =pod =encoding UTF-8 =head1 NAME mtpolicyd - the mtpolicyd executable =head1 VERSION version 2.03 =head1 DESCRIPTION mtpolicyd is a policy daemon for postfix access delegation. It can be configured to accept connections on several ports from a postfix mta. For each port a VirtualHost can be configured and for each VirtualHost several Plugins can be configured. =head1 NAME mtpolicyd - a modular policy daemon for postfix =head1 EXAMPLE In postfix main.cf: smtpd_recipient_restrictions = check_policy_service inet:127.0.0.1:12345 In mtpolicyd.conf: # listen on port 12345 (multiple ports can be separated by ',') port="127.0.0.1:12345" # defined host for this port name=example_vhost module="RBL" domain="sbl.spamhaus.org" mode=reject This check will execute a simple RBL lookup against dbl.spamhaus.org. =head1 COMMANDLINE OPTIONS mtpolicyd [-h|--help] [-c|--config=] [-f|--foreground] [-l|--loglevel=] [-d|--dump_vhosts] =over =item -h --help Show available command line options. =item -c --config= (default: /etc/mtpolicyd/mtpolicyd.conf) Specifiy the path to the configuration file. =item -f --foreground Do not fork to background and log to stdout. =item -l --loglevel= Overwrite the log level specified in the configuration with the specified level. =item -d --dump_vhosts Parse VirtualHosts configuration, print it to stdout and exit. =back =head1 CONFIGURATION FILE The configuration file is implementend with L which allows apache style configuration files. mtpolicyd accepts global configuration parameters in the style: key=value Comments begin with '#'. VirtualHosts must be configured with VirtualHost sections: > name= Each VirtualHost should contain at least on Plugin. > name= > module = "" # plugin options key=value For individual plugin configuration options see the man page of the plugin: Mail::MtPolicyd::Plugin:: =head2 GLOBAL CONFIGURATION OPTIONS =over =item user user id to run as =item group group id to run as =item pid_file location of the pid file =item log_level Verbosity of logging: 0=>'err', 1=>'warning', 2=>'notice', 3=>'info', 4=>'debug' =item host ip address to bind to. =item port comma separated list of ports to listen on. =item min_servers (default: 4) The minimum number of client processes to start. =item min_spare_servers (default: 4) The minimum number of client processes that should hanging around idle and wait for new connections. If the number of free processes is below this threshold mtpolicyd will start to create new child processes. =item max_spare_servers (default: 12) The maximum number of idle processes. If the number of idle processes is over this threshold mtpolicyd will start to shutdown child processes. =item max_servers (default: 25) The absolute maximum number of child processes to start. =item max_requests (default: 1000) =item max_keepalive (default: 0) Number of requests after that mtpolicyd closes the connection or no limit if set to zero. Should be the same value as smtpd_policy_service_reuse_count_limit (postfix >2.12) in postfix/smtpd configuration. =item vhost_by_policy_context (default: 0) Select VirtualHost by 'policy_context' request field. The policy_context will be matched against the 'name' field of the VirtualHost. For example in postfix main.cf use advanced syntax: check_policy_service { inet:localhost:12345, policy_context=reputation } ... check_policy_service { inet:localhost:12345, policy_context=accounting } In mtpolicyd.conf: port="127.0.0.1:12345" # only 1 port vhost_by_policy_context=1 name=reputation ... plugins ... name=accounting ... plugins ... The policy_context feature will be available in postfix 3.1 and later. If you just need small differentiations consider using the L plugin to match against plugin_context field. =item request_timeout Maximum total time for one request. =back =head1 CONFIGURE CONNECTIONS mtpolicyd has a global per process connection pool. Connections could be registered within the connection pool using a block within the configuration. You must at least specify the name of the connection and the module for the connection type. module = "[connection type]" # ... addditional parameters Connection modules may require additional parameters. Currently supported connection modules: =over =item Sql Perl DBI based connections for SQL databases. L =item Memcached Connection to a memcached server/cluster. L =item Ldap Connection to an LDAP directory server. L =back =head1 SESSION MANAGEMENT mtpolicyd implements session managemend to cache data across different checks for requests with the same instance id. mtpolicy is able to generate a session for each mail passed to it and store it within the session cache. The attached session information will be available to all following plugins across child processes, virtual hosts and ports. Plugins will use this session information to cache lookup etc. across multiple requests for the same mail. Postfix will send a query for each recipient and for each configured check_policy_service call. To enable the SessionCache specify a block within your configuration: module = "Memcached" expire = "300" lock_wait=50 lock_max_retry=50 lock_timeout=10 The example requires that a connection of type "Memcached" and the name "memcached" is configured within the connection pool. For details read L. As of version 2.00 it is possible to implement different session caches. Currently there are 2 session cache modules: =over =item L =item L =back =head1 PROCESSING OF REQUEST The policy daemon will process all plugins in the order they appear in the configuration file. It will stop as soon as a plugin returns an action and will return this action to the MTA. =head1 SCORING Most plugins can be configured to not return an action if the performed check matched. For example the RBL module could be set to passive mode and instead a score could be applied to the request: module = "RBL" mode = "passive" domain="zen.spamhaus.org" score=5 Check the documentation of the plugin for certain score/mode parameters. Plugin may provide more than one mode/score parameters if the do several checks. Now if you configure more than one RBL check the score will add up. Later an action can be taken based on the score. The ScoreAction plugin will return an action based on the score and the AddScoreHeader plugin will prepend the score as a header to the mail: module = "ScoreAction" threshold = 15 action = "reject sender ip %IP% is blocked (score=%SCORE%%SCORE_DETAIL%)" module = "AddScoreHeader" spam_score=5 =head1 UPGRADING =head2 FROM 1.x to 2.x With mtpolicyd 2.x configuration of connections and session cache has been changed. =head3 Database Connections In mtpolicyd 2.00 the connections defined globaly in the configuration file have been replaced by a dynamic connection pool. The global options db_* ldap_* and memcached_* have been removed. Instead connections are registred within a connection pool. You can define them using blocks: module = "" # parameter = "value" # ... In mtpolicyd 1.x: db_dsn=DBI:mysql:mtpolicyd db_user=mtpolicyd db_password=secret In mtpolicyd 2.x: dsn = "DBI:mysql:mtpolicyd" user = "mtpolicyd" password = "secret" All SQL modules will by default use the connection registred as "db". See modules in Mail::MtPolicyd::Connection::* for available connection adapters. =head3 Session Cache Starting with mtpolicyd 2.x it is possible to use other session caches then memcached. The global session_* parameters have been removed. Instead the session cache is defined by a block: module = "" # parameter = "value" # ... A memcached session cache in mtpolicyd v1.x: memcached_servers="127.0.0.1:11211" session_lock_wait=50 session_lock_max_retry=50 session_lock_timeout=10 In mtpolicyd 2.x: servers = "127.0.0.1:11211" module = "Memcached" # defaults to connection "memcached" # memcached = "memcached" lock_wait = "50" lock_max_retry = "50" lock_timeout = "10" If no is defined it will default to the dummy session cache module "None". See modules in Mail::MtPolicyd::SessionCache::* for available session cache modules. =head1 AUTHOR Markus Benning =head1 COPYRIGHT AND LICENSE This software is Copyright (c) 2014 by Markus Benning . This is free software, licensed under: The GNU General Public License, Version 2, June 1991 =cut plugin-dbl.t100755000000000000 501313306510157 16072 0ustar00rootroot000000000000Mail-MtPolicyd-2.03/t#!perl use strict; use warnings; use Test::More tests => 17; use Test::Exception; use Test::MockObject; use Mail::MtPolicyd::Request; use Mail::MtPolicyd::Plugin::DBL; my $blocked = 'dbltest.com'; my $p = Mail::MtPolicyd::Plugin::DBL->new( name => 'sh-dbl', enabled => 'on', uc_enabled => "spamhaus", domain => "dbl.spamhaus.org", helo_name_score => 1, helo_name_mode => 'passive', sender_score => 5, sender_mode => 'reject', reverse_client_name_score => 2.5, reverse_client_name_mode => 'reject', ); isa_ok($p, 'Mail::MtPolicyd::Plugin::DBL'); my $session = { '_instance' => 'abcd1234', }; # fake a Server object my $server = Test::MockObject->new; $server->set_isa('Net::Server'); $server->mock( 'log', sub { my ( $self, $level, $message ) = @_; print '# LOG('.$level.'): '.$message."\n" } ); my $r = Mail::MtPolicyd::Request->new( attributes => { 'instance' => 'abcd1234', 'helo_name' => 'saftpresse.bofh-noc.de', 'reverse_client_name' => 'saftpresse.bofh-noc.de', 'sender' => 'ich@markusbenning.de', }, session => $session, server => $server, use_caching => 0, ); isa_ok( $r, 'Mail::MtPolicyd::Request'); my $result; lives_ok { $result = $p->run($r); } 'execute request'; is( $result, undef, 'should not match' ); # in hope that this ip stays "bad" $r->attributes->{'reverse_client_name'} = "23.19.76.2.$blocked"; lives_ok { $result = $p->run($r); } 'execute request'; isa_ok( $result, 'Mail::MtPolicyd::Plugin::Result', 'should match' ); like( $result->action, qr/reject reverse_client_name rejected \(23.19.76.2.$blocked, https:\/\/www.spamhaus.org\/query\/domain\/$blocked\)/, 'should return a blocked header' ); is($session->{'score'}, 2.5, 'score should be 2.5'); $r->attributes->{'sender'} = "bsnobfvqzz\@$blocked"; lives_ok { $result = $p->run($r); } 'execute request'; isa_ok( $result, 'Mail::MtPolicyd::Plugin::Result', 'should match' ); like( $result->action, qr/reject sender rejected \($blocked, https:\/\/www.spamhaus.org\/query\/domain\/$blocked\)/, 'should return a reject' ); is($session->{'score'}, 7.5, 'score should be 7.5'); $p->reverse_client_name_mode('passive'); $p->sender_mode('passive'); $r->attributes->{'helo_name'} = "23.81.170.170.$blocked"; lives_ok { $result = $p->run($r); } 'execute request'; is( $result, undef, 'should take no action' ); is($session->{'score'}, 16, 'score should be 16'); # test with per-user/session setting $p->uc_enabled('spamhaus'); $session->{'spamhaus'} = 'off'; lives_ok { $result = $p->run($r); } 'execute request'; is( $result, undef, 'should do nothing' ); plugin-rbl.t100755000000000000 565213306510157 16121 0ustar00rootroot000000000000Mail-MtPolicyd-2.03/t#!perl use strict; use warnings; use Test::More tests => 25; use Test::Exception; use Test::MockObject; use Mail::MtPolicyd::Request; use Mail::MtPolicyd::Plugin::RBL; my $p = Mail::MtPolicyd::Plugin::RBL->new( name => 'sh-rbl', enabled => 'on', uc_enabled => "spamhaus", mode => 'reject', domain => "zen.spamhaus.org", score => 5, ); isa_ok($p, 'Mail::MtPolicyd::Plugin::RBL'); my $session = { '_instance' => 'abcd1234', }; # fake a Server object my $server = Test::MockObject->new; $server->set_isa('Net::Server'); $server->mock( 'log', sub { my ( $self, $level, $message ) = @_; print '# LOG('.$level.'): '.$message."\n" } ); my $r = Mail::MtPolicyd::Request->new( attributes => { 'instance' => 'abcd1234', 'client_address' => '127.0.0.1', }, session => $session, server => $server, use_caching => 0, ); isa_ok( $r, 'Mail::MtPolicyd::Request'); my $result; lives_ok { $result = $p->run($r); } 'execute request'; is( $result, undef, 'should not match' ); # XBL test address $r->attributes->{'client_address'} = '127.0.0.4'; lives_ok { $result = $p->run($r); } 'execute request'; isa_ok( $result, 'Mail::MtPolicyd::Plugin::Result', 'should match' ); like( $result->action, qr/reject delivery from 127.0.0.4 rejected \(https:\/\/www.spamhaus.org\/query\/ip\/127.0.0.4\)/, 'should return a reject action' ); is($session->{'score'}, 5, 'score should be 5'); # test with per-user/session setting $p->uc_enabled('spamhaus'); $session->{'spamhaus'} = 'off'; lives_ok { $result = $p->run($r); } 'execute request'; is( $result, undef, 'should do nothing' ); $session->{'spamhaus'} = 'on'; lives_ok { $result = $p->run($r); } 'execute request'; isa_ok( $result, 'Mail::MtPolicyd::Plugin::Result', 'should match' ); like( $result->action, qr/reject delivery from 127.0.0.4 rejected \(https:\/\/www.spamhaus.org\/query\/ip\/127.0.0.4\)/, 'should return a reject action' ); is($session->{'score'}, 10, 'score should be 10'); $p->mode('passive'); $r->use_caching(1); lives_ok { $result = $p->run($r); } 'execute request'; is( $result, undef, 'should not return an action' ); is($session->{'score'}, 15, 'score should be 15'); # TEST RBLAction use Mail::MtPolicyd::Plugin::RBLAction; $p = Mail::MtPolicyd::Plugin::RBLAction->new( name => 'sh-rbl-sbl', result_from => 'sh-rbl', mode => 'reject', re_match => '^127\.0\.0\.[23]$', # on SBL? score => 5, ); isa_ok($p, 'Mail::MtPolicyd::Plugin::RBLAction'); lives_ok { $result = $p->run($r); } 'execute request'; is( $result, undef, 'should do nothing' ); is($session->{'score'}, 15, 'score should be 15'); $p->re_match('^127\.0\.0\.[4-7]$'); # on XBL? $p->name('sh-rbl-xbl'); lives_ok { $result = $p->run($r); } 'execute request'; isa_ok( $result, 'Mail::MtPolicyd::Plugin::Result', 'should match' ); like( $result->action, qr/reject delivery from 127.0.0.4 rejected \(https:\/\/www.spamhaus.org\/query\/ip\/127.0.0.4\)/, 'should return a reject action' ); is($session->{'score'}, 20, 'score should be 20'); plugin-spf.t100755000000000000 270413306510157 16125 0ustar00rootroot000000000000Mail-MtPolicyd-2.03/t#!perl use strict; use warnings; use Test::More tests => 9; use Test::Exception; use Test::MockObject; use Mail::MtPolicyd::Request; use Mail::MtPolicyd::Plugin::SPF; my $p = Mail::MtPolicyd::Plugin::SPF->new( name => 'spf', enabled => 'on', pass_score => -10, pass_action => 'passive', fail_score => 5, fail_action => 'reject', ); isa_ok($p, 'Mail::MtPolicyd::Plugin::SPF'); my $session = { '_instance' => 'abcd1234', }; # fake a Server object my $server = Test::MockObject->new; $server->set_isa('Net::Server'); $server->mock( 'log', sub { my ( $self, $level, $message ) = @_; print '# LOG('.$level.'): '.$message."\n" } ); my $r = Mail::MtPolicyd::Request->new( attributes => { 'instance' => 'abcd1234', 'helo_name' => 'affenschaukel.bofh-noc.de', 'client_address' => '78.47.220.83', 'sender' => 'ich@markusbenning.de', }, session => $session, server => $server, use_caching => 0, ); isa_ok( $r, 'Mail::MtPolicyd::Request'); my $result; lives_ok { $result = $p->run($r); } 'execute request'; is( $result, undef, 'should not match' ); is($session->{'score'}, -10, 'score should be -10'); $r->attributes->{'client_address'} = '192.168.2.1'; lives_ok { $result = $p->run($r); } 'execute request'; isa_ok( $result, 'Mail::MtPolicyd::Plugin::Result' ); like( $result->action, qr/reject SPF validation failed: markusbenning.de: Sender is not authorized by default to use/, 'check action' ); is($session->{'score'}, -5, 'score should be -5'); etc000755000000000000 013306510157 14016 5ustar00rootroot000000000000Mail-MtPolicyd-2.03docker.conf100644000000000000 1111413306510157 16312 0ustar00rootroot000000000000Mail-MtPolicyd-2.03/etc# -*- apache -*- # # Configuration for the mailteam policy daemon user=mtpolicyd group=mtpolicyd #pid_file="/var/run/mtpolicyd/mtpolicyd.pid" #chroot=/var/run/mtpolicyd # 0=>'err', 1=>'warning', 2=>'notice', 3=>'info', 4=>'debug' (default: 2) log_level=2 host=127.0.0.1 port="127.0.0.1:12345" min_servers=4 min_spare_servers=4 max_spare_servers=12 max_servers=50 max_requests=1000 #keepalive_timeout=60 keepalive_timeout=0 # should be the same value as smtpd_policy_service_reuse_count_limit (postfix >2.12) max_keepalive=0 #max_keepalive=100 # timeout for processing of one request in seconds request_timeout=20 # # module = "Ldap" # host = "localhost" # module = "Memcached" servers = "memcached:11211" # namespace = "mt-" module = "Sql" dsn = "dbi:SQLite:dbname=/tmp/mtpolicyd.sqlite" module = "Memcached" #memcached = "memcached" # expire session cache entries expire = "300" # wait timeout will be increased each time 50,100,150,... (usec) lock_wait=50 # abort after n retries lock_max_retry=50 # session lock times out after (sec) lock_timeout=10 name="reputation" # we only check for a ticket here # avoid running thru all checks for early retries module = "Greylist" score = -5 mode = "passive" create_ticket = 0 query_autowl = 0 module = "SPF" pass_mode = "passive" pass_score = -10 fail_mode = "reject" # stop #fail_score = 5 # you may want to use some unused recipient addresses as honeypot # make sure they are really unused # # module = "Honeypot" # recipients_re = "^(chung|ogc|wore|aio|duy)@(yourdomain1|yourdomain2)\.de$" # module = "RBL" mode = "accept" # will stop here domain="list.dnswl.org" module = "GeoIPLookup" # apt-get install geoip-database database = "/usr/share/GeoIP/GeoIP.dat" module = "GeoIPAction" result_from = "geoip" country_codes = "DE,AT,CH,FR,IT" mode = passive score = -1 module = "GeoIPAction" result_from = "geoip" country_codes = "RU,UA,CN,IN" mode = passive score = 5 module = "RBL" mode = "passive" domain="zen.spamhaus.org" module = "RBLAction" result_from = "spamhaus-rbl" mode = "passive" re_match = "^127\.0\.0\.[23]$" score = 5 module = "RBLAction" result_from = "spamhaus-rbl" mode = "passive" re_match = "^127\.0\.0\.[4-7]$" score = 5 module = "RBLAction" result_from = "spamhaus-rbl" mode = "passive" re_match = "^127\.0\.0\.1[01]$" score = 3 module = "DBL" domain="dbl.spamhaus.org" helo_name_mode=passive helo_name_score=1 sender_mode=passive sender_score=5 reverse_client_name_mode=passive reverse_client_name_score=2.5 module = "RBL" mode = "passive" domain="dnsbl.sorbs.net" score = 5 module = "RBL" mode = "passive" domain="ix.dnsbl.manitu.net" score = 5 module = "RBL" mode = "passive" domain="bl.spamcop.net" score = 5 module = "RBL" mode = "passive" domain="drone.abuse.ch" score = 3 module = "RBL" mode = "passive" domain="db.wpbl.info" score = 3 module = "RBL" mode = "passive" domain="bb.barracudacentral.org" score = 3 # # block ip address with iptables filter # # module = "ScoreAction" # threshold = 15 # # module = "Fail2Ban" # socket = "/var/run/fail2ban/fail2ban.sock" # jail = "postfix" # # # score >= 15 will be rejected module = "ScoreAction" threshold = 15 action = "reject sender ip %IP% is blocked (score=%SCORE%%SCORE_DETAIL%)" # score >= 5 gets greylisting applied module = "ScoreAction" threshold = 5 module = "Greylist" score = -5 mode = "passive" # activating the autowl will require a SQL database use_autowl = 1 # add an header to everything left module = "AddScoreHeader" spam_score=5 addresslist.t100755000000000000 217513306510157 16364 0ustar00rootroot000000000000Mail-MtPolicyd-2.03/t#!perl use strict; use warnings; use Test::More tests => 12; use Test::MockObject; use Mail::MtPolicyd::AddressList; my $list = Mail::MtPolicyd::AddressList->new; isa_ok( $list, 'Mail::MtPolicyd::AddressList'); ok( $list->is_empty, 'list must be empty' ); $list->add_localhost; ok( ! $list->is_empty, 'list must contain entries' ); cmp_ok( $list->count, '==', 3, 'list must 3 entries' ); ok( $list->match_string('127.0.0.1'), 'list must match 127.0.0.1' ); ok( $list->match_string('::1'), 'list must match ::1' ); cmp_ok( $list->as_string, 'eq', '127.0.0.0/8,0:0:0:0:0:FFFF:7F00:0/104,0:0:0:0:0:0:0:1/128', 'check as_string output' ); ok( ! $list->match_string('123.45.67.89'), 'must not match a unknown IPv4!' ); ok( ! $list->match_string('2a01:4f8:d12:242::2'), 'must not match a unknown IPv6!' ); $list->add_string('78.47.220.83'); $list->add_string('2a01:4f8:d12:242::2,fe80::21c:14ff:fe01:c8 103.41.124.100'); cmp_ok( $list->count, '==', 7, 'list must contain 7 entries' ); ok( $list->match_string('78.47.220.83'), 'must match IP 78.47.220.83' ); ok( $list->match_string('103.41.124.100'), 'must match IP 103.41.124.100' ); virtualhost.t100755000000000000 312013306510157 16416 0ustar00rootroot000000000000Mail-MtPolicyd-2.03/t#!perl use strict; use warnings; use Test::More tests => 5; use Test::Exception; use Test::MockObject; use Mail::MtPolicyd::Request; use Mail::MtPolicyd::VirtualHost; use Mail::MtPolicyd::PluginChain; use Mail::MtPolicyd::Plugin::Action; my $vhost = Mail::MtPolicyd::VirtualHost->new( port => 12345, name => "test-host", chain => Mail::MtPolicyd::PluginChain->new( vhost_name => 'test-host', plugins => [ Mail::MtPolicyd::Plugin::Action->new( name => 'test-action-1', action => 'reject', ), # check order Mail::MtPolicyd::Plugin::Action->new( name => 'test-action-2', action => 'should not happen', ), ], ), ); isa_ok($vhost, 'Mail::MtPolicyd::VirtualHost'); my $session = { '_instance' => 'abcd1234' }; # fake a Server object my $server = Test::MockObject->new; $server->set_isa('Net::Server'); $server->set_true('log'); my $r = Mail::MtPolicyd::Request->new( attributes => { 'instance' => 'abcd1234', 'request' => 'smtpd_access_policy', 'protocol_state' => 'RCPT', 'protocol_name' => 'SMTP', 'helo_name' => 'some.domain.tld', 'queue_id' => '8045F2AB23', 'sender' => 'foo@bar.tld', 'recipient' => 'bar@foo.tld', 'recipient_count' => '0', 'client_address' => '1.2.3.4', 'client_name' => 'another.domain.tld', 'reverse_client_name' => 'another.domain.tld', }, session => $session, server => $server, ); isa_ok( $r, 'Mail::MtPolicyd::Request'); my $result; lives_ok { $result = $vhost->run($r); } 'execute request'; isa_ok( $result, 'Mail::MtPolicyd::Result' ); is( $result->as_policyd_response, "action=reject\n\n", 'check result' ); session-cache.t100644000000000000 635213306510157 16565 0ustar00rootroot000000000000Mail-MtPolicyd-2.03/t#!perl use strict; use warnings; use Test::More tests => 5; use Test::MockObject; use Mail::MtPolicyd::ConnectionPool; use Test::RedisDB; use Test::Exception; use String::Random; use Test::Deep; use_ok('Mail::MtPolicyd::SessionCache'); my $server = Test::MockObject->new; $server->set_isa('Net::Server'); $server->mock( 'log', sub { my ( $self, $level, $message ) = @_; print '# LOG('.$level.'): '.$message."\n" } ); my $cache = Mail::MtPolicyd::SessionCache->new( server => $server, ); isa_ok( $cache, 'Mail::MtPolicyd::SessionCache', 'initialize session cache'); sub cache_basics_ok { my ( $cache ) = @_; my $instance = 'abcd1234'; isa_ok( $cache->server, 'Net::Server'); isa_ok( $cache->cache, 'Mail::MtPolicyd::SessionCache::Base'); can_ok( $cache, 'retrieve_session', 'store_session', 'shutdown', 'load_config', ); lives_ok { $cache->store_session( { _instance => $instance, test => 'bla', } ); } 'call store_session must succeed'; lives_ok { $cache->retrieve_session( $instance ); } 'call retrieve_session must succeed'; } sub cache_store_retrieve_ok { my ( $cache ) = @_; my $rand = String::Random->new; foreach (1..10) { my $instance = $rand->randpattern('ssssssss'); my $session; my $session_retrieved; lives_ok { $session = $cache->retrieve_session( $instance ); } 'must be able to retrieve a session'; $session->{'data'} = $rand->randpattern('CCCCCCCCCC'); lives_ok { $cache->store_session( $session ); } 'must be able to store the session'; lives_ok { $session_retrieved = $cache->retrieve_session( $instance ); } 'must be able to retrieve the session again'; cmp_deeply( $session, $session_retrieved, 'stored and retrieved session must match'); } } sub cache_locking_ok { my ( $cache ) = @_; my $rand = String::Random->new; my $instance = $rand->randpattern('ssssssss'); my $session; lives_ok { $session = $cache->retrieve_session( $instance ); } 'must be able to retrieve a session'; throws_ok { $session = $cache->retrieve_session( $instance ); } qr/could not acquire lock for session/, 'session must be locked'; } subtest 'test session cache None', sub { cache_basics_ok( $cache ); }; subtest 'test session cache Memcached', sub { Mail::MtPolicyd::ConnectionPool->load_connection( 'memcached', { module => 'Memcached', servers => 'memcached:11211', } ); lives_ok { $cache->load_config( { module => 'Memcached', memcached => 'memcached', } ); } 'load session cache memcached config'; cache_basics_ok( $cache ); cache_store_retrieve_ok( $cache ); cache_locking_ok( $cache ); }; subtest 'test session cache Redis', sub { diag('trying to start mock redis...'); my $redis = Test::RedisDB->new or plan skip_all => 'could not start redis (not installed?), skipping test...'; Mail::MtPolicyd::ConnectionPool->load_connection( 'redis', { module => 'Redis', server => '127.0.0.1:'.$redis->port, } ); lives_ok { $cache->load_config( { module => 'Redis', redis => 'redis', } ); } 'load session cache redis config'; cache_basics_ok( $cache ); cache_store_retrieve_ok( $cache ); cache_locking_ok( $cache ); $redis->stop; }; author-critic.t100644000000000000 40313306510157 16565 0ustar00rootroot000000000000Mail-MtPolicyd-2.03/t#!perl BEGIN { unless ($ENV{AUTHOR_TESTING}) { print qq{1..0 # SKIP these tests are for testing by the author\n}; exit } } use strict; use warnings; use Test::Perl::Critic (-profile => "perlcritic.rc") x!! -e "perlcritic.rc"; all_critic_ok(); docker-compose.yml100644000000000000 106213306510157 17037 0ustar00rootroot000000000000Mail-MtPolicyd-2.03version: '2' services: mtpolicyd: build: context: . ports: - "12345:12345" volumes: - ".:/mtpolicyd" links: - memcached - openldap memcached: image: memcached openldap: image: osixia/openldap:1.2.1 container_name: openldap environment: LDAP_ADMIN_PASSWORD: "admin" LDAP_CONFIG_PASSWORD: "config" volumes: - "ldap_config:/etc/ldap/slapd.d" - "ldap_data:/var/lib/ldap" domainname: "example.org" hostname: "example.org" volumes: ldap_config: ldap_data: policyd-client100755000000000000 301213306510157 17014 0ustar00rootroot000000000000Mail-MtPolicyd-2.03/bin#!/usr/bin/env perl use strict; use warnings; our $VERSION = '2.03'; # VERSION # ABSTRACT: commandline client to query a policyd server # PODNAME: policyd-client use Mail::MtPolicyd::Client::App; my $app = Mail::MtPolicyd::Client::App->new_with_options(); $app->run; __END__ =pod =encoding UTF-8 =head1 NAME policyd-client - commandline client to query a policyd server =head1 VERSION version 2.03 =head1 DESCRIPTION policyd-client is a rudimentary tool to query a policy server from the command line. It will generate the instance and request fields all other fields must be specified on stdin and the request is completed by a blank line. =head1 USAGE policyd-client [-?hhksv] [long options...] -h -? --usage --help Prints this usage information. -h --host host:port of a policyd -s --socket_path path to a socket of a policyd -k --keepalive use connection keepalive? -v --verbose be verbose, print input/output to STDERR =head1 EXAMPLE $ policyd-client -v -h localhost:12347 client_address=212.178.212.218 >> request=smtpd_access_policy >> instance=0.133885340838791 >> client_address=212.178.212.218 >> << action=reject IP is blacklisted << reject IP is blddacklisted =head1 AUTHOR Markus Benning =head1 COPYRIGHT AND LICENSE This software is Copyright (c) 2014 by Markus Benning . This is free software, licensed under: The GNU General Public License, Version 2, June 1991 =cut mtpolicyd.conf100644000000000000 1113213306510157 17047 0ustar00rootroot000000000000Mail-MtPolicyd-2.03/etc# -*- apache -*- # # Configuration for the mailteam policy daemon user=mtpolicyd group=mtpolicyd #pid_file="/var/run/mtpolicyd/mtpolicyd.pid" #chroot=/var/run/mtpolicyd # 0=>'err', 1=>'warning', 2=>'notice', 3=>'info', 4=>'debug' (default: 2) log_level=2 host=127.0.0.1 port="127.0.0.1:12345" min_servers=4 min_spare_servers=4 max_spare_servers=12 max_servers=50 max_requests=1000 #keepalive_timeout=60 keepalive_timeout=0 # should be the same value as smtpd_policy_service_reuse_count_limit (postfix >2.12) max_keepalive=0 #max_keepalive=100 # timeout for processing of one request in seconds request_timeout=20 # # module = "Ldap" # host = "localhost" # module = "Memcached" servers = "127.0.0.1:11211" # namespace = "mt-" module = "Sql" dsn = "dbi:SQLite:dbname=/var/lib/mtpolicyd/mtpolicyd.sqlite" module = "Memcached" #memcached = "memcached" # expire session cache entries expire = "300" # wait timeout will be increased each time 50,100,150,... (usec) lock_wait=50 # abort after n retries lock_max_retry=50 # session lock times out after (sec) lock_timeout=10 name="reputation" # we only check for a ticket here # avoid running thru all checks for early retries module = "Greylist" score = -5 mode = "passive" create_ticket = 0 query_autowl = 0 module = "SPF" pass_mode = "passive" pass_score = -10 fail_mode = "reject" # stop #fail_score = 5 # you may want to use some unused recipient addresses as honeypot # make sure they are really unused # # module = "Honeypot" # recipients_re = "^(chung|ogc|wore|aio|duy)@(yourdomain1|yourdomain2)\.de$" # module = "RBL" mode = "accept" # will stop here domain="list.dnswl.org" module = "GeoIPLookup" # apt-get install geoip-database database = "/usr/share/GeoIP/GeoIP.dat" module = "GeoIPAction" result_from = "geoip" country_codes = "DE,AT,CH,FR,IT" mode = passive score = -1 module = "GeoIPAction" result_from = "geoip" country_codes = "RU,UA,CN,IN" mode = passive score = 5 module = "RBL" mode = "passive" domain="zen.spamhaus.org" module = "RBLAction" result_from = "spamhaus-rbl" mode = "passive" re_match = "^127\.0\.0\.[23]$" score = 5 module = "RBLAction" result_from = "spamhaus-rbl" mode = "passive" re_match = "^127\.0\.0\.[4-7]$" score = 5 module = "RBLAction" result_from = "spamhaus-rbl" mode = "passive" re_match = "^127\.0\.0\.1[01]$" score = 3 module = "DBL" domain="dbl.spamhaus.org" helo_name_mode=passive helo_name_score=1 sender_mode=passive sender_score=5 reverse_client_name_mode=passive reverse_client_name_score=2.5 module = "RBL" mode = "passive" domain="dnsbl.sorbs.net" score = 5 module = "RBL" mode = "passive" domain="ix.dnsbl.manitu.net" score = 5 module = "RBL" mode = "passive" domain="bl.spamcop.net" score = 5 module = "RBL" mode = "passive" domain="drone.abuse.ch" score = 3 module = "RBL" mode = "passive" domain="db.wpbl.info" score = 3 module = "RBL" mode = "passive" domain="bb.barracudacentral.org" score = 3 # # block ip address with iptables filter # # module = "ScoreAction" # threshold = 15 # # module = "Fail2Ban" # socket = "/var/run/fail2ban/fail2ban.sock" # jail = "postfix" # # # score >= 15 will be rejected module = "ScoreAction" threshold = 15 action = "reject sender ip %IP% is blocked (score=%SCORE%%SCORE_DETAIL%)" # score >= 5 gets greylisting applied module = "ScoreAction" threshold = 5 module = "Greylist" score = -5 mode = "passive" # activating the autowl will require a SQL database use_autowl = 1 # add an header to everything left module = "AddScoreHeader" spam_score=5 plugin-ctiprep.t100755000000000000 537313306510157 17010 0ustar00rootroot000000000000Mail-MtPolicyd-2.03/t#!perl use strict; use warnings; use Test::More; use Test::Exception; use Test::MockObject; use Mail::MtPolicyd::Request; use Mail::MtPolicyd::Plugin::CtIpRep; use LWP::UserAgent; eval { my $agent = LWP::UserAgent->new; my $response = $agent->get('http://localhost:8080/'); if( ! defined $response || ! defined $response->code ) { die('unknown response'); } if( $response->code =~ m/^5/ ) { die('no server on http://localhost:8080/'); } if( ! defined $response->server || $response->server !~ m/^CTCFC/ ) { my $vendor = defined $response->server ? $response->server : 'none'; die('wrong server vendor ('.$vendor.')'); } }; if( $@ ) { plan skip_all => 'no ctipd found ('.$@.')'; } plan tests => 16; my $p = Mail::MtPolicyd::Plugin::CtIpRep->new( name => 'commtouch', enabled => 'on', tempfail_score => 2.5, permfail_score => 5, tempfail_mode => 'passive', permfail_mode => 'reject', ); isa_ok($p, 'Mail::MtPolicyd::Plugin::CtIpRep'); my $session = { '_instance' => 'abcd1234', }; # fake a Server object my $server = Test::MockObject->new; $server->set_isa('Net::Server'); $server->mock( 'log', sub { my ( $self, $level, $message ) = @_; print '# LOG('.$level.'): '.$message."\n" } ); my $r = Mail::MtPolicyd::Request->new( attributes => { 'instance' => 'abcd1234', 'client_address' => '127.0.0.1', }, session => $session, server => $server, use_caching => 0, ); isa_ok( $r, 'Mail::MtPolicyd::Request'); my $result; lives_ok { $result = $p->run($r); } 'execute request'; is( $result, undef, 'should not match' ); # in hope that this ip stays "bad" $r->attributes->{'client_address'} = '201.216.207.129'; lives_ok { $result = $p->run($r); } 'execute request'; isa_ok( $result, 'Mail::MtPolicyd::Plugin::Result', 'should match' ); like( $result->action, qr/reject 550 delivery from 201.216.207.129 is rejected./, 'should return a reject' ); is($session->{'score'}, 5, 'score should be 5'); # test with per-user/session setting $p->uc_enabled('ctrep'); $session->{'ctrep'} = 'off'; lives_ok { $result = $p->run($r); } 'execute request'; is( $result, undef, 'should do nothing' ); $p->uc_enabled(undef); $p->permfail_mode('passive'); $p->tempfail_mode('passive'); lives_ok { $result = $p->run($r); } 'execute request'; is( $result, undef, 'should do nothing' ); is($session->{'score'}, 10, 'score should be 10'); $p->permfail_mode('defer'); lives_ok { $result = $p->run($r); } 'execute request'; like( $result->action, qr/defer 450 delivery from 201.216.207.129 is deferred,repeatedly. Send again or check at http:\/\/www.commtouch.com\/Site\/Resources\/Check_IP_Reputation.asp. Reference code: tid=.*/, 'should return a reject' ); is($session->{'score'}, 15, 'score should be 15'); plugin-sqllist.t100755000000000000 476013306510157 17034 0ustar00rootroot000000000000Mail-MtPolicyd-2.03/t#!perl use strict; use warnings; use Test::More tests => 16; use Test::Exception; use Test::MockObject; use Mail::MtPolicyd::Request; use Mail::MtPolicyd::ConnectionPool; use Mail::MtPolicyd::Plugin::SqlList; use DBI; my $p = Mail::MtPolicyd::Plugin::SqlList->new( name => 'mylist', sql_query => "SELECT client_ip FROM list WHERE client_ip = ?", match_action => 'dunno', score => 5, ); isa_ok($p, 'Mail::MtPolicyd::Plugin::SqlList'); my $session = { '_instance' => 'abcd1234', }; # build a fake database with an in-memory SQLite DB Mail::MtPolicyd::ConnectionPool->load_connection( 'db', { module => 'Sql', dsn => 'dbi:SQLite::memory:', user => '', password => '', } ); my $dbh = Mail::MtPolicyd::ConnectionPool->get_handle('db'); $dbh->do( 'CREATE TABLE `list` ( `id` INTEGER PRIMARY KEY AUTOINCREMENT, `client_ip` varchar(255) DEFAULT NULL )' ); # insert test data $dbh->do("INSERT INTO `list` VALUES (NULL, '192.168.0.1');"); # fake a Server object my $server = Test::MockObject->new; $server->set_isa('Net::Server'); $server->mock( 'log', sub { my ( $self, $level, $message ) = @_; print '# LOG('.$level.'): '.$message."\n" } ); $server->mock( 'get_dbh', sub { return $dbh; } ); my $r = Mail::MtPolicyd::Request->new( attributes => { 'instance' => 'abcd1234', 'client_address' => '192.168.0.0', }, session => $session, server => $server, use_caching => 0, ); isa_ok( $r, 'Mail::MtPolicyd::Request'); my $result; lives_ok { $result = $p->run($r); } 'execute request'; is( $result, undef, 'should not return a result' ); $r->attributes->{'client_address'} = '192.168.0.1'; lives_ok { $result = $p->run($r); } 'execute request'; isa_ok( $result, 'Mail::MtPolicyd::Plugin::Result', 'should match' ); is( $result->action, "dunno", 'must return action=dunno' ); is($session->{'score'}, 5, 'score should be 5'); $p->enabled('off'); lives_ok { $result = $p->run($r); } 'execute request'; is( $result, undef, 'should do nothing' ); $p->uc_enabled('list'); $session->{'list'} = 'on'; lives_ok { $result = $p->run($r); } 'execute request'; isa_ok( $result, 'Mail::MtPolicyd::Plugin::Result', 'should match' ); is( $result->action, "dunno", 'must return action=dunno' ); $r->attributes->{'client_address'} = '192.168.0.0'; $p->not_match_action('reject no access granted'); lives_ok { $result = $p->run($r); } 'execute request'; isa_ok( $result, 'Mail::MtPolicyd::Plugin::Result', 'should match' ); is( $result->action, "reject no access granted", 'must return action=reject no access granted' ); profiler-timer.t100644000000000000 227513306510157 17001 0ustar00rootroot000000000000Mail-MtPolicyd-2.03/t#!perl use strict; use warnings; use Test::More tests => 13; use_ok('Mail::MtPolicyd::Profiler::Timer'); my $timer = Mail::MtPolicyd::Profiler::Timer->new(name => 'zumsel'); isa_ok( $timer, 'Mail::MtPolicyd::Profiler::Timer', 'constructor with hash params'); $timer = Mail::MtPolicyd::Profiler::Timer->new('zumsel'); isa_ok( $timer, 'Mail::MtPolicyd::Profiler::Timer', 'constructor with single arg'); ok( defined $timer->start_time, 'start time must be defined'); is( ref $timer->start_time, 'ARRAY', 'start time must be ArrayRef'); $timer->tick('event 1'); is( scalar @{$timer->ticks}, 1, 'must contain 1 tick' ); my $tick = $timer->ticks->[0]; is( ref $tick, 'ARRAY', 'tick must be ArrayRef'); is( scalar @$tick, 2, 'tick must contain 2 elements'); my $subtimer = $timer->new_child( name => 'blablub' ); isa_ok( $subtimer, 'Mail::MtPolicyd::Profiler::Timer', 'create sub timer'); is( scalar @{$timer->ticks}, 3, 'must contain 3 elements' ); my $child = $timer->ticks->[-1]; cmp_ok($child, '==', $subtimer, 'child must equal returned subtimer'); cmp_ok($child->parent, '==', $timer, 'parent of subtimer must equal timer'); $timer->stop; is( scalar @{$timer->ticks}, 4, 'must contain 4 elements' ); rpm000755000000000000 013306510157 14041 5ustar00rootroot000000000000Mail-MtPolicyd-2.03mtpolicyd.spec100644000000000000 551613306510157 17070 0ustar00rootroot000000000000Mail-MtPolicyd-2.03/rpm%define module_name Mail-MtPolicyd Name: mtpolicyd Version: 2.03 Release: %(date +%Y%m%d)%{dist} Summary: a modular policy daemon for postfix Group: Applications/CPAN License: GPLv2 Vendor: Markus Benning Packager: Markus Benning BuildArch: noarch BuildRoot: %{_tmppath}/%{name}-%{version}-build Source0: %{module_name}-%{version}.tar.gz #AutoProv: 0 # only require core dependencies AutoReq: 0 Requires: perl(Cache::Memcached), perl(Config::General), perl(Moose), perl(Tie::IxHash), perl(Time::HiRes), perl(DBI), perl(Mail::RBL), perl(JSON), perl(MooseX::Singleton) BuildRequires: perl, perl(ExtUtils::MakeMaker) Requires(pre): /usr/sbin/useradd, /usr/sbin/groupadd %description A modular policy daemon for postfix written in perl. %prep rm -rf $RPM_BUILD_ROOT %setup -q -n %{module_name}-%{version} %build %{__perl} Makefile.PL INSTALLDIRS=vendor make %{?_smp_mflags} %install if [ -d "$RPM_BUILD_ROOT" ] ; then rm -rf $RPM_BUILD_ROOT fi make install DESTDIR=$RPM_BUILD_ROOT find $RPM_BUILD_ROOT -type f -name .packlist -exec rm -f {} \; find $RPM_BUILD_ROOT -type f -name perllocal.pod -exec rm -f {} \; find $RPM_BUILD_ROOT -depth -type d -exec rmdir {} 2>/dev/null \; mkdir -p "$RPM_BUILD_ROOT/%{_sysconfdir}/init.d" mkdir -p "$RPM_BUILD_ROOT/%{_sysconfdir}/mtpolicyd" mkdir -p "$RPM_BUILD_ROOT/%{_sysconfdir}/cron.d" mkdir -p "$RPM_BUILD_ROOT/var/run/mtpolicyd" install -m755 rpm/mtpolicyd.init-redhat "$RPM_BUILD_ROOT/%{_sysconfdir}/init.d/mtpolicyd" install -m640 etc/mtpolicyd.conf "$RPM_BUILD_ROOT/%{_sysconfdir}/mtpolicyd/mtpolicyd.conf" install -m640 etc/mtpolicyd.crontab "$RPM_BUILD_ROOT/%{_sysconfdir}/cron.d/mtpolicyd" %{_fixperms} $RPM_BUILD_ROOT/* %clean if [ "$RPM_BUILD_ROOT" = "" -o "$RPM_BUILD_ROOT" = "/" ]; then RPM_BUILD_ROOT=/var/tmp/rpm-build-root export RPM_BUILD_ROOT fi rm -rf $RPM_BUILD_ROOT %pre ( /usr/sbin/groupadd \ -r mtpolicyd \ && /usr/sbin/useradd \ -c 'mtpolicyd daemon' \ -d /var/run/mtpolicyd \ -M -r \ -s /bin/false \ -g mtpolicyd \ mtpolicyd 2>&1 >/dev/null || exit 0 ) %post /sbin/chkconfig --add mtpolicyd %preun if [ "$1" = 0 ]; then /sbin/service mtpolicyd stop &>/dev/null /sbin/chkconfig --del mtpolicyd fi %files %defattr(-,root,root) %doc README %attr(755,root,root) %{_bindir}/mtpolicyd %attr(755,root,root) %{_bindir}/policyd-client %attr(755,root,root) %{_sysconfdir}/init.d/mtpolicyd %dir %ghost %{_sysconfdir}/mtpolicyd %attr(640,root,mtpolicyd) %config(noreplace) %{_sysconfdir}/mtpolicyd/mtpolicyd.conf %attr(640,root,root) %config %{_sysconfdir}/cron.d/mtpolicyd %attr(750,mtpolicyd,mtpolicyd) %dir /var/run/mtpolicyd %{perl_vendorlib} %{_mandir}/man1/* %{_mandir}/man3/* %changelog * Fri Mar 20 2015 Markus Benning 2.03 - generate spec file from upstream release t-data000755000000000000 013306510157 14415 5ustar00rootroot000000000000Mail-MtPolicyd-2.03minimal.conf100755000000000000 112613306510157 17055 0ustar00rootroot000000000000Mail-MtPolicyd-2.03/t-data# -*- apache -*- #keepalive_timeout=60 keepalive_timeout=0 # should be the same value as smtpd_policy_service_reuse_count_limit (postfix >2.12) max_keepalive=0 #max_keepalive=100 # timeout for processing of one request in seconds request_timeout=20 module = "Memcached" # memcached connection for session caching servers="memcached:11211" module = "Memcached" memcached = "memcached" name="minimal" module = "Action" action = "reject test" plugin-greylist.t100755000000000000 671613306510157 17206 0ustar00rootroot000000000000Mail-MtPolicyd-2.03/t#!perl use strict; use warnings; use Test::More; use Test::Exception; use Test::MockObject; use Mail::MtPolicyd::Request; use Mail::MtPolicyd::ConnectionPool; use Mail::MtPolicyd::Plugin::Greylist; use Cache::Memcached; use DBI; plan tests => 73; Mail::MtPolicyd::ConnectionPool->load_connection( 'memcached', { module => 'Memcached', servers => 'memcached:11211', } ); my $memcached = Mail::MtPolicyd::ConnectionPool->get_handle('memcached'); isa_ok( $memcached, 'Cache::Memcached' ); my $p = Mail::MtPolicyd::Plugin::Greylist->new( name => 'greylist-test', autowl_threshold => 5, ); isa_ok($p, 'Mail::MtPolicyd::Plugin::Greylist'); # build a fake database with an in-memory SQLite DB Mail::MtPolicyd::ConnectionPool->load_connection( 'db', { module => 'Sql', dsn => 'dbi:SQLite::memory:', user => '', password => '', } ); lives_ok { $p->init(); } 'plugin initialization'; my $session = { '_instance' => 'abcd1234', }; # fake a Server object my $server = Test::MockObject->new; $server->set_isa('Net::Server'); $server->mock( 'log', sub { my ( $self, $level, $message ) = @_; print '# LOG('.$level.'): '.$message."\n" } ); sub test_one_greylisting_circle { my ( $sender, $client_address, $recipient, $r, $count ) = @_; my $sender_domain = $p->_extract_sender_domain( $sender ); my $result; lives_ok { $result = $p->run($r); } 'execute request'; isa_ok( $result, 'Mail::MtPolicyd::Plugin::Result', 'must return a result' ); like( $result->action, qr/^defer greylisting is active$/, 'must return a greylist defer'); # second time it must show a delay lives_ok { $result = $p->run($r); } 'execute request'; isa_ok( $result, 'Mail::MtPolicyd::Plugin::Result', 'must return a result' ); like( $result->action, qr/^defer greylisting is active \(\d+s left\)$/, 'must return a greylist defer with delay'); # now do a timewarp my $key = join(',', $sender, $client_address, $recipient); ok($memcached->decr($key, 301), 'manipulate greylisting ticket'); lives_ok { $result = $p->run($r); } 'execute request'; ok( ! defined $result, 'greylisting no longer active' ); # now we should have a autowl entry my $seen; lives_ok { $seen = $p->_awl->get( $sender_domain, $client_address ); } 'retrieve autowl row'; if( defined $count ) { cmp_ok( $seen, 'eq', $count, 'autowl count must be '.$count); } else { ok( ! defined $seen, 'must be no autowl present'); } } my $sender = 'newsender@domain'.int(rand(1000000)).'.de'; my $client_address = '192.168.0.0'; my $recipient = 'newrcpt@mydomain.de'; my $r = Mail::MtPolicyd::Request->new( attributes => { 'instance' => 'abcd1234', 'client_address' => $client_address, 'sender' => $sender, 'recipient' => $recipient, }, session => $session, server => $server, use_caching => 0, ); isa_ok( $r, 'Mail::MtPolicyd::Request'); foreach my $count (1..5) { test_one_greylisting_circle( $sender, $client_address, $recipient, $r, $count ); } # now autowl_threshold must be reached my $result; lives_ok { $result = $p->run($r); } 'execute request'; ok( ! defined $result, 'greylisting no longer active' ); # now manipulate autowl to expire all records lives_ok { Mail::MtPolicyd::ConnectionPool->get_handle('db')->do( 'UPDATE autowl SET last_seen=1;' ); } 'manipulate autowl, expire'; # greylisting should be active again test_one_greylisting_circle( $sender, $client_address, $recipient, $r, undef ); connection-ldap.t100644000000000000 253213306510157 17112 0ustar00rootroot000000000000Mail-MtPolicyd-2.03/t#!perl use strict; use warnings; use Test::More tests => 19; use Test::Exception; use Test::Deep; use_ok('Mail::MtPolicyd::Connection::Ldap'); my $ldap; lives_ok { $ldap = Mail::MtPolicyd::Connection::Ldap->new( name => 'ldap', host => 'openldap', port => 389, starttls => 0, ); } 'create ldap connection'; isa_ok($ldap, 'Mail::MtPolicyd::Connection::Ldap'); ok(!$ldap->is_connected, 'connection not established'); lives_ok { $ldap->handle; } "retrieve connection"; ok($ldap->is_connected, 'connection established'); isa_ok($ldap->handle, 'Net::LDAP'); my $old_handle = $ldap->handle; lives_ok { $ldap->reconnect; } "reconnect connection"; ok(!$ldap->is_connected, 'connection not established'); lives_ok { $ldap->handle; } "retrieve connection"; isa_ok($ldap->handle, 'Net::LDAP'); ok($ldap->is_connected, 'connection established'); cmp_ok($old_handle, '!=', $ldap->handle, 'a new handle has been created'); lives_ok { $ldap->shutdown; } "close connection"; ok(!$ldap->is_connected, 'connection not established'); lives_ok { $ldap->handle; } "retrieve connection"; isa_ok($ldap->handle, 'Net::LDAP'); ok($ldap->is_connected, 'connection established'); diag('trying to sabotage connection by closing underlying socket...'); $ldap->handle->socket->close; lives_ok { $ldap->handle->bind; } "connection must be reestablished"; plugin-condition.t100755000000000000 422613306510157 17324 0ustar00rootroot000000000000Mail-MtPolicyd-2.03/t#!perl use strict; use warnings; use Test::More tests => 19; use Test::Exception; use Test::MockObject; use Mail::MtPolicyd::Request; use Mail::MtPolicyd::Plugin::Condition; my $c = Mail::MtPolicyd::Plugin::Condition->new( name => 'greylist', key => 's:greylisting', match => 'on', action => 'postgrey_users', ); isa_ok($c, 'Mail::MtPolicyd::Plugin::Condition'); my $session = { '_instance' => 'abcd1234', }; # fake a Server object my $server = Test::MockObject->new; $server->set_isa('Net::Server'); $server->mock( 'log', sub { my ( $self, $level, $message ) = @_; print '# LOG('.$level.'): '.$message."\n" } ); my $r = Mail::MtPolicyd::Request->new( attributes => { 'instance' => 'abcd1234', 'queue_id' => '4561B3D95D8B', }, session => $session, server => $server, ); isa_ok( $r, 'Mail::MtPolicyd::Request'); my $result; lives_ok { $result = $c->run($r); } 'execute request'; is( $result, undef, 'should not match' ); $session->{'greylisting'} = 'off'; lives_ok { $result = $c->run($r); } 'execute request'; is( $result, undef, 'should not match' ); $session->{'greylisting'} = 'on'; lives_ok { $result = $c->run($r); } 'execute request'; isa_ok( $result, 'Mail::MtPolicyd::Plugin::Result', 'should match' ); is( $result->action, 'postgrey_users', 'check result' ); is( $result->abort, 1, 'check result' ); $c->action( undef ); $c->Plugin( { 'test' => { module => 'Action', action => 'zumsel' } } ); lives_ok { ( $result ) = $c->run($r); } 'execute request'; isa_ok( $result, 'Mail::MtPolicyd::Plugin::Result', 'should match' ); is( $result->action, 'zumsel', 'check result' ); is( $result->abort, 1, 'check result' ); # use a request attribute $c = Mail::MtPolicyd::Plugin::Condition->new( name => 'by_queueid', key => 'r:queue_id', match => '4561B3D95D8B', action => 'reject', ); lives_ok { ( $result ) = $c->run($r); } 'execute by_queueid request'; isa_ok( $result, 'Mail::MtPolicyd::Plugin::Result', 'check must match' ); is( $result->action, 'reject', 'check must return reject action' ); # test invert option $c->invert(1); lives_ok { ( $result ) = $c->run($r); } 'execute by_queueid request'; is( $result, undef, 'must not match when inverted' ); mtpolicyd.crontab100644000000000000 45513306510157 17520 0ustar00rootroot000000000000Mail-MtPolicyd-2.03/etc# crontab for mtpolicyd default tasks 0 1-23 * * * mtpolicyd /usr/bin/mtpolicyd --cron hourly 0 0 2-31 * 1-6 mtpolicyd /usr/bin/mtpolicyd --cron hourly,daily 0 0 2-31 * 0 mtpolicyd /usr/bin/mtpolicyd --cron hourly,daily,weekly 0 0 1 * * mtpolicyd /usr/bin/mtpolicyd --cron hourly,daily,weekly,monthly Mail000755000000000000 013306510157 14673 5ustar00rootroot000000000000Mail-MtPolicyd-2.03/libMtPolicyd.pm100644000000000000 2700013306510157 17314 0ustar00rootroot000000000000Mail-MtPolicyd-2.03/lib/Mailpackage Mail::MtPolicyd; use strict; use warnings; use base qw(Net::Server::PreFork); our $VERSION = '2.03'; # VERSION # ABSTRACT: a modular policy daemon for postfix use Data::Dumper; use Mail::MtPolicyd::Profiler; use Mail::MtPolicyd::Request; use Mail::MtPolicyd::VirtualHost; use Mail::MtPolicyd::ConnectionPool; use Mail::MtPolicyd::SessionCache; use DBI; use Time::HiRes qw( usleep tv_interval gettimeofday ); use Getopt::Long; use Tie::IxHash; use Config::General qw(ParseConfig); use IO::Handle; sub _preload_modules { # PRELOAD some modules my @modules = ( 'DBI', 'Moose', 'Moose::Role', 'MooseX::Getopt', 'MooseX::Role::Parameterized', 'namespace::autoclean', ); foreach my $module (@modules) { $module =~ s/::/\//g; $module .= '.pm'; require $module; } } sub _apply_values_from_config { my ( $self, $target, $config ) = ( shift, shift, shift ); while ( my $key = shift ) { if(! defined $config->{$key} ) { next; } $target->{$key} = $config->{$key}; } return; } sub _apply_array_from_config { my ( $self, $target, $config ) = ( shift, shift, shift ); while ( my $key = shift ) { if(! defined $config->{$key} ) { next; } $target->{$key} = [ split(/\s*,\s*/, $config->{$key}) ]; } return; } sub print_usage { print "mtpolicyd [-h|--help] [-c|--config=] [-f|--foreground] [-l|--loglevel=] [-d|--dump_vhosts] [-t|--cron=]\n"; return; } sub configure { my $self = shift; my $server = $self->{'server'}; my $cmdline; return if(@_); if( ! defined $server->{'config_file'} ) { $server->{'config_file'} = '/etc/mtpolicyd/mtpolicyd.conf'; } $server->{'background'} = 1; $server->{'setsid'} = 1; $server->{'no_close_by_child'} = 1; # Parse command line params %{$cmdline} = (); GetOptions( \%{$cmdline}, "help|h", "dump_config|d", "config|c:s", "foreground|f", "loglevel|l:i", "cron|t:s", ); if ($cmdline->{'help'}) { $self->print_usage; exit 0; } if (defined($cmdline->{'config'}) && $cmdline->{'config'} ne "") { $server->{'config_file'} = $cmdline->{'config'}; } if( ! -f $server->{'config_file'} ) { print(STDERR 'configuration file '.$server->{'config_file'}.' does not exist!\n'); exit 1; } # DEFAULTS if( ! defined $server->{'log_level'} ) { $server->{'log_level'} = 2; } if( ! defined $server->{'log_file'} && ! $cmdline->{'foreground'} ) { $server->{'log_file'} = 'Sys::Syslog'; } $server->{'syslog_ident'} = 'mtpolicyd'; $server->{'syslog_facility'} = 'mail'; $server->{'proto'} = 'tcp'; $server->{'host'} = '127.0.0.1'; if( ! defined $server->{'port'} ) { $server->{'port'} = [ '127.0.0.1:12345' ]; } $server->{'min_servers'} = 4; $server->{'min_spare_servers'} = 4; $server->{'max_spare_servers'} = 12; $server->{'max_servers'} = 25; $server->{'max_requests'} = 1000; $self->{'request_timeout'} = 20; $self->{'keepalive_timeout'} = 60; $self->{'max_keepalive'} = 0; $self->{'vhost_by_policy_context'} = 0; $self->{'program_name'} = $0; # APPLY values from configuration file tie my %config_hash, "Tie::IxHash"; %config_hash = ParseConfig( -AllowMultiOptions => 'no', -ConfigFile => $server->{'config_file'}, -Tie => "Tie::IxHash" ); my $config = \%config_hash; $self->_apply_values_from_config($server, $config, 'user', 'group', 'pid_file', 'log_level', 'log_file', 'syslog_ident', 'syslog_facility', 'host', 'min_servers', 'min_spare_servers', 'max_spare_servers', 'max_servers', 'max_requests', 'chroot', ); $self->_apply_array_from_config($server, $config, 'port'); $self->_apply_values_from_config($self, $config, 'request_timeout', 'keepalive_timeout', 'max_keepalive', 'vhost_by_policy_context', 'program_name', ); # initialize connection pool Mail::MtPolicyd::ConnectionPool->initialize; if( defined $config->{'Connection'} ) { Mail::MtPolicyd::ConnectionPool->load_config( $config->{'Connection'} ); } $self->{'session_cache_config'} = $config->{'SessionCache'}; # LOAD VirtualHosts if( ! defined $config->{'VirtualHost'} ) { print(STDERR 'no virtual hosts configured!\n'); exit 1; } my $vhosts = $config->{'VirtualHost'}; $self->{'virtual_hosts'} = {}; foreach my $vhost_port (keys %$vhosts) { my $vhost = $vhosts->{$vhost_port}; $self->{'virtual_hosts'}->{$vhost_port} = Mail::MtPolicyd::VirtualHost->new_from_config($vhost_port, $vhost) } if ($cmdline->{'dump_config'}) { print "----- Virtual Hosts -----\n"; print Dumper( $self->{'virtual_hosts'} ); exit 0; } # foreground mode (cmdline) if ($cmdline->{'foreground'}) { $server->{'background'} = undef; $server->{'setsid'} = undef; } if( $cmdline->{'loglevel'} ) { $server->{'log_level'} = $cmdline->{'loglevel'}; } # if running in cron mode execute cronjobs and exit if( $cmdline->{'cron'} && $cmdline->{'cron'} !~ /^\s*$/ ) { my @tasks = split(/\s*,\s*/, $cmdline->{'cron'}); $self->cron( @tasks ); exit 0; } # change processname in top/ps $self->_set_process_stat('master'); return; } sub cron { my $self = shift; foreach my $vhost ( keys %{$self->{'virtual_hosts'}} ) { $self->{'virtual_hosts'}->{$vhost}->cron( $self, @_ ); } return; } sub pre_loop_hook { my $self = shift; $self->_preload_modules; return; } sub child_init_hook { my $self = shift; $self->_set_process_stat('virgin child'); # recreate connection in child process Mail::MtPolicyd::ConnectionPool->reconnect; # initialize session cache $self->{'session_cache'} = Mail::MtPolicyd::SessionCache->new( server => $self, ); if( defined $self->{'session_cache_config'} && ref($self->{'session_cache_config'}) eq 'HASH') { $self->{'session_cache'}->load_config( $self->{'session_cache_config'} ); } return; } sub child_finish_hook { my $self = shift; $self->_set_process_stat('finish'); Mail::MtPolicyd::ConnectionPool->shutdown; if( defined $self->{'session_cache'} ) { $self->{'session_cache'}->shutdown; } return; } sub get_conn_port { my $self = shift; my $server = $self->{server}; my $client = $server->{client}; my $port; my $is_socket = $client && $client->UNIVERSAL::can('NS_proto') && $client->NS_proto eq 'UNIX'; if( $is_socket ) { $port = Net::Server->VERSION >= 2 ? $client->NS_port : $client->NS_unix_path; } else { $port = $self->{'server'}->{'sockport'}; } return($port); } sub get_virtual_host { my ( $self, $conn_port, $r ) = @_; my $vhost; my $policy_context = $r->attr('policy_context'); if( $self->{'vhost_by_policy_context'} && defined $policy_context && $policy_context ne '' ) { foreach my $vhost_port ( keys %{$self->{'virtual_hosts'}} ) { $vhost = $self->{'virtual_hosts'}->{$vhost_port}; if( $policy_context eq $vhost->name ) { return( $vhost ); } } } $vhost = $self->{'virtual_hosts'}->{$conn_port}; if( ! defined $vhost ) { die('no virtual host defined for port '.$conn_port); } return($vhost); } sub _is_loglevel { my ( $self, $level ) = @_; if( $self->{'server'}->{'log_level'} && $self->{'server'}->{'log_level'} >= $level ) { return(1); } return(0); } our %_LOG_ESCAPE_MAP = ( "\0" => '\0', "\r" => '\r', "\n" => '\n', "\\" => '\\\\', ); our $_LOG_ESCAPE_MAP_RE = '['.join('', map { sprintf('\\x%02x', ord($_)) } keys %_LOG_ESCAPE_MAP ).']'; sub log { my ( $self, $level, $msg, @params ) = @_; $msg =~ s/($_LOG_ESCAPE_MAP_RE)/ $_LOG_ESCAPE_MAP{$1} /gse; $msg =~ s/([\x01-\x08\x0b-\x0c\x0e-\x1f\x7f])/ sprintf('\\x%02X', ord($1)) /gse; return $self->SUPER::log( $level, $msg, @params ); } sub _process_one_request { my ( $self, $conn, $vhost, $r ) = @_; my $port = $vhost->port; my $s; my $error; eval { my $start_t = [gettimeofday]; local $SIG{'ALRM'} = sub { die "Request timeout!" }; my $timeout = $self->{'request_timeout'}; alarm($timeout); if( $self->_is_loglevel(4) ) { $self->log(4, 'request: '.$r->dump_attr); } my $instance = $r->attr('instance'); Mail::MtPolicyd::Profiler->tick('retrieve session'); $s = $self->{'session_cache'}->retrieve_session($instance); if( $self->_is_loglevel(4) ) { $self->log(4, 'session: '.Dumper($s)); } $r->session($s); Mail::MtPolicyd::Profiler->tick('run vhost'); my $result = $vhost->run($r); my $response = $result->as_policyd_response; $conn->print($response); $conn->flush; # convert to ms and round by 0.5/int my $elapsed = int(tv_interval( $start_t, [gettimeofday] ) * 100 + 0.5); my $matched = defined $result->last_match ? $result->last_match : ''; $self->log(1, $vhost->name.': instance='.$instance.', type='.$r->type.', t='.$elapsed.'ms, plugin='.$matched.', result='.$result->as_log); }; if ( $@ ) { $error = $@; } if( defined $s ) { $self->{'session_cache'}->store_session($s); } if( defined $error ) { die( $error ); } return; } sub process_request { my ( $self, $conn ) = @_; my $max_keepalive = $self->{'max_keepalive'}; my $port = $self->get_conn_port; $self->log(4, 'accepted connection on port '.$port ); for( my $alive_count = 0 ; $max_keepalive == 0 || $alive_count < $max_keepalive ; $alive_count++ ) { my $r; $self->_set_process_stat('waiting request'); Mail::MtPolicyd::Profiler->reset; eval { local $SIG{'ALRM'} = sub { die "Keepalive connection timeout" }; my $timeout = $self->{'keepalive_timeout'}; alarm($timeout); Mail::MtPolicyd::Profiler->tick('parsing request'); $r = Mail::MtPolicyd::Request->new_from_fh( $conn, 'server' => $self ); }; if ( $@ =~ /Keepalive connection timeout/ ) { $self->log(3, '['.$port.']: keepalive timeout: closing connection'); last; } elsif($@ =~ /connection closed by peer/) { $self->log(3, '['.$port.']: connection closed by peer'); last; } elsif($@) { $self->log(0, '['.$port.']: error while reading request: '.$@); last; } Mail::MtPolicyd::Profiler->tick('processing request'); my $vhost = $self->get_virtual_host($port, $r); $self->_set_process_stat($vhost->name.', processing request'); eval { $self->_process_one_request( $conn, $vhost, $r ); }; if ( $@ =~ /Request timeout!/ ) { $self->log(1, '['.$port.']: request timed out'); last; } elsif($@) { $self->log(0, 'error while processing request: '.$@); last; } Mail::MtPolicyd::Profiler->stop_current_timer; if( $self->_is_loglevel(4) ) { $self->log(4, Mail::MtPolicyd::Profiler->to_string); } } $self->log(3, '['.$port.']: closing connection'); $self->_set_process_stat('idle'); return; } sub _set_process_stat { my ( $self, $stat ) = @_; $0 = $self->{'program_name'}.' ('.$stat.')' }; sub memcached { die('the global memcached connection does no longer exist in mtpolicyd >= 2.00'); } sub get_dbh { die('the global dbh handle is no longer available in mtpolicyd >= 2.00'); } 1; __END__ =pod =encoding UTF-8 =head1 NAME Mail::MtPolicyd - a modular policy daemon for postfix =head1 VERSION version 2.03 =head1 DESCRIPTION Mail::MtPolicyd is the Net::Server class of the mtpolicyd daemon. =head2 SYNOPSIS use Mail::MtPolicyd; Mail::MtPolicyd->run; =head1 AUTHOR Markus Benning =head1 COPYRIGHT AND LICENSE This software is Copyright (c) 2014 by Markus Benning . This is free software, licensed under: The GNU General Public License, Version 2, June 1991 =cut plugin-postfixmap.t100755000000000000 525313306510157 17531 0ustar00rootroot000000000000Mail-MtPolicyd-2.03/t#!perl use strict; use warnings; use Test::More tests => 25; use Test::Exception; use Test::MockObject; use Mail::MtPolicyd::Request; use Mail::MtPolicyd::Plugin::PostfixMap; use DBI; my $p = Mail::MtPolicyd::Plugin::PostfixMap->new( name => 'postmap', db_file => "t-data/plugin-postfixmap-postmap.db", match_action => 'dunno', score => 5, ); isa_ok($p, 'Mail::MtPolicyd::Plugin::PostfixMap'); my $session = { '_instance' => 'abcd1234', }; # fake a Server object my $server = Test::MockObject->new; $server->set_isa('Net::Server'); $server->mock( 'log', sub { my ( $self, $level, $message ) = @_; print '# LOG('.$level.'): '.$message."\n" } ); my $r = Mail::MtPolicyd::Request->new( attributes => { 'instance' => 'abcd1234', 'client_address' => '192.168.0.0', }, session => $session, server => $server, use_caching => 0, ); isa_ok( $r, 'Mail::MtPolicyd::Request'); my $result; lives_ok { $result = $p->run($r); } 'execute request'; is( $result, undef, 'should not return a result' ); $r->attributes->{'client_address'} = '123.123.123.123'; lives_ok { $result = $p->run($r); } 'execute request'; isa_ok( $result, 'Mail::MtPolicyd::Plugin::Result', 'should match' ); is( $result->action, "dunno", 'must return action=dunno' ); is($session->{'score'}, 5, 'score should be 5'); $r->attributes->{'client_address'} = '123.123.124.1'; lives_ok { $result = $p->run($r); } 'execute request'; isa_ok( $result, 'Mail::MtPolicyd::Plugin::Result', 'should match' ); is( $result->action, "dunno", 'must return action=dunno' ); $r->attributes->{'client_address'} = 'fe80::250:56ff:fe85:56f5'; lives_ok { $result = $p->run($r); } 'execute request'; isa_ok( $result, 'Mail::MtPolicyd::Plugin::Result', 'should match' ); is( $result->action, "dunno", 'must return action=dunno' ); $r->attributes->{'client_address'} = 'fe81::250:56ff:eeee:ffff'; lives_ok { $result = $p->run($r); } 'execute request'; isa_ok( $result, 'Mail::MtPolicyd::Plugin::Result', 'should match' ); is( $result->action, "dunno", 'must return action=dunno' ); $p->enabled('off'); lives_ok { $result = $p->run($r); } 'execute request'; is( $result, undef, 'should do nothing' ); $p->uc_enabled('list'); $session->{'list'} = 'on'; lives_ok { $result = $p->run($r); } 'execute request'; isa_ok( $result, 'Mail::MtPolicyd::Plugin::Result', 'should match' ); is( $result->action, "dunno", 'must return action=dunno' ); $r->attributes->{'client_address'} = '192.168.0.1'; $p->not_match_action('reject no access granted'); lives_ok { $result = $p->run($r); } 'execute request'; isa_ok( $result, 'Mail::MtPolicyd::Plugin::Result', 'should match' ); is( $result->action, "reject no access granted", 'must return action=reject no access granted' ); plugin-smtpverify.t100755000000000000 324613306510157 17547 0ustar00rootroot000000000000Mail-MtPolicyd-2.03/t#!perl use strict; use warnings; use Test::More tests => 11; use Test::Exception; use Test::MockObject; use Test::Mock::Net::Server::Mail; use Mail::MtPolicyd::Request; use Mail::MtPolicyd::Plugin::SMTPVerify; my $s = Test::Mock::Net::Server::Mail->new; $s->start_ok; my $p = Mail::MtPolicyd::Plugin::SMTPVerify->new( name => 'smtpverify', host => $s->bind_address, port => $s->port, perm_fail_action => "reject %MSG%", temp_fail_action => "defer %MSG%", has_starttls_score => -5, no_starttls_score => 5, perm_fail_score => 10, ); isa_ok($p, 'Mail::MtPolicyd::Plugin::SMTPVerify'); my $session = { '_instance' => 'abcd1234', }; # fake a Server object my $server = Test::MockObject->new; $server->set_isa('Net::Server'); $server->mock( 'log', sub { my ( $self, $level, $message ) = @_; print '# LOG('.$level.'): '.$message."\n" } ); my $r = Mail::MtPolicyd::Request->new( attributes => { 'instance' => 'abcd1234', 'client_address' => '127.0.0.1', 'sender' => 'good-sender@testdomain.tld', 'recipient' => 'good-rcpt@testdomain.tld', 'size' => 10240, }, session => $session, server => $server, use_caching => 0, ); isa_ok( $r, 'Mail::MtPolicyd::Request'); my $result; lives_ok { $result = $p->run($r); } 'execute request'; is( $result, undef, 'should not match return an action' ); cmp_ok( $r->session->{'score'}, '==', -5, 'score must be 5'); $r->attributes->{'recipient'} = 'bad-rcpt@testdomain.tld'; lives_ok { $result = $p->run($r); } 'execute request'; isa_ok( $result, 'Mail::MtPolicyd::Plugin::Result' ); cmp_ok( $r->session->{'score'}, '==', 0, 'score must be 0'); like( $result->action, qr/^reject.*address rejected/, 'action' ); $s->stop_ok; plugin-regex-list.t100755000000000000 322613306510157 17420 0ustar00rootroot000000000000Mail-MtPolicyd-2.03/t#!perl use strict; use warnings; use Test::More tests => 11; use Test::Exception; use Test::MockObject; use Mail::MtPolicyd::Request; use Mail::MtPolicyd::Plugin::RegexList; my $c = Mail::MtPolicyd::Plugin::RegexList->new( name => 'regex-whitelist', key => 'r:client_name', regex => [ '^mail-[a-z][a-z]0-f[0-9]*\.google\.com$', '\.bofh-noc\.de$' ], action => 'accept', ); isa_ok($c, 'Mail::MtPolicyd::Plugin::RegexList'); my $session = { '_instance' => 'abcd1234', }; # fake a Server object my $server = Test::MockObject->new; $server->set_isa('Net::Server'); $server->mock( 'log', sub { my ( $self, $level, $message ) = @_; print '# LOG('.$level.'): '.$message."\n" } ); my $r = Mail::MtPolicyd::Request->new( attributes => { 'instance' => 'abcd1234', 'queue_id' => '4561B3D95D8B', }, session => $session, server => $server, use_caching => 0, ); isa_ok( $r, 'Mail::MtPolicyd::Request'); my $result; lives_ok { $result = $c->run($r); } 'execute request'; is( $result, undef, 'should not match' ); $r->attributes->{'client_name'} = 'zumsel.blablub.com'; lives_ok { $result = $c->run($r); } 'execute request'; is( $result, undef, 'should not match' ); $r->attributes->{'client_name'} = 'zumsel.bofh-noc.de'; lives_ok { $result = $c->run($r); } 'execute request'; isa_ok( $result, 'Mail::MtPolicyd::Plugin::Result', 'should match' ); is( $result->action, 'accept', 'check result' ); is( $result->abort, 1, 'check result' ); lives_ok { $c = Mail::MtPolicyd::Plugin::RegexList->new( name => 'regex-whitelist', key => 'r:client_name', regex => '\.bofh-noc\.de$', action => 'accept', ); } 'initialization with scalar regex'; author-pod-syntax.t100644000000000000 45413306510157 17424 0ustar00rootroot000000000000Mail-MtPolicyd-2.03/t#!perl BEGIN { unless ($ENV{AUTHOR_TESTING}) { print qq{1..0 # SKIP these tests are for testing by the author\n}; exit } } # This file was automatically generated by Dist::Zilla::Plugin::PodSyntaxTests. use strict; use warnings; use Test::More; use Test::Pod 1.41; all_pod_files_ok(); plugin-clearfields.t100755000000000000 276313306510157 17617 0ustar00rootroot000000000000Mail-MtPolicyd-2.03/t#!perl use strict; use warnings; use Test::More tests => 12; use Test::Exception; use Test::MockObject; use Mail::MtPolicyd::Request; use Mail::MtPolicyd::Plugin::ClearFields; my $c = Mail::MtPolicyd::Plugin::ClearFields->new( name => 'test', fields => 'zumsel', fields_prefix => 'sh_zen,sh_dbl', ); isa_ok($c, 'Mail::MtPolicyd::Plugin::ClearFields'); my $session = { '_instance' => 'abcd1234', 'zumsel' => 'zumsel', 'sh_zen' => 'zumsel', 'sh_zen_XBL' => 'zumsel', 'sh_zen_SBL' => 'zumsel', 'sh_dbl_helo' => 'zumsel', 'sh_dbl' => 'zumsel', 'bla' => 'zumsel', 'blub' => 'zumsel', }; # fake a Server object my $server = Test::MockObject->new; $server->set_isa('Net::Server'); $server->mock( 'log', sub { my ( $self, $level, $message ) = @_; print '# LOG('.$level.'): '.$message."\n" } ); my $r = Mail::MtPolicyd::Request->new( attributes => { 'instance' => 'abcd1234', }, session => $session, server => $server, ); isa_ok( $r, 'Mail::MtPolicyd::Request'); my $result; lives_ok { $result = $c->run($r); } 'execute request'; is( $result, undef, 'should not match' ); is( $session->{'bla'}, 'zumsel', 'check result' ); is( $session->{'blub'}, 'zumsel', 'check result' ); is( $session->{'zumsel'}, undef, 'check result' ); is( $session->{'sh_zen'}, undef, 'check result' ); is( $session->{'sh_zen_XBL'}, undef, 'check result' ); is( $session->{'sh_zen_SBL'}, undef, 'check result' ); is( $session->{'sh_dbl'}, undef, 'check result' ); is( $session->{'sh_dbl_helo'}, undef, 'check result' ); plugin-sa-awl-action.t100755000000000000 421513306510157 17773 0ustar00rootroot000000000000Mail-MtPolicyd-2.03/t#!perl use strict; use warnings; use Test::More tests => 18; use Test::Exception; use Test::MockObject; use Mail::MtPolicyd::Request; use Mail::MtPolicyd::Plugin::SaAwlLookup; use Mail::MtPolicyd::Plugin::SaAwlAction; my $p = Mail::MtPolicyd::Plugin::SaAwlAction->new( name => 'sa-awl-test', enabled => 'on', result_from => 'amavis', ); isa_ok($p, 'Mail::MtPolicyd::Plugin::SaAwlAction'); my $session = { '_instance' => 'abcd1234', 'sa-awl-amavis-result' => [ 100, 1.4 ], }; # fake a Server object my $server = Test::MockObject->new; $server->set_isa('Net::Server'); $server->mock( 'log', sub { my ( $self, $level, $message ) = @_; print '# LOG('.$level.'): '.$message."\n" } ); my $r = Mail::MtPolicyd::Request->new( attributes => { 'instance' => 'abcd1234', 'client_address' => '12.34.56.78', 'sender' => 'good@mtpolicyd.org', }, session => $session, server => $server, use_caching => 0, ); isa_ok( $r, 'Mail::MtPolicyd::Request'); my $result; lives_ok { $result = $p->run($r); } 'execute request'; is( $result, undef, 'should not match' ); $session->{'sa-awl-amavis-result'} = [100, 20]; lives_ok { $result = $p->run($r); } 'execute request'; isa_ok( $result, 'Mail::MtPolicyd::Plugin::Result', 'must match' ); like( $result->action, qr/^reject/, 'must return an reject action' ); $p->mode('passive'); $p->score_factor(0.5); lives_ok { $result = $p->run($r); } 'execute request'; is( $result, undef, 'should never match (mode passive)' ); cmp_ok( $session->{'score'}, '==', 10, 'score must be 10 (20 * factor 0.5)'); $session->{'score'} = 0; $p->score_factor(undef); $p->score(5); lives_ok { $result = $p->run($r); } 'execute request'; is( $result, undef, 'should never match (mode passive)' ); cmp_ok( $session->{'score'}, '==', 5, 'score must be 5'); $p->mode('accept'); $p->threshold(-1); $p->match('lt'); lives_ok { $result = $p->run($r); } 'execute request'; is( $result, undef, 'should not match' ); $session->{'sa-awl-amavis-result'} = [100, -5]; lives_ok { $result = $p->run($r); } 'execute request'; isa_ok( $result, 'Mail::MtPolicyd::Plugin::Result', 'must match' ); cmp_ok( $result->action, 'eq', 'dunno', 'action must be dunno' ); plugin-sa-awl-lookup.t100755000000000000 374413306510157 20035 0ustar00rootroot000000000000Mail-MtPolicyd-2.03/t#!perl use strict; use warnings; use Test::More tests => 12; use Test::Exception; use Test::MockObject; use Mail::MtPolicyd::Request; use Mail::MtPolicyd::Plugin::SaAwlLookup; my $p = Mail::MtPolicyd::Plugin::SaAwlLookup->new( name => 'sa-awl', enabled => 'on', db_file => '/dev/null', _awl => { 'good@mtpolicyd.org|ip=12.34|totscore' => 20, 'good@mtpolicyd.org|ip=12.34' => 100, 'bad@mtpolicyd.org|ip=12.34|totscore' => 2000, 'bad@mtpolicyd.org|ip=12.34' => 100, 'low@mtpolicyd.org|ip=12.34' => 1, 'low@mtpolicyd.org|ip=12.34' => 1, }, ); isa_ok($p, 'Mail::MtPolicyd::Plugin::SaAwlLookup'); my $session = { '_instance' => 'abcd1234', }; # fake a Server object my $server = Test::MockObject->new; $server->set_isa('Net::Server'); $server->mock( 'log', sub { my ( $self, $level, $message ) = @_; print '# LOG('.$level.'): '.$message."\n" } ); my $r = Mail::MtPolicyd::Request->new( attributes => { 'instance' => 'abcd1234', 'client_address' => '12.34.56.78', 'sender' => 'good@mtpolicyd.org', }, session => $session, server => $server, use_caching => 0, ); isa_ok( $r, 'Mail::MtPolicyd::Request'); my $result; lives_ok { $result = $p->run($r); } 'execute request'; is( $result, undef, 'should never match' ); cmp_ok( $p->truncate_ip('12.34.56.78'), 'eq', '12.34', 'ipv4 must be truncated correctly'); cmp_ok( $p->truncate_ip('2a01:4f8:d12:242::2'), 'eq', '2A01:04F8:0D12::', 'ipv6 must be truncated correctly'); lives_ok { $result = $p->run($r); } 'execute request'; is( $result, undef, 'should never match' ); $r->attributes->{'sender'} = 'bad@mtpolicyd.org'; $r->use_caching(1); lives_ok { $result = $p->run($r); } 'execute request'; ok( defined $session->{'sa-awl-sa-awl-result'}, 'result must be stored in session'); my $reputation = $session->{'sa-awl-sa-awl-result'}; cmp_ok( $reputation->[0], '==', 100, 'count in reputation must be 100'); cmp_ok( $reputation->[1], '==', 20, 'score in reputation must be 20'); plugin-sqluserconfig.t100755000000000000 323713306510157 20223 0ustar00rootroot000000000000Mail-MtPolicyd-2.03/t#!perl use strict; use warnings; use Test::More tests => 5; use Test::Exception; use Test::MockObject; use Mail::MtPolicyd::ConnectionPool; use Mail::MtPolicyd::Request; use Mail::MtPolicyd::Plugin::SqlUserConfig; use DBI; my $p = Mail::MtPolicyd::Plugin::SqlUserConfig->new( name => 'sqluserconfig-test', sql_query => "SELECT config FROM user_config WHERE address=?", ); isa_ok($p, 'Mail::MtPolicyd::Plugin::SqlUserConfig'); my $session = { '_instance' => 'abcd1234', }; # build a fake database with an in-memory SQLite DB Mail::MtPolicyd::ConnectionPool->load_connection( 'db', { module => 'Sql', dsn => 'dbi:SQLite::memory:', user => '', password => '', } ); my $dbh = Mail::MtPolicyd::ConnectionPool->get_handle('db'); $dbh->do( 'CREATE TABLE `user_config` ( `id` INTEGER PRIMARY KEY AUTOINCREMENT, `address` varchar(255) DEFAULT NULL, `config` TEXT NOT NULL )' ); # insert test data $dbh->do("INSERT INTO `user_config` VALUES (NULL, 'ich\@markusbenning.de', '{ \"test\": \"bla\" }');"); # fake a Server object my $server = Test::MockObject->new; $server->set_isa('Net::Server'); $server->mock( 'log', sub { my ( $self, $level, $message ) = @_; print '# LOG('.$level.'): '.$message."\n" } ); $server->mock( 'get_dbh', sub { return $dbh; } ); my $r = Mail::MtPolicyd::Request->new( attributes => { 'instance' => 'abcd1234', 'recipient' => 'ich@markusbenning.de', }, session => $session, server => $server, ); isa_ok( $r, 'Mail::MtPolicyd::Request'); my $result; lives_ok { $result = $p->run($r); } 'execute request'; is( $result, undef, 'should not return a result' ); is( $session->{'test'}, 'bla', 'field test should be bla in session'); server-minimal.feature100644000000000000 73213306510157 20137 0ustar00rootroot000000000000Mail-MtPolicyd-2.03/tFeature: the mtpolicyd must be able to start The mtpolicyd must be able to start up with a basic config file. Scenario: mtpolicyd startup with minimal configuration Given that a mtpolicyd is running with configuration t-data/minimal.conf When the following request is executed on mtpolicyd: """ client_address=84.204.103.98 """ Then mtpolicyd must respond with a action like ^reject test And the mtpolicyd server must be stopped successfull plugin-role-sqlutils.t100755000000000000 775013306510157 20162 0ustar00rootroot000000000000Mail-MtPolicyd-2.03/t#!perl use strict; use warnings; use Test::More tests => 23; use Test::Exception; use Mail::MtPolicyd::ConnectionPool; package Mail::MtPolicyd::Plugin::TestSqlUtils; use Moose; extends 'Mail::MtPolicyd::Plugin'; with 'Mail::MtPolicyd::Role::Connection' => { name => 'db', type => 'Sql', }; with 'Mail::MtPolicyd::Plugin::Role::SqlUtils'; package Mail::MtPolicyd::Plugin::TestSqlUtilsMySQL; use Moose; use Test::MockObject; extends 'Mail::MtPolicyd::Plugin'; has '_db_handle' => ( is => 'ro', default => sub { my $dbh = Test::MockObject->new(); $dbh->mock( 'quote_identifier', sub { my $self = shift; return shift; } ); $dbh->{'Driver'} = {'Name' => 'mysql'}; $dbh->mock( 'do', sub { my $self = shift; $self->{'do_sql'} = shift; return; } ); return $dbh; }, ); with 'Mail::MtPolicyd::Plugin::Role::SqlUtils'; package main; import Mail::MtPolicyd::Plugin::TestSqlUtils; import Mail::MtPolicyd::Plugin::TestSqlUtilsMySQL; my $sql = Mail::MtPolicyd::Plugin::TestSqlUtils->new( name => 'sqlutils-test', ); isa_ok($sql, 'Mail::MtPolicyd::Plugin::TestSqlUtils'); throws_ok { $sql->init(); } qr/no connection db configured!/, 'must die in init() when db unavailable'; # build a fake database with an in-memory SQLite DB Mail::MtPolicyd::ConnectionPool->load_connection( 'db', { module => 'Sql', dsn => 'dbi:SQLite::memory:', user => '', password => '', } ); lives_ok { $sql->init(); } 'init() when db available'; throws_ok { $sql->create_sql_table('table', {} ); } qr/no data definition for table/, 'must fail without a definition for driver'; throws_ok { $sql->create_sql_table('table', { '*' => 'bla' } ); } qr/syntax error/, 'must use * CREATE and fail with syntax error'; throws_ok { $sql->create_sql_table('table', { 'SQLite' => 'blub', '*' => 'bla' } ); } qr/blub/, 'must use SQLite CREATE and fail with syntax error'; ok( ! $sql->sql_table_exists('zumsel'), 'table does not exist' ); lives_ok { $sql->create_sql_table('zumsel', { 'SQLite' => 'CREATE TABLE %TABLE_NAME% ( `id` INTEGER PRIMARY KEY AUTOINCREMENT, `client_ip` varchar(255) DEFAULT NULL )' } ); } 'must create table zumsel'; ok( $sql->sql_table_exists('zumsel'), 'table must exist' ); lives_ok { $sql->check_sql_tables( 'zumsel' => { '*' => 'bla' }, ); } 'must not try to create table if it already exists'; throws_ok { $sql->check_sql_tables( 'zumsel' => { '*' => 'blub' }, 'bla' => { '*' => 'bla' }, ); } qr/near "bla": syntax error/, 'must try to create table if it does not exist and fail'; my $sth; lives_ok { $sth = $sql->execute_sql('SELECT 1'); } 'execute_sql must live'; isa_ok( $sth, 'DBI::st'); throws_ok { $sth = $sql->execute_sql('bla'); } qr/syntax error/, 'execute_sql must die on error'; # # MySQL settings tests # $sql = Mail::MtPolicyd::Plugin::TestSqlUtilsMySQL->new( name => 'sqlutils-mysql-test', ); isa_ok($sql, 'Mail::MtPolicyd::Plugin::TestSqlUtilsMySQL'); lives_ok { $sql->init(); } 'init() when db available'; lives_ok { $sql->create_sql_table('zumsel', { 'mysql' => 'CREATE TABLE %TABLE_NAME% ( `id` INTEGER PRIMARY KEY AUTOINCREMENT, `client_ip` varchar(255) DEFAULT NULL ) ENGINE=%MYSQL_ENGINE% DEFAULT CHARSET=latin1' } ); } 'should not fail (mocked)'; like($sql->_db_handle->{'do_sql'}, qr/CREATE TABLE zumsel/, 'table name must be set'); like($sql->_db_handle->{'do_sql'}, qr/ENGINE=MyISAM/, 'engine must be set to MyISAM (default)'); lives_ok { $sql->mysql_engine('InnoDB'); } 'setting mysql_engine must live'; lives_ok { $sql->create_sql_table('blablub', { 'mysql' => 'CREATE TABLE %TABLE_NAME% ( `id` INTEGER PRIMARY KEY AUTOINCREMENT, `client_ip` varchar(255) DEFAULT NULL ) ENGINE=%MYSQL_ENGINE% DEFAULT CHARSET=latin1' } ); } 'should not fail (mocked)'; like($sql->_db_handle->{'do_sql'}, qr/CREATE TABLE blablub/, 'table name must be set'); like($sql->_db_handle->{'do_sql'}, qr/ENGINE=InnoDB/, 'engine must be set to InnoDB'); mtpolicyd.init-redhat100755000000000000 336213306510157 20346 0ustar00rootroot000000000000Mail-MtPolicyd-2.03/rpm#!/bin/bash # # mtpolicyd Startup script for mtpolicyd. # # chkconfig: - 79 31 # description: a postfix policy daemon used by the mailteam ### BEGIN INIT INFO # Provides: $mtpolicyd # Default-Start: 2 3 4 5 # Default-Stop: 0 1 6 # Short-Description: a postfix policy daemon used by the mailteam # Description: mtpolicyd is a postfix policy daemon able to provide # advanced checks into postfix. ### END INIT INFO # Source function library. . /etc/init.d/functions RETVAL=0 PIDFILE=/var/run/mtpolicyd/mtpolicyd.pid prog=mtpolicyd exec=/usr/bin/mtpolicyd lockfile=/var/lock/subsys/$prog # Source config if [ -f /etc/sysconfig/$prog ] ; then . /etc/sysconfig/$prog fi start() { [ -x $exec ] || exit 5 umask 077 echo -n $"Starting mtpolicyd: " daemon $exec RETVAL=$? echo [ $RETVAL -eq 0 ] && touch $lockfile return $RETVAL } stop() { echo -n $"Shutting down mtpolicyd: " killproc -p "$PIDFILE" $exec RETVAL=$? echo [ $RETVAL -eq 0 ] && rm -f $lockfile return $RETVAL } rhstatus() { status -p "$PIDFILE" -l $prog $exec } restart() { stop start } reload() { echo -n $"Reloading mtpolicyd: " killproc -p "$PIDFILE" $exec -HUP RETVAL=$? echo } case "$1" in start) start ;; stop) stop ;; restart) restart ;; reload) reload ;; force-reload) restart ;; status) rhstatus ;; condrestart|try-restart) rhstatus >/dev/null 2>&1 || exit 0 restart ;; *) echo $"Usage: $0 {start|stop|restart|condrestart|try-restart|reload|force-reload|status}" exit 3 esac exit $? spamhaus-rbls.conf100755000000000000 360513306510157 20214 0ustar00rootroot000000000000Mail-MtPolicyd-2.03/t-data# -*- apache -*- #keepalive_timeout=60 keepalive_timeout=0 # should be the same value as smtpd_policy_service_reuse_count_limit (postfix >2.12) max_keepalive=0 #max_keepalive=100 # timeout for processing of one request in seconds request_timeout=20 # database connection as perl-DBI DSN (man DBI) db_dsn= db_user= db_password= # memcached connection for session caching memcached_servers="127.0.0.1:[% memcached_port %]" # memcached_namespace=mt- # memcached_expire=300 # wait timeout will be increased each time 50,100,150,... (usec) session_lock_wait=50 # abort after n retries session_lock_max_retry=50 # session lock times out after (sec) session_lock_timeout=10 name="spamhaus" module = "RBL" mode = "passive" domain="zen.spamhaus.org" module = "RBLAction" result_from = "spamhaus-rbl" mode = "reject" re_match = "^127\.0\.0\.[23]$" reject_message="SBL" module = "RBLAction" result_from = "spamhaus-rbl" mode = "reject" re_match = "^127\.0\.0\.[4-7]$" reject_message="XBL" module = "RBLAction" result_from = "spamhaus-rbl" mode = "reject" re_match = "^127\.0\.0\.1[01]$" reject_message="PBL" module = "DBL" domain="dbl.spamhaus.org" helo_name_mode=reject sender_mode=reject reverse_client_name_mode=reject reject_message="DBL %CHECK%" plugin-ldapuserconfig.t100755000000000000 331213306510157 20336 0ustar00rootroot000000000000Mail-MtPolicyd-2.03/t#!perl use strict; use warnings; use Test::More tests => 5; use Test::Exception; use Test::MockObject; use Mail::MtPolicyd::ConnectionPool; use Mail::MtPolicyd::Request; use Mail::MtPolicyd::Plugin::LdapUserConfig; use DBI; my $p = Mail::MtPolicyd::Plugin::LdapUserConfig->new( name => 'ldapuserconfig-test', basedn => 'ou=users,dc=domain,dc=com', filter => '(mail=%s)', filter_field => 'sasl_username', config_fields => 'gn,sn,mailMessageLimit', ); isa_ok($p, 'Mail::MtPolicyd::Plugin::LdapUserConfig'); my $session = { '_instance' => 'abcd1234', }; # build a moch LdapConnection Mail::MtPolicyd::ConnectionPool->load_connection('ldap', { module => 'Ldap', host => 'dummy', port => 389, binddn => 'cn=readonly,dc=domain,dc=com', password => 'secret', starttls => 1, connection_class => 'Test::Net::LDAP::Mock', } ); my $ldap = Mail::MtPolicyd::ConnectionPool->get_handle('ldap'); $ldap->add('uid=max,ou=users,dc=domain,dc=com', attrs => [ uid => 'max', gn => 'Max', sn => 'Mustermann', mail => 'max.mustermann@domain.com', mailMessageLimit => 2000, ]); # fake a Server object my $server = Test::MockObject->new; $server->set_isa('Net::Server'); $server->mock( 'log', sub { my ( $self, $level, $message ) = @_; print '# LOG('.$level.'): '.$message."\n" } ); my $r = Mail::MtPolicyd::Request->new( attributes => { 'instance' => 'abcd1234', 'sasl_username' => 'max.mustermann@domain.com', }, session => $session, server => $server, ); isa_ok( $r, 'Mail::MtPolicyd::Request'); my $result; lives_ok { $result = $p->run($r); } 'execute request'; is( $result, undef, 'should not return a result' ); cmp_ok( $session->{'mailMessageLimit'}, '==', 2000, 'mailMessageLimit must be set'); execute-cucumber-tests.t100644000000000000 70613306510157 20423 0ustar00rootroot000000000000Mail-MtPolicyd-2.03/t#!perl use strict; use warnings; use Test::More; eval { require Test::BDD::Cucumber::Loader; require Test::BDD::Cucumber::Harness::TestBuilder; }; if( $@ ) { plan skip_all => 'module Test::BDD::Cucumber not installed'; } my ( $executor, @features ) = Test::BDD::Cucumber::Loader->load( 't/' ); my $harness = Test::BDD::Cucumber::Harness::TestBuilder->new({}); $executor->execute( $_, $harness ) for @features; done_testing; plugin-accounting-quota.t100755000000000000 1266313306510157 20643 0ustar00rootroot000000000000Mail-MtPolicyd-2.03/t#!perl use strict; use warnings; use Test::More tests => 65; use Test::Exception; use Test::MockObject; use Mail::MtPolicyd::Request; use Mail::MtPolicyd::ConnectionPool; use Mail::MtPolicyd::Plugin::Accounting; use Mail::MtPolicyd::Plugin::Quota; use DBI; my $p = Mail::MtPolicyd::Plugin::Accounting->new( name => 'acct_test', fields => 'client_address,sender,recipient', ); isa_ok($p, 'Mail::MtPolicyd::Plugin::Accounting'); # build a fake database with an in-memory SQLite DB Mail::MtPolicyd::ConnectionPool->load_connection( 'db', { module => 'Sql', dsn => 'dbi:SQLite::memory:', user => '', password => '', } ); lives_ok { $p->init(); } 'plugin initialization'; my $session = { '_instance' => 'abcd1234', }; # fake a Server object my $server = Test::MockObject->new; $server->set_isa('Net::Server'); $server->mock( 'log', sub { my ( $self, $level, $message ) = @_; print '# LOG('.$level.'): '.$message."\n" } ); my $r = Mail::MtPolicyd::Request->new( attributes => { 'instance' => 'abcd1234', 'client_address' => '192.168.0.1', 'sender' => 'sender@testdomain.de', 'recipient' => 'newrcpt@mydomain.de', 'size' => '13371', 'recipient_count' => '0', }, session => $session, server => $server, use_caching => 0, ); isa_ok( $r, 'Mail::MtPolicyd::Request'); sub cmp_table_numrows_ok { my ( $table, $op, $rows, $desc ) = @_; my $dbh = Mail::MtPolicyd::ConnectionPool->get_handle('db'); my $table_name = $dbh->quote_identifier( $table ); my $sql = "SELECT * FROM $table_name"; my $sth = $dbh->prepare( $sql ); $sth->execute; $sth->fetchall_arrayref; return cmp_ok( $sth->rows, $op, $rows, $desc); } sub cmp_table_value_ok { my ( $table, $key, $field, $op, $count ) = @_; my $dbh = Mail::MtPolicyd::ConnectionPool->get_handle('db'); my $table_name = $dbh->quote_identifier( $table ); my $field_name = $dbh->quote_identifier( $field ); my $key_name = $dbh->quote_identifier('key'); my $key_value = $dbh->quote($key); my $sql = "SELECT $field_name FROM $table_name WHERE $key_name=$key_value"; my $sth = $dbh->prepare( $sql ); $sth->execute; my $row = $sth->fetchrow_arrayref; my $desc = "counter $field in table $table for $key"; return cmp_ok( $row->[0], $op, $count, $desc); } my $result; lives_ok { $result = $p->run($r); } 'execute request'; ok( ! defined $result, 'should never return something' ); cmp_table_numrows_ok('acct_client_address', '==', 1, 'table must have 1 row'); cmp_table_numrows_ok('acct_sender', '==', 1, 'table must have 1 row'); cmp_table_numrows_ok('acct_recipient', '==', 1, 'table must have 1 row'); foreach my $cnt (1..10) { lives_ok { $result = $p->run($r); } 'execute request '.$cnt; } cmp_table_numrows_ok('acct_client_address', '==', 1, 'table must have 1 row'); cmp_table_numrows_ok('acct_sender', '==', 1, 'table must have 1 row'); cmp_table_numrows_ok('acct_recipient', '==', 1, 'table must have 1 row'); foreach my $cnt (1..10) { $r->attributes->{'client_address'} = "192.168.1.$cnt"; lives_ok { $result = $p->run($r); } 'execute request for client_address '.$cnt; } cmp_table_numrows_ok('acct_client_address', '==', 11, 'table must have 1 row'); cmp_table_numrows_ok('acct_sender', '==', 1, 'table must have 1 row'); cmp_table_numrows_ok('acct_recipient', '==', 1, 'table must have 1 row'); $r->attributes->{'client_address'} = '192.168.2.1'; $r->attributes->{'recipient_count'} = '10'; foreach my $cnt (1..10) { $r->attributes->{'sender'} = 'sender'.$cnt.'@testdomain.de'; lives_ok { $result = $p->run($r); } 'execute request for sender '.$cnt; } cmp_table_numrows_ok('acct_client_address', '==', 12, 'table must have 12 rows'); cmp_table_numrows_ok('acct_sender', '==', 11, 'table must have 11 rows'); cmp_table_numrows_ok('acct_recipient', '==', 1, 'table must have 1 row'); # now check some counters cmp_table_value_ok('acct_client_address', '192.168.0.1', 'count', '==', '11'); cmp_table_value_ok('acct_client_address', '192.168.0.1', 'count_rcpt', '==', '11'); cmp_table_value_ok('acct_client_address', '192.168.0.1', 'size', '==', '147081'); cmp_table_value_ok('acct_client_address', '192.168.0.1', 'size_rcpt', '==', '147081'); cmp_table_value_ok('acct_client_address', '192.168.1.1', 'count', '==', '1'); cmp_table_value_ok('acct_client_address', '192.168.1.1', 'count_rcpt', '==', '1'); cmp_table_value_ok('acct_client_address', '192.168.1.1', 'size', '==', '13371'); cmp_table_value_ok('acct_client_address', '192.168.1.1', 'size_rcpt', '==', '13371'); cmp_table_value_ok('acct_client_address', '192.168.2.1', 'count', '==', '10'); cmp_table_value_ok('acct_client_address', '192.168.2.1', 'count_rcpt', '==', '100'); cmp_table_value_ok('acct_client_address', '192.168.2.1', 'size', '==', '133710'); cmp_table_value_ok('acct_client_address', '192.168.2.1', 'size_rcpt', '==', '1337100'); # Plugin::Quota checks $p = Mail::MtPolicyd::Plugin::Quota->new( name => 'quota_test', field => 'client_address', metric => 'count', threshold => 1000, ); isa_ok($p, 'Mail::MtPolicyd::Plugin::Quota'); $r->attributes->{'client_address'} = '192.168.0.1'; lives_ok { $result = $p->run($r); } 'execute request'; is( $result, undef, 'should not match' ); $p->threshold(11); lives_ok { $result = $p->run($r); } 'execute request'; isa_ok( $result, 'Mail::MtPolicyd::Plugin::Result', 'should match' ); cmp_ok( $result->action, 'eq', 'defer smtp traffic quota has been exceeded', 'check action'); MtPolicyd000755000000000000 013306510157 16577 5ustar00rootroot000000000000Mail-MtPolicyd-2.03/lib/MailClient.pm100644000000000000 537213306510157 20522 0ustar00rootroot000000000000Mail-MtPolicyd-2.03/lib/Mail/MtPolicydpackage Mail::MtPolicyd::Client; use Moose; our $VERSION = '2.03'; # VERSION # ABSTRACT: a policyd client class use IO::Socket::UNIX; use IO::Socket::INET; use Mail::MtPolicyd::Client::Response; has 'socket_path' => ( is => 'rw', isa => 'Maybe[Str]' ); has 'host' => ( is => 'rw', isa => 'Str', default => 'localhost:12345' ); has 'keepalive' => ( is => 'rw', isa => 'Bool', default => 0 ); has '_fh' => ( is => 'rw', isa => 'Maybe[IO::Handle]' ); sub _connect { my $self = shift; my $fh; if( defined $self->socket_path ) { $fh = IO::Socket::UNIX->new( Peer => $self->socket_path, autoflush => 0, ) or die('could not connect to socket: '.$!); } else { $fh = IO::Socket::INET->new( PeerAddr => $self->host, Proto => 'tcp', autoflush => 0, ) or die('could not connect to host: '.$!); } $self->_fh( $fh ); } sub _disconnect { my $self = shift; $self->_fh->close; $self->_fh( undef ); } sub _is_connected { my $self = shift; if( defined $self->_fh ) { return(1); } return(0); } sub request { my ( $self, $request ) = @_; if( ! $self->_is_connected ) { $self->_connect; } $self->_fh->print( $request->as_string ); $self->_fh->flush; my $response = Mail::MtPolicyd::Client::Response->new_from_fh( $self->_fh ); # close connection we're not doing keepalive # or if the server already closed connection (server side keepalive off) if( ! $self->keepalive || $self->_fh->eof ) { $self->_disconnect; } return $response; } 1; __END__ =pod =encoding UTF-8 =head1 NAME Mail::MtPolicyd::Client - a policyd client class =head1 VERSION version 2.03 =head1 DESCRIPTION Client class to query a policyd server. =head2 SYNOPSIS use Mail::MtPolicyd::Client; use Mail::MtPolicyd::Client::Request; my $client = Mail::MtPolicyd::Client->new( host => 'localhost:12345', keepalive => 1, ); my $request = Mail::MtPolicyd::Client::Request->new( 'client_address' => '192.168.0.1', ); my $response = $client->request( $request ); print $response->as_string; =head2 METHODS =over =item request ( $request ) Will send a Mail::MtPolicyd::Client::Request to the remote host and return a Mail::MtPolicyd::Client::Response. =back =head2 ATTRIBUTES =over =item socket_path (default: undef) Path of a socket of the policyd server. If defined this socket will be used instead of a tcp connection. =item host (default: localhost:12345) Remote address/port of the policyd server. =item keepalive (default: 0) Keep connection open for multiple requests. =back =head1 AUTHOR Markus Benning =head1 COPYRIGHT AND LICENSE This software is Copyright (c) 2014 by Markus Benning . This is free software, licensed under: The GNU General Public License, Version 2, June 1991 =cut Plugin.pm100644000000000000 315713306510157 20541 0ustar00rootroot000000000000Mail-MtPolicyd-2.03/lib/Mail/MtPolicydpackage Mail::MtPolicyd::Plugin; use Moose; use namespace::autoclean; our $VERSION = '2.03'; # VERSION # ABSTRACT: a base class for plugins has 'name' => ( is => 'rw', isa => 'Str', required => 1 ); has 'log_level' => ( is => 'ro', isa => 'Int', default => 4 ); has 'vhost_name' => ( is => 'ro', isa => 'Maybe[Str]' ); has 'on_error' => ( is => 'ro', isa => 'Maybe[Str]' ); sub run { my ( $self, $r ) = @_; die('plugin did not implement run method!'); } sub log { my ($self, $r, $msg) = @_; if( defined $self->vhost_name ) { $msg = $self->vhost_name.': '.$msg; } $r->log($self->log_level, $msg); return; } sub init { return; } sub cron { return; } __PACKAGE__->meta->make_immutable; 1; __END__ =pod =encoding UTF-8 =head1 NAME Mail::MtPolicyd::Plugin - a base class for plugins =head1 VERSION version 2.03 =head1 ATTRIBUTES =head2 name Contains a string with the name of this plugin as specified in the configuration. =head2 log_level (default: 4) The log_level used when the plugin calls $self->log( $r, $msg ). =head1 METHODS =head2 run( $r ) This method has be implemented by the plugin which inherits from this base class. =head2 log( $r, $msg ) This method could be used by the plugin to log something. Since this is mostly for debugging the default is to log plugin specific messages with log_level=4. (see log_level attribute) =head1 AUTHOR Markus Benning =head1 COPYRIGHT AND LICENSE This software is Copyright (c) 2014 by Markus Benning . This is free software, licensed under: The GNU General Public License, Version 2, June 1991 =cut Result.pm100644000000000000 243513306510157 20557 0ustar00rootroot000000000000Mail-MtPolicyd-2.03/lib/Mail/MtPolicydpackage Mail::MtPolicyd::Result; use Moose; use namespace::autoclean; our $VERSION = '2.03'; # VERSION # ABSTRACT: class to hold the results of a request returned by plugins has 'plugin_results' => ( is => 'ro', isa => 'ArrayRef[Mail::MtPolicyd::Plugin::Result]', lazy => 1, default => sub { [] }, traits => [ 'Array' ], handles => { 'add_plugin_result' => 'push', }, ); has 'last_match' => ( is => 'rw', isa => 'Maybe[Str]' ); sub actions { my $self = shift; return map { defined $_->action ? $_->action : () } @{$self->plugin_results}; } sub as_log { my $self = shift; return join(',', $self->actions); } sub as_policyd_response { my $self = shift; my @actions = $self->actions; if( ! @actions ) { # we have nothing to say return("action=dunno\n\n"); } return('action='.join("\naction=", @actions)."\n\n"); } __PACKAGE__->meta->make_immutable; 1; __END__ =pod =encoding UTF-8 =head1 NAME Mail::MtPolicyd::Result - class to hold the results of a request returned by plugins =head1 VERSION version 2.03 =head1 AUTHOR Markus Benning =head1 COPYRIGHT AND LICENSE This software is Copyright (c) 2014 by Markus Benning . This is free software, licensed under: The GNU General Public License, Version 2, June 1991 =cut Request.pm100644000000000000 1402613306510157 20750 0ustar00rootroot000000000000Mail-MtPolicyd-2.03/lib/Mail/MtPolicydpackage Mail::MtPolicyd::Request; use Moose; use namespace::autoclean; use Mail::MtPolicyd::Plugin::Result; our $VERSION = '2.03'; # VERSION # ABSTRACT: the request object has 'attributes' => ( is => 'ro', isa => 'HashRef', required => 1, traits => [ 'Hash' ], handles => { 'attr' => 'get' }, ); # gets attached later has 'session' => ( is => 'rw', isa => 'Maybe[HashRef]' ); has 'server' => ( is => 'ro', isa => 'Net::Server', required => 1, handles => { 'log' => 'log', } ); has 'type' => ( is => 'ro', isa => 'Str', lazy => 1, default => sub { my $self = shift; return( $self->attr('request') ); } ); has 'use_caching' => ( is => 'rw', isa => 'Bool', default => 1 ); sub dump_attr { my $self = shift; my $attr = $self->attributes; return( join(', ', map { $_.'='.$attr->{$_} } keys %$attr ) ); } sub get { my ( $self, $value ) = @_; my ($scope, $name); if( ! defined $value || $value eq '' ) { return; } my @params = split(':', $value, 2); if( scalar(@params) == 2 ) { ( $scope, $name ) = @params; } elsif( scalar(@params) == 1) { ( $scope, $name ) = ( 'request', @params ); } if( $scope eq 'session' || $scope eq 's' ) { if( ! defined $self->session ) { return; } return $self->session->{$name}; } elsif( $scope eq 'request' || $scope eq 'r' ) { return $self->attr( $name ); } die("unknown scope $scope while retrieving variable for $value"); return; } sub new_from_fh { my ( $class, $fh ) = ( shift, shift ); my $attr = {}; my $complete = 0; my $line; while( defined( $line = $fh->getline ) ) { $line =~ s/\r?\n$//; if( $line eq '') { $complete = 1 ; last; } my ( $name, $value ) = split('=', $line, 2); if( ! defined $value ) { die('error parsing request'); } $attr->{$name} = $value; } if( $fh->error ) { die('while reading request: '.$fh->error); } if( ! defined $line && ! $complete ) { die('connection closed by peer'); } if( ! $complete ) { die('could not parse request'); } my $obj = $class->new( 'attributes' => $attr, @_ ); return $obj; } sub do_cached { my ( $self, $key, $call ) = @_; my $session = $self->session; # we cant cache a result without session if( ! defined $session || ! $self->use_caching ) { return( $call->() ); } if( ! defined $session->{$key} ) { $session->{$key} = [ $call->() ]; } return( @{$session->{$key}} ); } sub is_already_done { my ( $self, $key ) = @_; my $session = $self->session; # we cant cache a result without session if( ! defined $session || ! $self->use_caching ) { return 0; } if( defined $session->{$key} ) { return(1); } $session->{$key} = 1; return 0; } sub is_attr_defined { my ( $self, @fields ) = @_; my $a = $self->attributes; foreach my $field ( @fields ) { if( ! defined $a->{$field} || $a->{$field} eq '' || $a->{$field} =~ /^\s+$/ ) { return 0; } } return 1; } __PACKAGE__->meta->make_immutable; 1; __END__ =pod =encoding UTF-8 =head1 NAME Mail::MtPolicyd::Request - the request object =head1 VERSION version 2.03 =head1 ATTRIBUTES =head2 attributes Contains an HashRef with all attributes of the request. To retrieve a single attribute the attr method could be used: $obj->attr('sender'); =head2 session Contains a HashRef with all values stored in the session. mtpolicyd will persist the content of this HashRef across requests with the same instance_id. =head2 server Contains the Net::Server object of mtpolicyd. =head2 type The type of the request. Postfix will always use 'smtpd_access_policy'. =head2 use_caching Could be used to disable caching. Only used within the unit tests. =head1 METHODS =head2 dump_attr Returns an string to dump the content of a request. =head2 get($variable_name) Retrieve value of a session or request variable. The format for the variable name is (:)? If no scope is given it default to the request scope. Valid scopes are: =over =item session, s Session variables. =item request, r Request attributes. =back For example: $r->get('request:sender'); # retrieve sender from request $r->get('r:sender'); # short format $r->get('sender'); # scope defaults to request $r->get('session:user_policy'); # retrieve session variable user_policy $r->get('s:user_policy'); # the same =head2 new_from_fh($fh) An object constructor for creating an request object with the content read for the supplied filehandle $fh. Will die if am error ocours: =over =item error parsing request A line in the request could not be parsed. =item while reading request: The filehandle had an error while reading the request. =item connection closed by peer Connection has been closed while reading the request. =item could not parse request The client did not send a complete request. =back =head2 do_cached( $key, $sub ) This method will execute the function reference give in $sub and store the return values in $key within the session. If there is already a cached result stored within $key of the session it will return the content instead of calling the reference again. Returns an Array with the return values of the function call. Example: my ( $ip_result, $info ) = $r->do_cached('rbl-'.$self->name.'-result', sub { $self->_rbl->check( $ip ) } ); =head2 is_already_done( $key ) This function will raise an flag with name of $key within the session and return true if the flag is already set. False otherwise. This could be used to prevent scores or headers from being applied a second time. Example: if( defined $self->score && ! $r->is_already_done('rbl-'.$self->name.'-score') ) { $self->add_score($r, $self->name => $self->score); } =head2 is_attr_defined Returns true if all given attribute names are defined and non-empty. =head1 AUTHOR Markus Benning =head1 COPYRIGHT AND LICENSE This software is Copyright (c) 2014 by Markus Benning . This is free software, licensed under: The GNU General Public License, Version 2, June 1991 =cut Profiler.pm100644000000000000 330713306510157 21062 0ustar00rootroot000000000000Mail-MtPolicyd-2.03/lib/Mail/MtPolicydpackage Mail::MtPolicyd::Profiler; use strict; use warnings; use MooseX::Singleton; use namespace::autoclean; use Mail::MtPolicyd::Profiler::Timer; use JSON; our $VERSION = '2.03'; # VERSION # ABSTRACT: a application level profiler for mtpolicyd has 'root' => ( is => 'rw', isa => 'Mail::MtPolicyd::Profiler::Timer', lazy => 1, default => sub { Mail::MtPolicyd::Profiler::Timer->new( name => 'main timer' ); }, ); has 'current' => ( is => 'rw', isa => 'Mail::MtPolicyd::Profiler::Timer', handles => { 'tick' => 'tick', }, lazy => 1, default => sub { my $self = shift; return $self->root; }, ); sub reset { my ( $self, $name ) = @_; my $timer = Mail::MtPolicyd::Profiler::Timer->new( name => 'main timer' ); $self->root( $timer ); $self->current( $timer ); return; } sub new_timer { my ( $self, $name ) = @_; my $timer = $self->current->new_child( name => $name ); $self->current( $timer ); return; } sub stop_current_timer { my ( $self, $name ) = @_; $self->current->stop; if( defined $self->current->parent ) { $self->current($self->current->parent); } return; } sub to_string { my $self = shift; return $self->root->to_string; } __PACKAGE__->meta->make_immutable; 1; __END__ =pod =encoding UTF-8 =head1 NAME Mail::MtPolicyd::Profiler - a application level profiler for mtpolicyd =head1 VERSION version 2.03 =head1 AUTHOR Markus Benning =head1 COPYRIGHT AND LICENSE This software is Copyright (c) 2014 by Markus Benning . This is free software, licensed under: The GNU General Public License, Version 2, June 1991 =cut server-spamhaus-rbls.feature100644000000000000 362513306510157 21316 0ustar00rootroot000000000000Mail-MtPolicyd-2.03/tFeature: mtpolicyd running with a basic spamhaus RBL config The mtpolicyd must be able to start up with a basic Spamhaus RBL config. Scenario: mtpolicyd with a basic Spamhaus configuration Given that a mtpolicyd is running with configuration t-data/spamhaus-rbls.conf When the following request is executed on mtpolicyd: """ sender=mtpolicyd@bofh-noc.de client_address=1.3.3.1 reverse_client_name=bofh-noc.de helo_name=bofh-noc.de """ Then mtpolicyd must respond with a action like ^reject SBL When the following request is executed on mtpolicyd: """ sender=mtpolicyd@bofh-noc.de client_address=127.0.0.4 reverse_client_name=bofh-noc.de helo_name=bofh-noc.de """ Then mtpolicyd must respond with a action like ^reject XBL When the following request is executed on mtpolicyd: """ sender=mtpolicyd@bofh-noc.de client_address=127.0.0.10 reverse_client_name=bofh-noc.de helo_name=bofh-noc.de """ Then mtpolicyd must respond with a action like ^reject PBL When the following request is executed on mtpolicyd: """ sender=mtpolicyd@dbltest.com client_address=127.0.0.1 reverse_client_name=bofh-noc.de helo_name=bofh-noc.de """ Then mtpolicyd must respond with a action like ^reject DBL sender When the following request is executed on mtpolicyd: """ sender=mtpolicyd@bofh-noc.de client_address=127.0.0.1 reverse_client_name=mail.dbltest.com helo_name=bofh-noc.de """ Then mtpolicyd must respond with a action like ^reject DBL reverse_client_name When the following request is executed on mtpolicyd: """ sender=mtpolicyd@bofh-noc.de client_address=127.0.0.1 reverse_client_name=bofh-noc.de helo_name=mail.dbltest.com """ Then mtpolicyd must respond with a action like ^reject DBL helo_name And the mtpolicyd server must be stopped successfull Cookbook.pod100644000000000000 214113306510157 21207 0ustar00rootroot000000000000Mail-MtPolicyd-2.03/lib/Mail/MtPolicyd# PODNAME: Mail::MtPolicyd::Cookbook # ABSTRACT: How to cook with mtpolicyd __END__ =pod =encoding UTF-8 =head1 NAME Mail::MtPolicyd::Cookbook - How to cook with mtpolicyd =head1 VERSION version 2.03 =head1 DESCRIPTION The mtpolicyd cookbook is a series of guides for learning mtpolicyd. =head1 RECIPES =head2 BASICS =over =item L How to do a basic installation of mtpolicyd in postfix. =item L Explains the default configuration that mtpolicyd comes with. =back =head2 PLUGIN DEVELOPMENT =over =item L How to write your own mtpolicyd plugin. =item L This receipt shows how to achieve tasks like scoring, per user configuration, SQL database queries, caching. =back =head1 AUTHOR Markus Benning =head1 COPYRIGHT AND LICENSE This software is Copyright (c) 2014 by Markus Benning . This is free software, licensed under: The GNU General Public License, Version 2, June 1991 =cut Connection.pm100644000000000000 136713306510157 21403 0ustar00rootroot000000000000Mail-MtPolicyd-2.03/lib/Mail/MtPolicydpackage Mail::MtPolicyd::Connection; use Moose; our $VERSION = '2.03'; # VERSION # ABSTRACT: base class for mtpolicyd connection modules has 'name' => ( is => 'ro', isa => 'Str', required => 1 ); sub init { my $self = shift; return; } sub reconnect { my $self = shift; return; } sub shutdown { my $self = shift; return; } 1; __END__ =pod =encoding UTF-8 =head1 NAME Mail::MtPolicyd::Connection - base class for mtpolicyd connection modules =head1 VERSION version 2.03 =head1 AUTHOR Markus Benning =head1 COPYRIGHT AND LICENSE This software is Copyright (c) 2014 by Markus Benning . This is free software, licensed under: The GNU General Public License, Version 2, June 1991 =cut Client000755000000000000 013306510157 20015 5ustar00rootroot000000000000Mail-MtPolicyd-2.03/lib/Mail/MtPolicydApp.pm100644000000000000 412213306510157 21232 0ustar00rootroot000000000000Mail-MtPolicyd-2.03/lib/Mail/MtPolicyd/Clientpackage Mail::MtPolicyd::Client::App; use Moose; our $VERSION = '2.03'; # VERSION # ABSTRACT: application interface class for Mail::MtPolicyd::Client extends 'Mail::MtPolicyd::Client'; with 'MooseX::Getopt'; use Mail::MtPolicyd::Client::Request; use IO::Handle; has '+host' => ( traits => ['Getopt'], cmd_aliases => "h", documentation => "host:port of a policyd", ); has '+socket_path' => ( traits => ['Getopt'], cmd_aliases => "s", documentation => "path to a socket of a policyd", ); has '+keepalive' => ( traits => ['Getopt'], cmd_aliases => "k", documentation => "use connection keepalive?", ); has 'verbose' => ( is => 'rw', isa => 'Bool', default => 0, traits => ['Getopt'], cmd_aliases => "v", documentation => "be verbose, print input/output to STDERR", ); sub run { my $self = shift; my $stdin = IO::Handle->new; $stdin->fdopen(fileno(STDIN),"r"); while( my $request = Mail::MtPolicyd::Client::Request->new_from_fh( $stdin ) ) { if( $self->verbose ) { $self->_dump('>> ', $request->as_string); } my $response = $self->request( $request ); if( $self->verbose ) { $self->_dump('<< ', $response->as_string); } print $response->action."\n"; } return; } sub _dump { my ( $self, $prefix, $message ) = @_; $message =~ s/^/$prefix/mg; print STDERR $message; return; } 1; __END__ =pod =encoding UTF-8 =head1 NAME Mail::MtPolicyd::Client::App - application interface class for Mail::MtPolicyd::Client =head1 VERSION version 2.03 =head1 SYNOPSIS use Mail::MtPolicyd::Client::App; my $app = Mail::MtPolicyd::Client::App->new_with_options(); $app->run; =head1 DESCRIPTION This class provides a application interface for Mail::MtPolicyd::Client. =head1 SEE ALSO L, L =head1 AUTHOR Markus Benning =head1 COPYRIGHT AND LICENSE This software is Copyright (c) 2014 by Markus Benning . This is free software, licensed under: The GNU General Public License, Version 2, June 1991 =cut Plugin000755000000000000 013306510157 20035 5ustar00rootroot000000000000Mail-MtPolicyd-2.03/lib/Mail/MtPolicydDBL.pm100644000000000000 1214113306510157 21153 0ustar00rootroot000000000000Mail-MtPolicyd-2.03/lib/Mail/MtPolicyd/Pluginpackage Mail::MtPolicyd::Plugin::DBL; use Moose; use namespace::autoclean; our $VERSION = '2.03'; # VERSION # ABSTRACT: mtpolicyd plugin for checking helo,sender domain,rdns against an DBL extends 'Mail::MtPolicyd::Plugin'; with 'Mail::MtPolicyd::Plugin::Role::Scoring'; with 'Mail::MtPolicyd::Plugin::Role::UserConfig' => { 'uc_attributes' => [ 'enabled', 'sender_mode', 'helo_name_mode', 'reverse_client_name_mode' ], }; use Mail::MtPolicyd::Plugin::Result; use Mail::RBL; has 'domain' => ( is => 'rw', isa => 'Str', required => 1 ); has 'enabled' => ( is => 'rw', isa => 'Str', default => 'on' ); has 'sender_mode' => ( is => 'rw', isa => 'Str', default => 'reject' ); has 'sender_score' => ( is => 'rw', isa => 'Maybe[Num]', default => 5 ); has 'reverse_client_name_mode' => ( is => 'rw', isa => 'Str', default => 'reject' ); has 'reverse_client_name_score' => ( is => 'rw', isa => 'Maybe[Num]', default => 2.5 ); has 'helo_name_mode' => ( is => 'rw', isa => 'Str', default => 'passive' ); has 'helo_name_score' => ( is => 'rw', isa => 'Maybe[Num]', default => 1 ); has 'reject_message' => ( is => 'rw', isa => 'Str', default => '%CHECK% rejected (%HOSTNAME%%INFO%)' ); has '_rbl' => ( is => 'ro', isa => 'Mail::RBL', lazy => 1, default => sub { my $self = shift; Mail::RBL->new($self->domain) }, ); sub run { my ( $self, $r ) = @_; my $session = $r->session; my $enabled = $self->get_uc( $session, 'enabled' ); if( $enabled eq 'off' ) { return; } foreach my $check ( 'sender', 'reverse_client_name', 'helo_name') { my $hostname = $self->_get_hostname($r, $check); if( ! defined $hostname ) { next; } my ( $ip_result, $info ) = $r->do_cached( $self->name.'-'.$check.'-result', sub { $self->_rbl->check_rhsbl( $hostname ) } ); if( ! defined $ip_result ) { $self->log($r, 'domain '.$hostname.' not on '.$self->domain.' blacklist'); next; } $self->log($r, 'domain '.$hostname.' is on '.$self->domain.' blacklist'. ( defined $info ? " ($info)" : '' ) ); my $score_attr = $check.'_score'; if( defined $self->$score_attr && ! $r->is_already_done($self->name.'-'.$check.'-score') ) { $self->add_score($r, $self->name.'-'.$check => $self->$score_attr ); } my $mode = $self->get_uc( $session, $check.'_mode' ); if( $mode eq 'reject' ) { return Mail::MtPolicyd::Plugin::Result->new( action => $self->_get_reject_action($check, $hostname, $info), abort => 1, ); } } return; } sub _get_hostname { my ( $self, $r, $field ) = @_; my $value = $r->attr($field); if( ! defined $value ) { die($field.' not defined in request!'); } # skip unknown and empty fields if( $value eq 'unknown' || $value eq '' ) { return; } # skip ip addresses if( $value =~ m/^\d+\.\d+\.\d+\.\d+$/) { return; } # skip ip6 addresses if( $value =~ m/:/) { return; } # skip unqualified hostnames if( $value !~ m/\./) { return; } if( $field eq 'sender') { $value =~ s/^[^@]*@//; } return($value); } sub _get_reject_action { my ( $self, $check, $hostname, $info ) = @_; my $msg = $self->reject_message; $msg =~ s/%CHECK%/$check/; $msg =~ s/%HOSTNAME%/$hostname/; if( defined $info ) { $msg =~ s/%INFO%/, $info/; } else { $msg =~ s/%INFO%//; } return 'reject '.$msg; } __PACKAGE__->meta->make_immutable; 1; __END__ =pod =encoding UTF-8 =head1 NAME Mail::MtPolicyd::Plugin::DBL - mtpolicyd plugin for checking helo,sender domain,rdns against an DBL =head1 VERSION version 2.03 =head1 DESCRIPTION Will check the sender, helo and reverse_client_name against an domain black list. =head1 PARAMETERS =over =item domain (required) The domain of the blacklist to query. =item enabled (default: on) Set to 'off' to disable plugin. Possible values: on,off =item uc_enabled (default: empty) If specified the give variable within the session will overwrite the value of 'enabled' if set. =item (uc_)sender_mode (default: reject), (uc_)helo_name_mode (default: passive), (uc_)reverse_client_name_mode (default: reject) Should the plugin return an reject if the check matches (reject) or just add an score (passive). Possible values: reject, passive =item sender_score (default: 5) =item helo_name_score (default: 1) =item reverse_client_name_score (default: 2.5) Add the given score if check matched. =item score_field (default: score) Name of the session variable the score is stored in. Could be used if multiple scores are needed. =back =head1 EXAMPLE Only the sender and the reverse_client_name check will cause an action to be executed (mode). The helo check will only add an score. module = "RBL" #enabled = "on" uc_enabled = "spamhaus" domain="dbl.spamhaus.org" # do not reject based on helo #helo_name_mode=passive #helo_name_score=1 #sender_mode=reject #sender_score=5 #reverse_client_name_mode=reject #reverse_client_name_score=2.5 =head1 AUTHOR Markus Benning =head1 COPYRIGHT AND LICENSE This software is Copyright (c) 2014 by Markus Benning . This is free software, licensed under: The GNU General Public License, Version 2, June 1991 =cut RBL.pm100644000000000000 675313306510157 21165 0ustar00rootroot000000000000Mail-MtPolicyd-2.03/lib/Mail/MtPolicyd/Pluginpackage Mail::MtPolicyd::Plugin::RBL; use Moose; use namespace::autoclean; our $VERSION = '2.03'; # VERSION # ABSTRACT: mtpolicyd plugin for checking the client-address against an RBL extends 'Mail::MtPolicyd::Plugin'; with 'Mail::MtPolicyd::Plugin::Role::Scoring'; with 'Mail::MtPolicyd::Plugin::Role::UserConfig' => { 'uc_attributes' => [ 'enabled', 'mode' ], }; use Mail::MtPolicyd::Plugin::Result; use Mail::RBL; has 'domain' => ( is => 'rw', isa => 'Str', required => 1 ); has 'enabled' => ( is => 'rw', isa => 'Str', default => 'on' ); has 'mode' => ( is => 'rw', isa => 'Str', default => 'reject' ); has 'reject_message' => ( is => 'ro', isa => 'Str', default => 'delivery from %IP% rejected %INFO%', ); has 'score' => ( is => 'rw', isa => 'Maybe[Num]' ); has '_rbl' => ( is => 'ro', isa => 'Mail::RBL', lazy => 1, default => sub { my $self = shift; Mail::RBL->new($self->domain) }, ); sub run { my ( $self, $r ) = @_; my $ip = $r->attr('client_address'); my $session = $r->session; my $mode = $self->get_uc( $session, 'mode' ); my $enabled = $self->get_uc( $session, 'enabled' ); if( $enabled eq 'off' ) { return; } my ( $ip_result, $info ) = $r->do_cached('rbl-'.$self->name.'-result', sub { $self->_rbl->check( $ip ) } ); if( ! defined $ip_result ) { $self->log($r, 'ip '.$ip.' not on '.$self->domain.' blacklist'); return; # host is not on the list } $self->log($r, 'ip '.$ip.' on '.$self->domain.' blacklist'.( defined $info ? ' ('.$info.')' : '' ) ); if( defined $self->score && ! $r->is_already_done('rbl-'.$self->name.'-score') ) { $self->add_score($r, $self->name => $self->score); } if( $mode eq 'reject' ) { return Mail::MtPolicyd::Plugin::Result->new( action => $self->_get_reject_action($ip, $info), abort => 1, ); } if( $mode eq 'accept' ) { return Mail::MtPolicyd::Plugin::Result->new_dunno; } return; } sub _get_reject_action { my ( $self, $ip, $info ) = @_; my $message = $self->reject_message; $message =~ s/%IP%/$ip/; if( defined $info && $info ne '' ) { $message =~ s/%INFO%/($info)/; } else { $message =~ s/%INFO%//; } return('reject '.$message); } __PACKAGE__->meta->make_immutable; 1; __END__ =pod =encoding UTF-8 =head1 NAME Mail::MtPolicyd::Plugin::RBL - mtpolicyd plugin for checking the client-address against an RBL =head1 VERSION version 2.03 =head1 DESCRIPTION This plugin queries a DNS black/white list. =head1 PARAMETERS =over =item domain (required) The domain of the blacklist to query. =item (uc_)enabled (default: on) Enable/disable this check. =item (uc_)mode (default: reject) =over =item reject Reject the message. (reject) =item accept Stop processing an accept this message. (dunno) =item passive Only apply the score if one is given. =back =item reject_message (default: delivery from %IP% rejected %INFO%) A pattern for the reject message if mode is set to 'reject'. =item score (default: empty) Apply this score if the check matched. =back =head1 EXAMPLE DNS BLACKLIST module = "RBL" mode = "passive" domain="dnsbl.sorbs.net" score = 5 =head1 EXAMPLE DNS WHITELIST module = "RBL" mode = "accept" # will stop here domain="list.dnswl.org" =head1 AUTHOR Markus Benning =head1 COPYRIGHT AND LICENSE This software is Copyright (c) 2014 by Markus Benning . This is free software, licensed under: The GNU General Public License, Version 2, June 1991 =cut SPF.pm100644000000000000 2232113306510157 21203 0ustar00rootroot000000000000Mail-MtPolicyd-2.03/lib/Mail/MtPolicyd/Pluginpackage Mail::MtPolicyd::Plugin::SPF; use Moose; use namespace::autoclean; our $VERSION = '2.03'; # VERSION # ABSTRACT: mtpolicyd plugin to apply SPF checks extends 'Mail::MtPolicyd::Plugin'; with 'Mail::MtPolicyd::Plugin::Role::Scoring'; with 'Mail::MtPolicyd::Plugin::Role::UserConfig' => { 'uc_attributes' => [ 'enabled', 'fail_mode', 'softfail_mode', 'pass_mode' ], }; use Mail::MtPolicyd::Plugin::Result; use Mail::MtPolicyd::AddressList; use Mail::SPF; use Net::DNS::Resolver; has 'enabled' => ( is => 'rw', isa => 'Str', default => 'on' ); has 'pass_score' => ( is => 'rw', isa => 'Maybe[Num]' ); has 'pass_mode' => ( is => 'rw', isa => 'Str', default => 'passive' ); has 'softfail_score' => ( is => 'rw', isa => 'Maybe[Num]' ); has 'softfail_mode' => ( is => 'rw', isa => 'Str', default => 'passive' ); has 'fail_score' => ( is => 'rw', isa => 'Maybe[Num]' ); has 'fail_mode' => ( is => 'rw', isa => 'Str', default => 'reject' ); has 'reject_message' => ( is => 'rw', isa => 'Str', default => 'SPF validation failed: %LOCAL_EXPL%' ); has 'default_authority_explanation' => ( is => 'ro', isa => 'Str', default => 'See http://www.%{d}/why/id=%{S};ip=%{I};r=%{R}' ); has 'hostname' => ( is => 'ro', isa => 'Str', default => '' ); has 'whitelist' => ( is => 'rw', isa => 'Str', default => ''); has '_whitelist' => ( is => 'ro', isa => 'Mail::MtPolicyd::AddressList', lazy => 1, default => sub { my $self = shift; my $list = Mail::MtPolicyd::AddressList->new; $list->add_localhost; $list->add_string( $self->whitelist ); return $list; }, ); # use a custom resolver to be able to provide a mock in unit tests has '_dns_resolver' => ( is => 'ro', isa => 'Net::DNS::Resolver', lazy => 1, default => sub { Net::DNS::Resolver->new; }, ); has '_spf' => ( is => 'ro', isa => 'Mail::SPF::Server', lazy => 1, default => sub { my $self = shift; return Mail::SPF::Server->new( default_authority_explanation => $self->default_authority_explanation, hostname => $self->hostname, dns_resolver => $self->_dns_resolver, ); }, ); has 'check_helo' => ( is => 'rw', isa => 'Str', default => 'on'); sub run { my ( $self, $r ) = @_; if( $self->get_uc($r->session, 'enabled') eq 'off' ) { return; } if( ! $r->is_attr_defined('client_address') ) { $self->log( $r, 'cant check SPF without client_address'); return; } if( $self->_whitelist->match_string( $r->attr('client_address') ) ) { $self->log( $r, 'skipping SPF checks for local or whitelisted ip'); return; } my $sender = $r->attr('sender'); if( $r->is_attr_defined('helo_name') && $self->check_helo ne 'off' ) { my $helo_result = $self->_check_helo( $r ); if( defined $helo_result ) { return( $helo_result ); # return action if present } if( ! $r->is_attr_defined('sender') ) { $sender = 'postmaster@'.$r->attr('helo_name'); $self->log( $r, 'null sender, building sender from HELO: '.$sender ); } } if( ! defined $sender ) { $self->log( $r, 'skipping SPF check because of null sender, consider setting check_helo=on'); return; } return $self->_check_mfrom( $r, $sender ); } sub _check_helo { my ( $self, $r ) = @_; my $ip = $r->attr('client_address'); my $helo = $r->attr('helo_name'); my $session = $r->session; my $request = Mail::SPF::Request->new( scope => 'helo', identity => $helo, ip_address => $ip, ); my $result = $self->_spf->process($request); return $self->_check_spf_result( $r, $result, 1 ); } sub _check_mfrom { my ( $self, $r, $sender ) = @_; my $ip = $r->attr('client_address'); my $helo = $r->attr('helo_name'); my $request = Mail::SPF::Request->new( scope => 'mfrom', identity => $sender, ip_address => $ip, defined $helo && length($helo) ? ( helo_identity => $helo ) : (), ); my $result = $self->_spf->process($request); return $self->_check_spf_result( $r, $result, 0 ); } sub _check_spf_result { my ( $self, $r, $result, $no_pass_action ) = @_; my $scope = $result->request->scope; my $session = $r->session; my $fail_mode = $self->get_uc($session, 'fail_mode'); my $softfail_mode = $self->get_uc($session, 'softfail_mode'); my $pass_mode = $self->get_uc($session, 'pass_mode'); if( $result->code eq 'neutral') { $self->log( $r, 'SPF '.$scope.' status neutral. (no SPF records)'); return; } elsif( $result->code eq 'fail') { $self->log( $r, 'SPF '.$scope.' check failed: '.$result->local_explanation); if( defined $self->fail_score && ! $r->is_already_done($self->name.'-score') ) { $self->add_score( $r, $self->name => $self->fail_score ); } if( $fail_mode eq 'reject') { return Mail::MtPolicyd::Plugin::Result->new( action => $self->_get_reject_action($result), abort => 1, ); } return; } elsif( $result->code eq 'softfail') { $self->log( $r, 'SPF '.$scope.' check returned softfail '.$result->local_explanation); if( defined $self->softfail_score && ! $r->is_already_done($self->name.'-score') ) { $self->add_score( $r, $self->name => $self->softfail_score ); } if( $softfail_mode eq 'reject') { return Mail::MtPolicyd::Plugin::Result->new( action => $self->_get_reject_action($result), abort => 1, ); } elsif( $softfail_mode eq 'accept' || $softfail_mode eq 'dunno') { return Mail::MtPolicyd::Plugin::Result->new_dunno; } return; } elsif( $result->code eq 'pass' ) { $self->log( $r, 'SPF '.$scope.' check passed'); if( $no_pass_action ) { return; } if( defined $self->pass_score && ! $r->is_already_done($self->name.'-score') ) { $self->add_score( $r, $self->name => $self->pass_score ); } if( $pass_mode eq 'accept' || $pass_mode eq 'dunno') { return Mail::MtPolicyd::Plugin::Result->new_dunno; } return; } $self->log( $r, 'spf '.$scope.' check failed: '.$result->local_explanation ); return; } sub _get_reject_action { my ( $self, $result ) = @_; my $message = $self->reject_message; if( $message =~ /%LOCAL_EXPL%/) { my $expl = $result->local_explanation; $message =~ s/%LOCAL_EXPL%/$expl/; } if( $message =~ /%AUTH_EXPL%/) { my $expl = ''; if( $result->can('authority_explanation') ) { $expl = $result->authority_explanation; } $message =~ s/%AUTH_EXPL%/$expl/; } return('reject '.$message); } __PACKAGE__->meta->make_immutable; 1; __END__ =pod =encoding UTF-8 =head1 NAME Mail::MtPolicyd::Plugin::SPF - mtpolicyd plugin to apply SPF checks =head1 VERSION version 2.03 =head1 DESCRIPTION This plugin applies Sender Policy Framework(SPF) checks. Checks are implemented using the Mail::SPF perl module. Actions based on the SPF result can be applied for: =over =item pass (pass_mode, default: passive) =item softfail (softfail_mode, default: passive) =item fail (fail_mode, default: reject) =back For status 'neutral' no action or score is applied. =head1 PARAMETERS =over =item (uc_)enabled (default: on) Enable/disable the plugin. =item (uc_)pass_mode (default: passive) How to behave if the SPF checks passed successfully: =over =item passive Just apply score. Do not return an action. =item accept, dunno Will return an 'dunno' action. =back =item pass_score (default: empty) Score to apply when the sender has been successfully checked against SPF. =item (uc_)softfail_mode (default: passive) How to behave if the SPF checks returned a softfail status. =over =item passive Just apply score. Do not return an action. =item accept, dunno Will return an 'dunno' action. =item reject Return an reject action. =back =item softfail_score (default: empty) Score to apply when the SPF check returns an softfail status. =item (uc_)fail_mode (default: reject) =over =item reject Return an reject action. =item passive Just apply score and do not return an action. =back =item reject_message (default: ) If fail_mode is set to 'reject' this message is used in the reject. The following pattern will be replaced in the string: =over =item %LOCAL_EXPL% Will be replaced with a (local) explanation of the check result. =item %AUTH_EXPL% Will be replaced with a URL to the explanation of the result. This URL could be configured with 'default_authority_explanation'. =back =item fail_score (default: empty) Score to apply if the sender failed the SPF checks. =item default_authority_explanation (default: See http://www.%{d}/why/id=%{S};ip=%{I};r=%{R}) String to return as an URL pointing to an explanation of the SPF check result. See Mail::SPF::Server for details. =item hostname (default: empty) An hostname to show in the default_authority_explanation as generating server. =item whitelist (default: '') A comma separated list of IP addresses to skip. =item check_helo (default: "on") Set to 'off' to disable SPF check on helo. =back =head1 EXAMPLE module = "SPF" pass_mode = passive pass_score = -10 fail_mode = reject #fail_score = 10 =head1 SEE ALSO L, OpenSPF L, RFC 7209 L =head1 AUTHOR Markus Benning =head1 COPYRIGHT AND LICENSE This software is Copyright (c) 2014 by Markus Benning . This is free software, licensed under: The GNU General Public License, Version 2, June 1991 =cut plugin-postfixmap-postmap100755000000000000 26413306510157 21634 0ustar00rootroot000000000000Mail-MtPolicyd-2.03/t-data123.123.123.123 OK 123.123.124 OK 123.124 OK 124 OK fe80::250:56ff:fe85:56f5 OK fe80::250:56ff:fe84 OK fe81 OK 111.111.111.111 1 111.111.111.11 DUNNO 111.111.111.1 REJECT AddressList.pm100644000000000000 506213306510157 21521 0ustar00rootroot000000000000Mail-MtPolicyd-2.03/lib/Mail/MtPolicydpackage Mail::MtPolicyd::AddressList; use Moose; use namespace::autoclean; our $VERSION = '2.03'; # VERSION # ABSTRACT: a class for IP address lists use NetAddr::IP; has '_localhost_addr' => ( is => 'ro', isa => 'ArrayRef[NetAddr::IP]', lazy => 1, default => sub { return [ map { NetAddr::IP->new( $_ ) } ( '127.0.0.0/8', '::ffff:127.0.0.0/104', '::1' ) ]; }, ); has 'list' => ( is => 'ro', isa => 'ArrayRef[NetAddr::IP]', lazy => 1, default => sub { [] }, traits => [ 'Array' ], handles => { 'add' => 'push', 'is_empty' => 'is_empty', 'count' => 'count', }, ); sub add_localhost { my $self = shift; $self->add( @{$self->_localhost_addr} ); return; } sub add_string { my ( $self, @strings ) = @_; my @addr_strings = map { split( /\s*[, ]\s*/, $_ ) } @strings; my @addr = map { NetAddr::IP->new( $_ ); } @addr_strings; $self->add( @addr ); return; } sub match { my ( $self, $addr ) = @_; if( grep { $_->contains( $addr ) } @{$self->list} ) { return 1; } return 0; } sub match_string { my ( $self, $string ) = @_; my $addr = NetAddr::IP->new( $string ); return( $self->match( $addr ) ); } sub as_string { my $self = shift; return join(',', map { $_->cidr } @{$self->list}); } __PACKAGE__->meta->make_immutable; 1; __END__ =pod =encoding UTF-8 =head1 NAME Mail::MtPolicyd::AddressList - a class for IP address lists =head1 VERSION version 2.03 =head1 Attributes =head2 list Contains an ArrayRef of NetAddr::IP which holds the all entries of this object. =head1 Methods =head2 add Add a list of NetAddr::IP objects to the list. =head2 is_empty Returns a true value when empty. =head2 count Returns the number of entries. =head2 add_localhost Add localhost addresses to list. =head2 add_string Takes a list of IP address strings. The strings itself can contain a list of comma/space separated addresses. Then a list of NetAddr::IP objects is created and pushed to the list. =head2 match Returns true if the give NetAddr::IP object matches an entry of the list. =head2 match_string Same as match(), but takes an string instead of NetAddr::IP object. =head2 as_string Returns a comma separated string with all addresses. =head1 AUTHOR Markus Benning =head1 COPYRIGHT AND LICENSE This software is Copyright (c) 2014 by Markus Benning . This is free software, licensed under: The GNU General Public License, Version 2, June 1991 =cut PluginChain.pm100644000000000000 650513306510157 21504 0ustar00rootroot000000000000Mail-MtPolicyd-2.03/lib/Mail/MtPolicydpackage Mail::MtPolicyd::PluginChain; use Moose; use namespace::autoclean; our $VERSION = '2.03'; # VERSION # ABSTRACT: class for a VirtualHost instance use Mail::MtPolicyd::Profiler; use Mail::MtPolicyd::Result; has 'plugins' => ( is => 'ro', isa => 'ArrayRef[Mail::MtPolicyd::Plugin]', default => sub { [] }, traits => [ 'Array' ], handles => { 'add_plugin' => 'push', } ); has 'plugin_prefix' => ( is => 'ro', isa => 'Str', default => 'Mail::MtPolicyd::Plugin::', ); has 'vhost_name' => ( is => 'rw', isa => 'Maybe[Str]' ); sub run { my ( $self, $r ) = @_; my $result = Mail::MtPolicyd::Result->new; foreach my $plugin ( @{$self->plugins} ) { my $abort = 0; Mail::MtPolicyd::Profiler->new_timer('plugin '.$plugin->name); my @plugin_results; eval { @plugin_results = $plugin->run($r); }; my $e = $@; if( $e ) { my $msg = 'plugin '.$plugin->name.' failed: '.$e; if( ! defined $plugin->on_error || $plugin->on_error ne 'continue' ) { die($msg); } $r->log(0, $msg); } Mail::MtPolicyd::Profiler->stop_current_timer; if( scalar @plugin_results ) { $result->last_match( $plugin->name ); } foreach my $plugin_result ( @plugin_results ) { $result->add_plugin_result($plugin_result); if( $plugin_result->abort ) { $abort = 1; } } if( $abort ) { last; } } return $result; } sub cron { my $self = shift; my $server = shift; foreach my $plugin ( @{$self->plugins} ) { $server->log(3, 'running cron for plugin '.$plugin->name); eval { $plugin->cron( $server, @_ ); }; my $e = $@; if( $e ) { $server->log(0, 'plugin '.$plugin->name.' failed in cron: '.$e ); } } return; } sub load_plugin { my ( $self, $plugin_name, $params ) = @_; if( ! defined $params->{'module'} ) { die('no module defined for plugin '.$plugin_name.'!'); } my $module = $params->{'module'}; my $plugin_class = $self->plugin_prefix.$module; my $plugin; my $code = "require ".$plugin_class.";"; eval $code; ## no critic (ProhibitStringyEval) if($@) { die('could not load module '.$module.' for plugin '.$plugin_name.': '.$@); } eval { $plugin = $plugin_class->new( name => $plugin_name, vhost_name => $self->vhost_name, %$params, ); $plugin->init(); }; if($@) { die('could not initialize plugin '.$plugin_name.': '.$@); } $self->add_plugin($plugin); return; } sub new_from_config { my ( $class, $vhost_name, $config ) = @_; my $self = $class->new( vhost_name => $vhost_name ); if( ! defined $config ) { return( $self ); } if( ref($config) ne 'HASH' ) { die('config must be an hashref!'); } foreach my $plugin_name ( keys %{$config} ) { $self->load_plugin($plugin_name, $config->{$plugin_name} ); } return $self; } __PACKAGE__->meta->make_immutable; 1; __END__ =pod =encoding UTF-8 =head1 NAME Mail::MtPolicyd::PluginChain - class for a VirtualHost instance =head1 VERSION version 2.03 =head1 AUTHOR Markus Benning =head1 COPYRIGHT AND LICENSE This software is Copyright (c) 2014 by Markus Benning . This is free software, licensed under: The GNU General Public License, Version 2, June 1991 =cut VirtualHost.pm100644000000000000 244513306510157 21566 0ustar00rootroot000000000000Mail-MtPolicyd-2.03/lib/Mail/MtPolicydpackage Mail::MtPolicyd::VirtualHost; use Moose; use namespace::autoclean; our $VERSION = '2.03'; # VERSION # ABSTRACT: class for a VirtualHost instance use Mail::MtPolicyd::PluginChain; has 'port' => ( is => 'ro', isa => 'Str', required => 1 ); has 'name' => ( is => 'ro', isa => 'Str', required => 1 ); has 'chain' => ( is => 'ro', isa => 'Mail::MtPolicyd::PluginChain', required => 1, handles => [ 'run' ], ); sub new_from_config { my ( $class, $port, $config ) = @_; if( ! defined $config->{'Plugin'} ) { die('no defined for on port '.$port.'!'); } my $vhost = $class->new( 'port' => $port, 'name' => $config->{'name'}, 'chain' => Mail::MtPolicyd::PluginChain->new_from_config( $config->{'name'}, $config->{'Plugin'} ), ); return $vhost; } sub cron { my $self = shift; return $self->chain->cron(@_); } __PACKAGE__->meta->make_immutable; 1; __END__ =pod =encoding UTF-8 =head1 NAME Mail::MtPolicyd::VirtualHost - class for a VirtualHost instance =head1 VERSION version 2.03 =head1 AUTHOR Markus Benning =head1 COPYRIGHT AND LICENSE This software is Copyright (c) 2014 by Markus Benning . This is free software, licensed under: The GNU General Public License, Version 2, June 1991 =cut Eval.pm100644000000000000 322413306510157 21423 0ustar00rootroot000000000000Mail-MtPolicyd-2.03/lib/Mail/MtPolicyd/Pluginpackage Mail::MtPolicyd::Plugin::Eval; use Moose; use namespace::autoclean; our $VERSION = '2.03'; # VERSION # ABSTRACT: mtpolicyd plugin to capture the output of plugins extends 'Mail::MtPolicyd::Plugin'; with 'Mail::MtPolicyd::Plugin::Role::PluginChain'; has 'store_in' => ( is => 'ro', isa => 'Str', required => 1 ); sub run { my ( $self, $r ) = @_; my $field = $self->store_in; if( ! defined $self->chain ) { return; } my $chain_result = $self->chain->run( $r ); my @actions = $chain_result->actions; if( scalar @actions ) { $r->session->{$field} = join("\n", @actions) } return; } __PACKAGE__->meta->make_immutable; 1; __END__ =pod =encoding UTF-8 =head1 NAME Mail::MtPolicyd::Plugin::Eval - mtpolicyd plugin to capture the output of plugins =head1 VERSION version 2.03 =head1 DESCRIPTION This plugin executes a list of configured plugins but will not return the action back to mtpolicyd. Instead it writes the output of the plugins to a variable within the session. =head1 PARAMETERS =over =item store_in (required) The name of the key in the session to store the result of the eval'ed checks. =item Plugin (required) A list of checks to execute. =back =head1 EXAMPLE module = "Eval" # store result in spf_action store_in="spf_action" module = "Proxy" host = "localhost:10023" =head1 AUTHOR Markus Benning =head1 COPYRIGHT AND LICENSE This software is Copyright (c) 2014 by Markus Benning . This is free software, licensed under: The GNU General Public License, Version 2, June 1991 =cut SessionCache.pm100644000000000000 310513306510157 21643 0ustar00rootroot000000000000Mail-MtPolicyd-2.03/lib/Mail/MtPolicydpackage Mail::MtPolicyd::SessionCache; use Moose; our $VERSION = '2.03'; # VERSION # ABSTRACT: class for handling session cache use Mail::MtPolicyd::SessionCache::None; has 'server' => ( is => 'ro', isa => 'Net::Server', required => 1, handles => { 'log' => 'log', } ); has 'cache' => ( is => 'rw', isa => 'Mail::MtPolicyd::SessionCache::Base', lazy => 1, default => sub { Mail::MtPolicyd::SessionCache::None->new }, handles => [ 'retrieve_session', 'store_session', 'shutdown', ], ); sub load_config { my ( $self, $config ) = @_; if( ! defined $config->{'module'} ) { die('no module defined for SessionCache!'); } my $module = $config->{'module'}; my $class = 'Mail::MtPolicyd::SessionCache::'.$module; my $cache; $self->log(1, 'loading SessionCache '.$module); my $code = "require ".$class.";"; eval $code; ## no critic (ProhibitStringyEval) if($@) { die('could not load SessionCache '.$module.': '.$@); } $self->log(1, 'initializing SessionCache '.$module); eval { $cache = $class->new( %$config, ); $cache->init(); }; if($@) { die('could not initialize SessionCache: '.$@); } $self->cache( $cache ); return; } 1; __END__ =pod =encoding UTF-8 =head1 NAME Mail::MtPolicyd::SessionCache - class for handling session cache =head1 VERSION version 2.03 =head1 AUTHOR Markus Benning =head1 COPYRIGHT AND LICENSE This software is Copyright (c) 2014 by Markus Benning . This is free software, licensed under: The GNU General Public License, Version 2, June 1991 =cut Proxy.pm100644000000000000 414313306510157 21656 0ustar00rootroot000000000000Mail-MtPolicyd-2.03/lib/Mail/MtPolicyd/Pluginpackage Mail::MtPolicyd::Plugin::Proxy; use Moose; use namespace::autoclean; our $VERSION = '2.03'; # VERSION # ABSTRACT: mtpolicyd plugin to forward request to another policy daemon extends 'Mail::MtPolicyd::Plugin'; use Mail::MtPolicyd::Plugin::Result; use Mail::MtPolicyd::Client; use Mail::MtPolicyd::Client::Request; has 'socket_path' => ( is => 'rw', isa => 'Maybe[Str]' ); has 'host' => ( is => 'rw', isa => 'Maybe[Str]' ); has 'keepalive' => ( is => 'rw', isa => 'Bool', default => 0 ); has _client => ( is => 'ro', isa => 'Mail::MtPolicyd::Client', lazy => 1, default => sub { my $self = shift; my %opts = ( keepalive => $self->keepalive, ); if( defined $self->socket_path ) { $opts{'socket_path'} = $self->socket_path; } elsif( defined $self->host ) { $opts{'host'} = $self->host; } else { $self->logdie('no host and no socket_path configured!'); } return Mail::MtPolicyd::Client->new( %opts ); }, ); sub run { my ( $self, $r ) = @_; my $proxy_request = Mail::MtPolicyd::Client::Request->new_proxy_request( $r ); my $response = $self->_client->request( $proxy_request ); return Mail::MtPolicyd::Plugin::Result->new( action => $response->action, abort => 1, ); } __PACKAGE__->meta->make_immutable; 1; __END__ =pod =encoding UTF-8 =head1 NAME Mail::MtPolicyd::Plugin::Proxy - mtpolicyd plugin to forward request to another policy daemon =head1 VERSION version 2.03 =head1 DESCRIPTION This module forwards the request to another policy daemon. =head1 PARAMETERS =over =item host (default: empty) The : of the target policy daemon. =item socket_path (default: empty) The path to the socket of the target policy daemon. =item keepalive (default: 0) Keep connection open across requests. =back =head1 EXAMPLE module = "Proxy" host="localhost:10023" =head1 AUTHOR Markus Benning =head1 COPYRIGHT AND LICENSE This software is Copyright (c) 2014 by Markus Benning . This is free software, licensed under: The GNU General Public License, Version 2, June 1991 =cut Quota.pm100644000000000000 1161213306510157 21645 0ustar00rootroot000000000000Mail-MtPolicyd-2.03/lib/Mail/MtPolicyd/Pluginpackage Mail::MtPolicyd::Plugin::Quota; use Moose; use namespace::autoclean; our $VERSION = '2.03'; # VERSION # ABSTRACT: mtpolicyd plugin for accounting in sql tables extends 'Mail::MtPolicyd::Plugin'; with 'Mail::MtPolicyd::Plugin::Role::UserConfig' => { 'uc_attributes' => [ 'enabled', 'field', 'threshold', 'action', 'metric' ], }; with 'Mail::MtPolicyd::Plugin::Role::PluginChain'; use Mail::MtPolicyd::Plugin::Result; use Time::Piece; has 'enabled' => ( is => 'rw', isa => 'Str', default => 'on' ); has 'field' => ( is => 'rw', isa => 'Str', required => 1); has 'metric' => ( is => 'rw', isa => 'Str', required => 1); has 'time_pattern' => ( is => 'rw', isa => 'Str', default => '%Y-%m'); has 'threshold' => ( is => 'rw', isa => 'Int', required => 1); has 'action' => ( is => 'rw', isa => 'Str', default => 'defer smtp traffic quota has been exceeded'); with 'Mail::MtPolicyd::Role::Connection' => { name => 'db', type => 'Sql', }; with 'Mail::MtPolicyd::Plugin::Role::SqlUtils'; sub get_timekey { my $self = shift; return Time::Piece->new->strftime( $self->time_pattern ); } has 'table_prefix' => ( is => 'rw', isa => 'Str', default => 'acct_'); sub run { my ( $self, $r ) = @_; my $session = $r->session; if( $self->get_uc( $session, 'enabled') eq 'off' ) { return; } my $field = $self->get_uc( $session, 'field'); my $metric = $self->get_uc( $session, 'metric'); my $action = $self->get_uc( $session, 'action'); my $threshold = $self->get_uc( $session, 'threshold'); my $key = $r->attr( $field ); if( ! defined $key || $key =~ /^\s*$/ ) { $self->log( $r, 'field '.$field.' is empty in request. skipping quota check.'); return; } my $count = $self->get_accounting_count( $r, $field, $metric, $key ); if( $count >= $threshold ) { if( defined $action ) { return Mail::MtPolicyd::Plugin::Result->new( action => $action, abort => 1, ); } if( defined $self->chain ) { my $chain_result = $self->chain->run( $r ); return( @{$chain_result->plugin_results} ); } } return; } sub get_table_name { my ( $self, $field ) = @_; return( $self->table_prefix . $field ); } sub get_accounting_count { my ( $self, $r, $field, $metric, $key ) = @_; my $dbh = $self->_db_handle; my $where = { 'key' => $key, 'time' => $self->get_timekey, }; my $table_name = $dbh->quote_identifier( $self->get_table_name($field) ); my $where_str = join(' AND ', map { $dbh->quote_identifier($_).'='.$dbh->quote($where->{$_}) } keys %$where ); my $column_name = $dbh->quote_identifier( $metric ); my $sql = "SELECT $column_name FROM $table_name WHERE $where_str"; my $count = $dbh->selectrow_array($sql); if( defined $count && $count =~ /^\d+$/ ) { return $count; } return; } __PACKAGE__->meta->make_immutable; 1; __END__ =pod =encoding UTF-8 =head1 NAME Mail::MtPolicyd::Plugin::Quota - mtpolicyd plugin for accounting in sql tables =head1 VERSION version 2.03 =head1 DESCRIPTION This plugin can be used to do accounting based on request fields. =head1 Example module = "Quota" table_prefix = "acct_" # per month time_pattern = "%Y-%m" # per ip field = "client_address" # allow 1000 mails metric = "count" threshold = 1000 action = "defer you exceeded your monthly limit, please insert coin" =head1 Configuration =head2 Parameters The module takes the following parameters: =over =item (uc_)enabled (default: on) Enable/disable this check. =item (uc_)field (required) The field used for accounting/quota. =item (uc_)metric (required) The metric on which the quota should be based. The Accounting module stores the following metrics: =over =item count Number of mails recivied. =item count_rcpt Number of mails recivied multiplied with number of recipients. =item size Size of mails recivied. =item size_rcpt Size of mails recivied multiplied with number of recipients. =back =item time_pattern (default: "%Y-%m") A format string for building the time key used to store counters. Default is to build counters on a monthly base. For example use: * "%Y-%W" for weekly * "%Y-%m-%d" for daily See "man date" for format string sequences. You must use the same time_pattern as used in for the Accounting module. =item threshold (required) The quota limit. =item action (default: defer smtp traffic quota has been exceeded) The action to return when the quota limit has been reached. =item table_prefix (default: "acct_") A prefix to add to every table. The table name will be the prefix + field_name. =back =head1 AUTHOR Markus Benning =head1 COPYRIGHT AND LICENSE This software is Copyright (c) 2014 by Markus Benning . This is free software, licensed under: The GNU General Public License, Version 2, June 1991 =cut plugin-role-configurablefields.t100755000000000000 345413306510157 22126 0ustar00rootroot000000000000Mail-MtPolicyd-2.03/t#!perl use strict; use warnings; use Test::More tests => 7; use Test::Exception; use Test::MockObject; use Mail::MtPolicyd::Request; package Mail::MtPolicyd::Plugin::TestConfigurableFields; use Moose; extends 'Mail::MtPolicyd::Plugin'; with 'Mail::MtPolicyd::Plugin::Role::ConfigurableFields' => { fields => { 'test_str' => { default => 'test value', value_isa => 'Str', }, 'test_int' => { default => 123, value_isa => 'Int', }, } }; package main; import Mail::MtPolicyd::Plugin::TestConfigurableFields; my $p = Mail::MtPolicyd::Plugin::TestConfigurableFields->new( name => 'configurable-fields-test', test_str_field => 'test_str', test_int_field => 'test_int', ); isa_ok($p, 'Mail::MtPolicyd::Plugin::TestConfigurableFields'); lives_ok { $p->init(); } 'initialize plugin'; my $session = { '_instance' => 'abcd1234', }; # fake a Server object my $server = Test::MockObject->new; $server->set_isa('Net::Server'); $server->mock( 'log', sub { my ( $self, $level, $message ) = @_; print '# LOG('.$level.'): '.$message."\n" } ); my $r = Mail::MtPolicyd::Request->new( attributes => { 'instance' => 'abcd1234', }, session => $session, server => $server, use_caching => 0, ); isa_ok( $r, 'Mail::MtPolicyd::Request'); ok( ! defined $p->get_test_int_value( $r ), 'must be undefined without request field' ); $r->attributes->{'test_int'} = 123; cmp_ok( $p->get_test_int_value( $r ), '==', '123', 'must be returned value of request field if present' ); $r->attributes->{'test_int'} = 'hello world'; ok( ! defined $p->get_test_int_value( $r ), 'must be undefined without if type constraint fails' ); $r->attributes->{'test_str'} = 'hello world'; cmp_ok( $p->get_test_str_value( $r ), 'eq', 'hello world', 'must be returned value of request field if present' ); step_definitions000755000000000000 013306510157 17054 5ustar00rootroot000000000000Mail-MtPolicyd-2.03/tclient_steps.pl100644000000000000 222013306510157 22241 0ustar00rootroot000000000000Mail-MtPolicyd-2.03/t/step_definitions#!perl use strict; use warnings; use Test::More; use Mail::MtPolicyd::Client; use Mail::MtPolicyd::Client::Request; When qr/the following request is executed on mtpolicyd:/, sub { isa_ok( S->{'server'}, 'Test::Net::Server'); my $port = S->{'server'}->port; my $client = Mail::MtPolicyd::Client->new( 'host' => 'localhost:'.$port, ); my $attrs = { map { split('=', $_, 2) } split("\n", C->data) }; my $req = Mail::MtPolicyd::Client::Request->new( attributes => $attrs, ); my $response; eval { $response = $client->request( $req ); }; if( $@ ) { fail('error while executing query: '.$@ ."\nLogfile: ".S->{'server'}->tail_log ); return; } pass('sent request to policy server'); S->{'policyd_response'} = $response; return; }; Then qr/mtpolicyd must respond with a action like (.*)/, sub { my $regex = $1; my $response = S->{'policyd_response'}; ok( defined $response, 'got a policyd response'); ok( defined $response->action, 'response action is defined'); like( $response->action, qr/$regex/, 'action is like '.$1); return; }; Action.pm100644000000000000 226513306510157 21755 0ustar00rootroot000000000000Mail-MtPolicyd-2.03/lib/Mail/MtPolicyd/Pluginpackage Mail::MtPolicyd::Plugin::Action; use Moose; use namespace::autoclean; our $VERSION = '2.03'; # VERSION # ABSTRACT: mtpolicyd plugin which just returns an action extends 'Mail::MtPolicyd::Plugin'; use Mail::MtPolicyd::Plugin::Result; has 'action' => ( is => 'ro', isa => 'Str', required => 1 ); sub run { my ( $self, $r ) = @_; return Mail::MtPolicyd::Plugin::Result->new( action => $self->action, abort => 1, ); } __PACKAGE__->meta->make_immutable; 1; __END__ =pod =encoding UTF-8 =head1 NAME Mail::MtPolicyd::Plugin::Action - mtpolicyd plugin which just returns an action =head1 VERSION version 2.03 =head1 DESCRIPTION This plugin just returns the specified string as action. =head1 PARAMETERS =over =item action (required) A string with the action to return. =back =head1 EXAMPLE module = "action" # any postfix action will do action=reject no reason =head1 AUTHOR Markus Benning =head1 COPYRIGHT AND LICENSE This software is Copyright (c) 2014 by Markus Benning . This is free software, licensed under: The GNU General Public License, Version 2, June 1991 =cut Result.pm100644000000000000 221013306510157 22004 0ustar00rootroot000000000000Mail-MtPolicyd-2.03/lib/Mail/MtPolicyd/Pluginpackage Mail::MtPolicyd::Plugin::Result; use Moose; use namespace::autoclean; our $VERSION = '2.03'; # VERSION # ABSTRACT: result returned by a plugin has 'action' => ( is => 'rw', isa => 'Maybe[Str]' ); has 'abort' => ( is => 'rw', isa => 'Bool', default => 0 ); sub new_dunno { my $class = shift; my $obj = $class->new( action => 'dunno', abort => 1, ); return($obj); } sub new_header { my ( $class, $header, $value ) = @_; my $obj = $class->new( action => 'PREPEND '.$header.': '.$value, abort => 1, ); return($obj); } sub new_header_once { my ( $class, $is_done, $header, $value ) = @_; if( $is_done ) { return $class->new_dunno; } return $class->new_header($header, $value); } __PACKAGE__->meta->make_immutable; 1; __END__ =pod =encoding UTF-8 =head1 NAME Mail::MtPolicyd::Plugin::Result - result returned by a plugin =head1 VERSION version 2.03 =head1 AUTHOR Markus Benning =head1 COPYRIGHT AND LICENSE This software is Copyright (c) 2014 by Markus Benning . This is free software, licensed under: The GNU General Public License, Version 2, June 1991 =cut Stress.pm100644000000000000 401513306510157 22016 0ustar00rootroot000000000000Mail-MtPolicyd-2.03/lib/Mail/MtPolicyd/Pluginpackage Mail::MtPolicyd::Plugin::Stress; use Moose; use namespace::autoclean; our $VERSION = '2.03'; # VERSION # ABSTRACT: mtpolicyd plugin for postfix stress mode extends 'Mail::MtPolicyd::Plugin'; with 'Mail::MtPolicyd::Plugin::Role::UserConfig' => { 'uc_attributes' => [ 'action' ], }; with 'Mail::MtPolicyd::Plugin::Role::PluginChain'; use Mail::MtPolicyd::Plugin::Result; has 'action' => ( is => 'rw', isa => 'Maybe[Str]' ); sub run { my ( $self, $r ) = @_; my $session = $r->session; my $stress = $r->attr('stress'); if( defined $stress && $stress eq 'yes' ) { $self->log($r, 'MTA has stress feature turned on'); my $action = $self->get_uc($session, 'action'); if( defined $action ) { return Mail::MtPolicyd::Plugin::Result->new( action => $action, abort => 1, ); } if( defined $self->chain ) { my $chain_result = $self->chain->run( $r ); return( @{$chain_result->plugin_results} ); } } return; } __PACKAGE__->meta->make_immutable; 1; __END__ =pod =encoding UTF-8 =head1 NAME Mail::MtPolicyd::Plugin::Stress - mtpolicyd plugin for postfix stress mode =head1 VERSION version 2.03 =head1 DESCRIPTION Will return an action or execute futher plugins if postfix signals stress. See postfix STRESS_README. =head1 PARAMETERS An action must be specified: =over =item action (default: empty) The action to return when under stress. =item Plugin (default: empty) Execute this plugins when under stress. =back =head1 EXAMPLE: defer clients when under stress To defer clients under stress: module = "Stress" action = "defer please try again later" This will return an defer action and execute no futher tests. You may want to do some whitelisting for preferred clients before this action. =head1 AUTHOR Markus Benning =head1 COPYRIGHT AND LICENSE This software is Copyright (c) 2014 by Markus Benning . This is free software, licensed under: The GNU General Public License, Version 2, June 1991 =cut plugin-postfixmap-postmap.db100755000000000000 3000013306510157 22247 0ustar00rootroot000000000000Mail-MtPolicyd-2.03/t-dataa  0ý_-,áFU Ñh^  ñéØÕÄÀ«§¡OKfe81OKfe80::250:56ff:fe84OK123.123.123.1231111.111.111.111REJECT111.111.111.1 ¤ ðéÜØÏËƨ¤ 0ý_-,áFUÑh^OKfe80::250:56ff:fe85:56f5OK124OK123.124OK123.123.124DUNNO111.111.111.11vhost-by-policy-context.conf100755000000000000 175113306510157 22165 0ustar00rootroot000000000000Mail-MtPolicyd-2.03/t-data# -*- apache -*- #keepalive_timeout=60 keepalive_timeout=0 # should be the same value as smtpd_policy_service_reuse_count_limit (postfix >2.12) max_keepalive=0 #max_keepalive=100 # timeout for processing of one request in seconds request_timeout=20 # database connection as perl-DBI DSN (man DBI) db_dsn= db_user= db_password= # memcached connection for session caching memcached_servers="memcached:11211" # memcached_namespace=mt- # memcached_expire=300 # wait timeout will be increased each time 50,100,150,... (usec) session_lock_wait=50 # abort after n retries session_lock_max_retry=50 # session lock times out after (sec) session_lock_timeout=10 # we use policy_context for vhost detection... vhost_by_policy_context=1 name="fred" module = "Action" action = "reject my name is fred" name="horst" module = "Action" action = "reject my name is horst" ConnectionPool.pm100644000000000000 412413306510157 22227 0ustar00rootroot000000000000Mail-MtPolicyd-2.03/lib/Mail/MtPolicydpackage Mail::MtPolicyd::ConnectionPool; use strict; use warnings; use MooseX::Singleton; our $VERSION = '2.03'; # VERSION # ABSTRACT: a singleton to hold all configure connections has 'pool' => ( is => 'ro', isa => 'HashRef[Mail::MtPolicyd::Connection]', lazy => 1, default => sub { {} }, traits => [ 'Hash' ], handles => { 'get_connection' => 'get', 'add_connection' => 'set', } ); sub get_handle { my ( $self, $name ) = @_; if( defined $self->pool->{$name} ) { return $self->pool->{$name}->handle; } return; } has 'plugin_prefix' => ( is => 'ro', isa => 'Str', default => 'Mail::MtPolicyd::Connection::'); sub load_config { my ( $self, $config ) = @_; foreach my $name ( keys %$config ) { $self->load_connection( $name, $config->{$name} ); } return; } sub load_connection { my ( $self, $name, $params ) = @_; if( ! defined $params->{'module'} ) { die('no module defined for connection '.$name.'!'); } my $module = $params->{'module'}; my $class = $self->plugin_prefix.$module; my $conn; my $code = "require ".$class.";"; eval $code; ## no critic (ProhibitStringyEval) if($@) { die('could not load connection '.$name.': '.$@); } eval { $conn = $class->new( name => $name, %$params, ); $conn->init(); }; if($@) { die('could not initialize connection '.$name.': '.$@); } $self->add_connection( $name => $conn ); return; } sub shutdown { my $self = shift; foreach my $conn ( values %{$self->pool} ) { $conn->shutdown(@_); # cascade } return; } sub reconnect { my $self = shift; foreach my $conn ( values %{$self->pool} ) { $conn->reconnect(@_); # cascade } return; } 1; __END__ =pod =encoding UTF-8 =head1 NAME Mail::MtPolicyd::ConnectionPool - a singleton to hold all configure connections =head1 VERSION version 2.03 =head1 AUTHOR Markus Benning =head1 COPYRIGHT AND LICENSE This software is Copyright (c) 2014 by Markus Benning . This is free software, licensed under: The GNU General Public License, Version 2, June 1991 =cut Request.pm100644000000000000 515313306510157 22147 0ustar00rootroot000000000000Mail-MtPolicyd-2.03/lib/Mail/MtPolicyd/Clientpackage Mail::MtPolicyd::Client::Request; use Moose; our $VERSION = '2.03'; # VERSION # ABSTRACT: a postfix policyd client request class has 'type' => ( is => 'ro', isa => 'Str', default => 'smtpd_access_policy' ); has 'instance' => ( is => 'ro', isa => 'Str', lazy => 1, default => sub { return rand; }, ); has 'attributes' => ( is => 'ro', isa => 'HashRef[Str]', default => sub { {} }, ); sub as_string { my $self = shift; return join("\n", 'request='.$self->type, 'instance='.$self->instance, map { $_.'='.$self->attributes->{$_} } keys %{$self->attributes}, )."\n\n"; } sub new_from_fh { my ( $class, $fh ) = ( shift, shift ); my $attr = {}; my $complete = 0; while( my $line = $fh->getline ) { $line =~ s/\r?\n$//; if( $line eq '') { $complete = 1 ; last; } my ( $name, $value ) = split('=', $line, 2); if( ! defined $value ) { die('error parsing response'); } $attr->{$name} = $value; } if( ! $complete ) { die('could not read response'); } my $obj = $class->new( 'attributes' => $attr, @_ ); return $obj; } sub new_proxy_request { my ( $class, $r ) = ( shift, shift ); my %attr = %{$r->attributes}; delete($attr{'type'}); delete($attr{'instance'}); my $obj = $class->new( 'type' => $r->type, 'instance' => $r->attr('instance'), 'attributes' => \%attr, ); return $obj; } 1; __END__ =pod =encoding UTF-8 =head1 NAME Mail::MtPolicyd::Client::Request - a postfix policyd client request class =head1 VERSION version 2.03 =head1 DESCRIPTION Class for construction of policyd requests. =head2 SYNOPSIS use Mail::MtPolicyd::Client::Request; $request = Mail::MtPolicyd::Client::Request->new( 'client_address' => '127.0.0.1', ); =head2 METHODS =over =item as_string Returns the request in as a string in the policyd request format. =back =head2 ATTRIBUTES =over =item type (default: smtpd_access_policy) The type of the request. =item instance (default: rand() ) The instance ID of the mail processed by the MTA. =item attributes (default: {} ) A hashref with contains all key/value pairs of the request. =back =head1 AUTHOR Markus Benning =head1 COPYRIGHT AND LICENSE This software is Copyright (c) 2014 by Markus Benning . This is free software, licensed under: The GNU General Public License, Version 2, June 1991 =cut Connection000755000000000000 013306510157 20676 5ustar00rootroot000000000000Mail-MtPolicyd-2.03/lib/Mail/MtPolicydSql.pm100644000000000000 361213306510157 22135 0ustar00rootroot000000000000Mail-MtPolicyd-2.03/lib/Mail/MtPolicyd/Connectionpackage Mail::MtPolicyd::Connection::Sql; use Moose; extends 'Mail::MtPolicyd::Connection'; # ABSTRACT: Connection pool sql connection object our $VERSION = '2.03'; # VERSION use DBI; has 'dsn' => ( is => 'ro', isa => 'Str', required => 1 ); has 'user' => ( is => 'ro', isa => 'Str', default => '' ); has 'password' => ( is => 'ro', isa => 'Str', default => '' ); has 'handle' => ( is => 'rw', isa => 'DBI::db', lazy => 1, default => sub { my $self = shift; return $self->_create_handle; }, handles => [ 'disconnect' ], ); sub _create_handle { my $self = shift; my $handle = DBI->connect( $self->dsn, $self->user, $self->password, { RaiseError => 1, PrintError => 0, AutoCommit => 1, mysql_auto_reconnect => 1, }, ); return $handle; } sub reconnect { my $self = shift; $self->handle( $self->_create_handle ); } 1; __END__ =pod =encoding UTF-8 =head1 NAME Mail::MtPolicyd::Connection::Sql - Connection pool sql connection object =head1 VERSION version 2.03 =head1 SYNOPSIS module = "Sql" # see perldoc DBI for syntax of dsn connection string dsn = "dbi:SQLite:dbname=/var/lib/mtpolicyd/mtpolicyd.sqlite" # user = "mtpolicyd" # user = "secret" =head1 PARAMETERS =over =item dsn (required) A perl DBI connection string. Examples: dbi:SQLite:dbname=/var/lib/mtpolicyd/mtpolicyd.sqlite dbi:SQLite::memory: DBI:mysql:database=test;host=localhost see L =item user (default: '') A username if required for connection. =item password (default: '') A password if required for user/connection. =back =head1 AUTHOR Markus Benning =head1 COPYRIGHT AND LICENSE This software is Copyright (c) 2014 by Markus Benning . This is free software, licensed under: The GNU General Public License, Version 2, June 1991 =cut CtIpRep.pm100644000000000000 1270313306510157 22064 0ustar00rootroot000000000000Mail-MtPolicyd-2.03/lib/Mail/MtPolicyd/Pluginpackage Mail::MtPolicyd::Plugin::CtIpRep; use Moose; use namespace::autoclean; our $VERSION = '2.03'; # VERSION # ABSTRACT: mtpolicyd plugin for the Commtouch IP reputation service (ctipd) extends 'Mail::MtPolicyd::Plugin'; with 'Mail::MtPolicyd::Plugin::Role::Scoring'; with 'Mail::MtPolicyd::Plugin::Role::UserConfig' => { 'uc_attributes' => [ 'enabled', 'tempfail_mode', 'permfail_mode' ], }; use Mail::MtPolicyd::Plugin::Result; use LWP::UserAgent; use HTTP::Request::Common; has 'enabled' => ( is => 'rw', isa => 'Str', default => 'on' ); has '_agent' => ( is => 'ro', isa => 'LWP::UserAgent', lazy => 1, default => sub { LWP::UserAgent->new } ); has 'url' => ( is => 'ro', isa => 'Str', default => 'http://localhost:8080/ctipd/iprep', ); has 'key' => ( is => 'ro', isa => 'Maybe[Str]' ); has 'reject_message' => ( is => 'rw', isa => 'Str', default => '550 delivery from %IP% is rejected. Check at http://www.commtouch.com/Site/Resources/Check_IP_Reputation.asp. Reference code: %REFID%', ); has 'defer_message' => ( is => 'rw', isa => 'Str', default => '450 delivery from %IP% is deferred,repeatedly. Send again or check at http://www.commtouch.com/Site/Resources/Check_IP_Reputation.asp. Reference code: %REFID%', ); has 'permfail_score' => ( is => 'rw', isa => 'Maybe[Num]' ); has 'permfail_mode' => ( is => 'rw', isa => 'Str', default => 'reject' ); has 'tempfail_score' => ( is => 'rw', isa => 'Maybe[Num]' ); has 'tempfail_mode' => ( is => 'rw', isa => 'Str', default => 'defer' ); sub _scan_ip { my ( $self, $ip ) = @_; my $request = "x-ctch-request-type: classifyip\r\n". "x-ctch-pver: 1.0\r\n"; if( defined $self->key ) { $request .= 'x-ctch-key: '.$self->key."\r\n"; } $request .= "\r\n"; $request .= 'x-ctch-ip: '.$ip."\r\n"; my $response = $self->_agent->request(POST $self->url, Content => $request ); if( $response->code ne 200 ) { die('error while accessing Commtouch ctipd: '.$response->status_line); } my $content = $response->content; my ( $action ) = $content =~ m/^x-ctch-dm-action:(.*)\r$/m; my ( $refid ) = $content =~ m/^x-ctch-refid:(.*)\r$/m; if( ! defined $action ) { die('could not find action in response: '.$content); } return( $action, $refid ); } sub run { my ( $self, $r ) = @_; my $ip = $r->attr('client_address'); my $session = $r->session; my $mode; if( ! defined $ip ) { die('no client_address in request!'); } my $enabled = $self->get_uc($session, 'enabled'); if( $enabled eq 'off' ) { return; } my ( $result, $refid ) = $r->do_cached( $self->name.'-result', sub{ $self->_scan_ip( $ip ) } ); if( $result eq 'accept') { $self->log( $r, 'CtIpRep: sender IP is ok' ); return; # do nothing } elsif( $result eq 'permfail' ) { $mode = $self->get_uc( $session, 'permfail_mode' ); if( $self->permfail_score && ! $r->is_already_done($self->name.'-score') ) { $self->add_score($r, $self->name => $self->permfail_score); } } elsif ($result eq 'tempfail' ) { $mode = $self->get_uc( $session, 'tempfail_mode' ); if( $self->tempfail_score && ! $r->is_already_done($self->name.'-score') ) { $self->add_score($r, $self->name => $self->tempfail_score); } } else { die('unknown ctiprep action: '.$result); } $self->log($r, 'CtIpRep: result='.$result.', mode='.$mode); if ( $mode eq 'reject' || $mode eq 'defer' ) { return Mail::MtPolicyd::Plugin::Result->new( action => $self->_build_action($mode, $ip, $refid), abort => 1, ); } return; } sub _build_action { my ( $self, $action, $ip, $refid ) = @_; my $message; if( $action eq 'reject' ) { $message = $self->reject_message; } elsif ( $action eq 'defer' ) { $message = $self->defer_message; } else { die('unknown action: '.$action); } $message =~ s/%IP%/$ip/; $message =~ s/%REFID%/$refid/; return($action.' '.$message); } __PACKAGE__->meta->make_immutable; 1; __END__ =pod =encoding UTF-8 =head1 NAME Mail::MtPolicyd::Plugin::CtIpRep - mtpolicyd plugin for the Commtouch IP reputation service (ctipd) =head1 VERSION version 2.03 =head1 DESCRIPTION This plugin will query the Commtouch IP Reputation service (ctipd). The used protocol is HTTP. The services will return a status permfail or tempfail. =head1 PARAMETERS =over =item (uc_)enabled (default: on) Enable/disable the plugin. =item url (default: http://localhost:8080/ctipd/iprep) The URL to access the ctipd daemon. =item key (default: empty) If an authentication key is required by the ctipd. =item reject_message (default: 550 delivery from %IP% is rejected. Check at http://www.commtouch.com/Site/Resources/Check_IP_Reputation.asp. Reference code: %REFID%) This parameter could be used to specifiy a custom reject message if message is rejected. =item defer_message (default: 450 delivery from %IP% is deferred,repeatedly. Send again or check at http://www.commtouch.com/Site/Resources/Check_IP_Reputation.asp. Reference code: %REFID%) This parameter could be used to specifiy a custom message is a message is to be defered. =item (uc_)permfail_mode, (uc_)tempfail_mode (default: reject, defer) Action to take when the service return permfail/tempfail status: =over =item reject =item defer =item passive =back =item permfail_score, tempfail_score (default: empty) Apply the specified score. =back =head1 AUTHOR Markus Benning =head1 COPYRIGHT AND LICENSE This software is Copyright (c) 2014 by Markus Benning . This is free software, licensed under: The GNU General Public License, Version 2, June 1991 =cut SqlList.pm100644000000000000 1071213306510157 22147 0ustar00rootroot000000000000Mail-MtPolicyd-2.03/lib/Mail/MtPolicyd/Pluginpackage Mail::MtPolicyd::Plugin::SqlList; use Moose; use namespace::autoclean; our $VERSION = '2.03'; # VERSION # ABSTRACT: mtpolicyd plugin for accessing a SQL white/black/access list extends 'Mail::MtPolicyd::Plugin'; with 'Mail::MtPolicyd::Plugin::Role::Scoring'; with 'Mail::MtPolicyd::Plugin::Role::UserConfig' => { 'uc_attributes' => [ 'enabled' ], }; use Mail::MtPolicyd::Plugin::Result; has 'enabled' => ( is => 'rw', isa => 'Str', default => 'on' ); has 'sql_query' => ( is => 'rw', isa => 'Str', default => 'SELECT client_ip FROM whitelist WHERE client_ip=INET_ATON(?)', ); has 'score' => ( is => 'rw', isa => 'Maybe[Num]' ); has 'match_action' => ( is => 'rw', isa => 'Maybe[Str]' ); has 'not_match_action' => ( is => 'rw', isa => 'Maybe[Str]' ); with 'Mail::MtPolicyd::Role::Connection' => { name => 'db', type => 'Sql', }; with 'Mail::MtPolicyd::Plugin::Role::SqlUtils'; sub _query_db { my ( $self, $ip ) = @_; return $self->execute_sql($self->sql_query, $ip)->fetchrow_array; } sub run { my ( $self, $r ) = @_; my $ip = $r->attr('client_address'); my $session = $r->session; my $config; if( $self->get_uc( $session, 'enabled') eq 'off' ) { return; } if( ! defined $ip) { $self->log($r, 'no attribute \'client_address\' in request'); return; } my $value = $r->do_cached( $self->name.'-result', sub { $self->_query_db($ip) } ); if( $value ) { $self->log($r, 'client_address '.$ip.' matched SqlList '.$self->name); if( defined $self->score && ! $r->is_already_done($self->name.'-score') ) { $self->add_score($r, $self->name , $self->score); } if( defined $self->match_action ) { return Mail::MtPolicyd::Plugin::Result->new( action => $self->match_action, abort => 1, ); } } else { $self->log($r, 'client_address '.$ip.' did not match SqlList '.$self->name); if( defined $self->not_match_action ) { return Mail::MtPolicyd::Plugin::Result->new( action => $self->not_match_action, abort => 1, ); } } return; } __PACKAGE__->meta->make_immutable; 1; __END__ =pod =encoding UTF-8 =head1 NAME Mail::MtPolicyd::Plugin::SqlList - mtpolicyd plugin for accessing a SQL white/black/access list =head1 VERSION version 2.03 =head1 SYNOPSIS module="SqlList" sql_query="SELECT client_ip FROM whitelist WHERE client_ip=?" match_action=dunno module="SqlList" sql_query="SELECT client_ip FROM blacklist WHERE client_ip=?" match_action="reject you are blacklisted!" =head1 DESCRIPTION Plugin checks the client_address against a SQL table. Depending on wether a supplied SQL query matched actions can be taken. =head2 PARAMETERS The module takes the following parameters: =over =item (uc_)enabled (default: "on") Could be set to 'off' to deactivate check. Could be used to activate/deactivate check per user. =item sql_query (default: "SELECT client_ip FROM whitelist WHERE client_ip=INET_ATON(?)") Prepared SQL statement to use for checking an IP address. ? will be replaced by the IP address. The module will match if the statement returns one or more rows. =back By default the plugin will do nothing. One of the following actions should be specified: =over =item match_action (default: empty) If given this action will be returned to the MTA if the SQL query matched. =item not_match_action (default: empty) If given this action will be returned to the MTA if the SQL query DID NOT matched. =item score (default: empty) If given this score will be applied to the session. =back =head1 EXAMPLE WITH A MYSQL TABLE You may use the following table for storing ipv4 addresses in MySQL: CREATE TABLE `whitelist` ( `id` int(11) NOT NULL AUTO_INCREMENT, `client_ip` INT UNSIGNED NOT NULL, PRIMARY KEY (`id`), UNIQUE KEY `client_ip` (`client_ip`) ) ENGINE=MyISAM DEFAULT CHARSET=latin1 INSERT INTO whitelist VALUES(NULL, INET_ATON('127.0.0.1')); And use it as a whitelist in mtpolicyd: name="reputation" module="SqlList" sql_query="SELECT client_ip FROM whitelist WHERE client_ip=INET_ATON(?)" match_action="dunno" ... =head1 AUTHOR Markus Benning =head1 COPYRIGHT AND LICENSE This software is Copyright (c) 2014 by Markus Benning . This is free software, licensed under: The GNU General Public License, Version 2, June 1991 =cut Profiler000755000000000000 013306510157 20361 5ustar00rootroot000000000000Mail-MtPolicyd-2.03/lib/Mail/MtPolicydTimer.pm100644000000000000 407713306510157 22147 0ustar00rootroot000000000000Mail-MtPolicyd-2.03/lib/Mail/MtPolicyd/Profilerpackage Mail::MtPolicyd::Profiler::Timer; use Moose; use namespace::autoclean; our $VERSION = '2.03'; # VERSION # ABSTRACT: a profiler for the mtpolicyd use Time::HiRes 'gettimeofday', 'tv_interval'; has 'name' => ( is => 'rw', isa => 'Str', required => 1 ); has 'start_time' => ( is => 'rw', isa => 'ArrayRef', default => sub { [gettimeofday()] }, ); has 'ticks' => ( is => 'ro', isa => 'ArrayRef', lazy => 1, default => sub { [] }, ); has 'parent' => ( is => 'ro', isa => 'Maybe[Mail::MtPolicyd::Profiler::Timer]' ); around BUILDARGS => sub { my $orig = shift; my $class = shift; if ( @_ == 1 && !ref $_[0] ) { return $class->$orig( name => $_[0] ); } else { return $class->$orig(@_); } }; sub tick { my ( $self, $msg ) = @_; my $now = [gettimeofday()]; my $delay = tv_interval($self->start_time, $now); push( @{$self->ticks}, [ $delay, $msg ] ); return; } sub stop { my $self = shift; $self->tick('timer stopped'); } sub new_child { my $self = shift; my $timer = __PACKAGE__->new( parent => $self, @_ ); $self->tick('started timer '.$timer->name); push( @{$self->ticks}, $timer ); return( $timer ); } sub to_string { my $self = shift; my $str = ''; foreach my $tick ( @{$self->ticks} ) { if( ref $tick eq 'ARRAY' ) { $str .= sprintf("%0f %s\n", @$tick ); } elsif( ref $tick eq 'Mail::MtPolicyd::Profiler::Timer' ) { my $substr = $tick->to_string; $substr =~ s/^/ /msg; $str .= $substr; } } return( $str ); } __PACKAGE__->meta->make_immutable; 1; __END__ =pod =encoding UTF-8 =head1 NAME Mail::MtPolicyd::Profiler::Timer - a profiler for the mtpolicyd =head1 VERSION version 2.03 =head1 AUTHOR Markus Benning =head1 COPYRIGHT AND LICENSE This software is Copyright (c) 2014 by Markus Benning . This is free software, licensed under: The GNU General Public License, Version 2, June 1991 =cut Response.pm100644000000000000 450713306510157 22317 0ustar00rootroot000000000000Mail-MtPolicyd-2.03/lib/Mail/MtPolicyd/Clientpackage Mail::MtPolicyd::Client::Response; use Moose; our $VERSION = '2.03'; # VERSION # ABSTRACT: a postfix policyd client response class has 'action' => ( is => 'ro', isa => 'Str', required => 1 ); has 'attributes' => ( is => 'ro', isa => 'HashRef[Str]', default => sub { {} }, ); sub as_string { my $self = shift; return join("\n", map { $_.'='.$self->attributes->{$_} } keys %{$self->attributes}, )."\n\n"; } sub new_from_fh { my ( $class, $fh ) = ( shift, shift ); my $attr = {}; my $complete = 0; while( my $line = $fh->getline ) { $line =~ s/\r?\n$//; if( $line eq '') { $complete = 1 ; last; } my ( $name, $value ) = split('=', $line, 2); if( ! defined $value ) { die('error parsing response'); } $attr->{$name} = $value; } if( ! $complete ) { die('could not read response'); } if( ! defined $attr->{'action'} ) { die('no action found in response'); } my $obj = $class->new( 'action' => $attr->{'action'}, 'attributes' => $attr, @_ ); return $obj; } 1; __END__ =pod =encoding UTF-8 =head1 NAME Mail::MtPolicyd::Client::Response - a postfix policyd client response class =head1 VERSION version 2.03 =head1 DESCRIPTION Class to handle a policyd response. =head2 SYNOPSIS use Mail::MtPolicyd::Client::Response; my $response = Mail::MtPolicyd::Client::Response->new_from_fh( $conn ); -- my $response = Mail::MtPolicyd::Client::Response->new( action => 'reject', attributes => { action => 'reject', }, ); print $response->as_string; =head2 METHODS =over =item new_from_fh( $filehandle ) Constructor which reads a response from the supplied filehandle. =item as_string Returns a stringified version of the response. =back =head2 ATTRIBUTES =over =item action (required) The action specified in the reponse. =item attributes Holds a hash with all key/values of the response. =back =head1 AUTHOR Markus Benning =head1 COPYRIGHT AND LICENSE This software is Copyright (c) 2014 by Markus Benning . This is free software, licensed under: The GNU General Public License, Version 2, June 1991 =cut Ldap.pm100644000000000000 665313306510157 22266 0ustar00rootroot000000000000Mail-MtPolicyd-2.03/lib/Mail/MtPolicyd/Connectionpackage Mail::MtPolicyd::Connection::Ldap; use Moose; extends 'Mail::MtPolicyd::Connection'; # ABSTRACT: a LDAP connection plugin for mtpolicyd our $VERSION = '2.03'; # VERSION use Net::LDAP; has 'host' => ( is => 'ro', isa => 'Str', default => 'localhost' ); has 'port' => ( is => 'ro', isa => 'Int', default => 389 ); has 'keepalive' => ( is => 'ro', isa => 'Bool', default => 1 ); has 'timeout' => ( is => 'ro', isa => 'Int', default => 120 ); has 'binddn' => ( is => 'ro', isa => 'Maybe[Str]' ); has 'password' => ( is => 'ro', isa => 'Maybe[Str]' ); has 'starttls' => ( is => 'ro', isa => 'Bool', default => 1 ); has 'handle' => ( is => 'ro', isa => 'Net::LDAP', lazy => 1, default => sub { my $self = shift; return $self->_connect_ldap; }, clearer => '_clear_handle', predicate => 'is_connected', ); # if available check ->connected on underlying IO::Socket # and invalidate connection if unconnected before 'handle' => sub { my $self = shift; return unless $self->is_connected; return unless $self->{'handle'}->can('socket'); my $socket = $self->{'handle'}->socket; return unless $socket->isa('IO::Socket'); if( ! $socket->connected ) { $self->_clear_handle; } return; }; has 'connection_class' => ( is => 'ro', isa => 'Maybe[Str]' ); sub _connect_ldap { my $self = shift; my $ldap_class = 'Net::LDAP'; if( defined $self->connection_class ) { $ldap_class = $self->connection_class; eval "require $ldap_class;"; ## no critic } my $ldap = $ldap_class->new( $self->host, port => $self->port, keepalive => $self->keepalive, timeout => $self->timeout, onerror => sub { $self->_handle_error(@_); }, ) or die ('cant connect ldap: '.$@); if( $self->starttls ) { eval{ $ldap->start_tls( verify => 'require' ); }; if( $@ ) { die('starttls on ldap connection failed: '.$@); } } if( defined $self->binddn ) { $ldap->bind( $self->binddn, password => $self->password ); } else { $ldap->bind; # anonymous bind } return $ldap; } sub _handle_error { my ($self, $error) = @_; if( $error->isa('Net::LDAP::Message') ) { $error = $error->error; } if( $error =~ /(Broken pipe|Bad file descriptor)/ ) { $self->_clear_handle; } die($error); } *reconnect = \&shutdown; sub shutdown { my $self = shift; # try to unbind eval { $self->handle->unbind }; $self->_clear_handle; return; } 1; __END__ =pod =encoding UTF-8 =head1 NAME Mail::MtPolicyd::Connection::Ldap - a LDAP connection plugin for mtpolicyd =head1 VERSION version 2.03 =head1 SYNOPSIS module = "Ldap" host = "localhost" =head1 PARAMETERS =over =item host (default: 'localhost') LDAP server to connect to. =item port (default: 389) LDAP servers port number to connect to. =item keepalive (default: 1) Enable connection keepalive for this connection. =item timeout (default: 120) Timeout in seconds for operations on this connection. =item binddn (default: undef) If set a bind with this binddn is done when connecting. =item password (default: undef) =item starttls (default: 1) Enable or disabled the use of starttls. (TLS/SSL encryption) =back =head1 AUTHOR Markus Benning =head1 COPYRIGHT AND LICENSE This software is Copyright (c) 2014 by Markus Benning . This is free software, licensed under: The GNU General Public License, Version 2, June 1991 =cut Fail2Ban.pm100644000000000000 704413306510157 22116 0ustar00rootroot000000000000Mail-MtPolicyd-2.03/lib/Mail/MtPolicyd/Pluginpackage Mail::MtPolicyd::Plugin::Fail2Ban; use Moose; use namespace::autoclean; our $VERSION = '2.03'; # VERSION # ABSTRACT: mtpolicyd plugin to block an address with fail2ban extends 'Mail::MtPolicyd::Plugin'; with 'Mail::MtPolicyd::Plugin::Role::UserConfig' => { 'uc_attributes' => [ 'enabled' ], }; use IO::Socket::UNIX; has 'enabled' => ( is => 'rw', isa => 'Str', default => 'on' ); has 'socket' => ( is => 'ro', isa => 'Str', default => '/var/run/fail2ban/fail2ban.sock' ); has 'jail' => ( is => 'ro', isa => 'Str', default => 'postfix' ); has '_socket' => ( is => 'ro', isa => 'IO::Socket::UNIX', lazy => 1, default => sub { my $self = shift; my $socket = IO::Socket::UNIX->new( Peer => $self->socket, ) or die "cant connect fail2ban socket: $!"; return( $socket ); }, ); sub run { my ( $self, $r ) = @_; my $ip = $r->attr('client_address'); my $session = $r->session; my $enabled = $self->get_uc( $session, 'enabled' ); if( $enabled eq 'off' ) { return; } if( ! $r->is_already_done($self->name.'-fail2ban') ) { $self->log( $r, 'adding ip '.$ip.' to fail2ban jail '.$self->jail ); $self->add_fail2ban( $r, $ip ); } return; } # The protocol used is based in tickle, an python specific serialization protocol # this command is captured from the output of: # strace -s 1024 -f fail2ban-client set postfix banip 123.123.123.123 # ... # sendto(3, "\200\2]q\0(U\3setq\1U\7postfixq\2U\5banipq\3U\017123.123.123.123q\4e.", 71, 0, NU has '_command_pattern' => ( is => 'ro', isa => 'Str', default => "\200\2]q\0(U\3setq\1U%c%sq\2U\5banipq\3U%c%sq\4e.", ); sub add_fail2ban { my ( $self, $r, $ip ) = @_; $self->_socket->print( sprintf($self->_command_pattern, length($self->jail), $self->jail, length($ip), $ip ) ); return; } __PACKAGE__->meta->make_immutable; 1; __END__ =pod =encoding UTF-8 =head1 NAME Mail::MtPolicyd::Plugin::Fail2Ban - mtpolicyd plugin to block an address with fail2ban =head1 VERSION version 2.03 =head1 DESCRIPTION This plugin can be used to block an ip with iptable thru the fail2ban daemon. For more information abount fail2ban read: http://www.fail2ban.org/ This plugin will directly talk to the daemon thru the unix domain socket and execute an banip command: set banip =head1 PARAMETERS =over =item socket (default: /var/run/fail2ban/fail2ban.sock) Path to the fail2ban unix socket. Make sure mtpolicyd is allowed to write to this socket! =item jail (default: postfix) The jail in which the ip should be banned. =back =head1 EXAMPLE Execute a ban on all client-ips which send a mail with a score of >=15: module = "ScoreAction" threshold = 15 module = "Fail2Ban" socket = "/var/run/fail2ban/fail2ban.sock" jail = "postfix" =head1 FAIL2BAN CONFIGURATION To allow mtpolicyd to access fail2ban you must make sure fail2ban can write to the fail2ban unix socket. chgrp mtpolicyd /var/run/fail2ban/fail2ban.sock chmod g+rwx /var/run/fail2ban/fail2ban.sock You may want to add this to the fail2ban startup script. You may want to use the predefined postfix jail. To activate it create /etc/fail2ban/jail.local and enable the postfix fail by setting enabled=true. [postfix] enabled = true =head1 AUTHOR Markus Benning =head1 COPYRIGHT AND LICENSE This software is Copyright (c) 2014 by Markus Benning . This is free software, licensed under: The GNU General Public License, Version 2, June 1991 =cut Honeypot.pm100644000000000000 1177313306510157 22371 0ustar00rootroot000000000000Mail-MtPolicyd-2.03/lib/Mail/MtPolicyd/Pluginpackage Mail::MtPolicyd::Plugin::Honeypot; use Moose; use namespace::autoclean; our $VERSION = '2.03'; # VERSION # ABSTRACT: mtpolicyd plugin for creating an honeypot extends 'Mail::MtPolicyd::Plugin'; with 'Mail::MtPolicyd::Plugin::Role::Scoring'; with 'Mail::MtPolicyd::Plugin::Role::UserConfig' => { 'uc_attributes' => [ 'enabled' ], }; with 'Mail::MtPolicyd::Plugin::Role::PluginChain'; use Mail::MtPolicyd::Plugin::Result; has 'enabled' => ( is => 'rw', isa => 'Str', default => 'on' ); has 'score' => ( is => 'rw', isa => 'Maybe[Num]' ); has 'mode' => ( is => 'rw', isa => 'Str', default => 'reject'); has 'recipients' => ( is => 'rw', isa => 'Str', default => '' ); has 'recipients_re' => ( is => 'rw', isa => 'Str', default => '' ); has _recipients => ( is => 'ro', isa => 'ArrayRef', lazy => 1, default => sub { my $self = shift; return [ split(/\s*,\s*/, $self->recipients) ]; }, ); has _recipients_re => ( is => 'ro', isa => 'ArrayRef', lazy => 1, default => sub { my $self = shift; return [ split(/\s*,\s*/, $self->recipients_re) ]; }, ); has 'reject_message' => ( is => 'rw', isa => 'Str', default => 'trapped by honeypod' ); has 'expire' => ( is => 'rw', isa => 'Int', default => 60*60*2 ); sub run { my ( $self, $r ) = @_; my $ip = $r->attr('client_address'); my $recipient = $r->attr('recipient'); my $session = $r->session; my $enabled = $self->get_uc( $session, 'enabled' ); if( $enabled eq 'off' ) { return; } if( $self->is_in_honeypot( $r, $ip ) ) { return $self->trapped_action; } if( $self->is_honeypot_recipient( $recipient ) ) { $self->add_to_honeypot( $r, $ip ); return $self->trapped_action; } return; } sub trapped_action { my ( $self, $r ) = @_; if( $self->mode eq 'reject' ) { return( Mail::MtPolicyd::Plugin::Result->new( action => 'reject '.$self->reject_message, abort => 1, ) ); } if( defined $self->score && ! $r->is_already_done($self->name.'-score') ) { $self->add_score($r, $self->name => $self->score); } if( defined $self->chain ) { my $chain_result = $self->chain->run( $r ); return( @{$chain_result->plugin_results} ); } return; } sub is_honeypot_recipient { my ( $self, $recipient ) = @_; if( $self->is_in_recipients( $recipient ) || $self->is_in_recipients_re( $recipient ) ) { return(1); } return(0); } sub is_in_recipients { my ( $self, $recipient ) = @_; if( grep { $_ eq $recipient } @{$self->_recipients} ) { return(1); } return(0); } sub is_in_recipients_re { my ( $self, $recipient ) = @_; if( grep { $recipient =~ /$_/ } @{$self->_recipients_re} ) { return(1); } return(0); } sub is_in_honeypot { my ( $self, $r, $ip ) = @_; my $key = join(",", $self->name, $ip ); if( my $ticket = $r->server->memcached->get( $key ) ) { return( 1 ); } return; } sub add_to_honeypot { my ( $self, $r, $ip ) = @_; my $key = join(",", $self->name, $ip ); $r->server->memcached->set( $key, '1', $self->expire ); return; } __PACKAGE__->meta->make_immutable; 1; __END__ =pod =encoding UTF-8 =head1 NAME Mail::MtPolicyd::Plugin::Honeypot - mtpolicyd plugin for creating an honeypot =head1 VERSION version 2.03 =head1 DESCRIPTION The Honeypot plugin creates an honeypot to trap IPs sending to unused recipient addresses. The plugin requires that you define unused recipient addresses as honeypots. These addresses can be specified by the recipients and recipients_re parameters. Each time an IP tries to send an mail to one of these honeypots the message will be reject if mode is 'reject' and an scoring is applied. The IP is also added to a temporary IP blacklist till an timeout is reached (parameter expire). All IPs on this blacklist will also be rejected if mode is 'reject' and scoring is applied. =head1 EXAMPLE module = "Honeypot" recipients = "bob@company.com,joe@company.com" recipients_re = "^(tic|tric|trac)@(gmail|googlemail)\.de$" =head1 PARAMETERS =over =item (uc_)enabled (default: on) Enable/disable this check. =item score (default: empty) Apply an score to this message if it is send to an honeypot address or it has been added to the honeypot before by sending an mail to an honeypot. =item mode (default: reject) The default is to return an reject. Change to 'passive' if you just want scoring. =item recipients (default: '') A comma separated list of recipients to use as honeypots. =item recipients_re (default: '') A comma separated list of regular expression to match against the recipient to use them as honeypots. =item reject_message (default: 'trapped by honeypod') A string to return with the reject action. =item expire (default: 7200 (2h)) Time in seconds till the client_ip is removed from the honeypot. =item Plugin (default: empty) Execute this plugins when the condition matched. =back =head1 AUTHOR Markus Benning =head1 COPYRIGHT AND LICENSE This software is Copyright (c) 2014 by Markus Benning . This is free software, licensed under: The GNU General Public License, Version 2, June 1991 =cut SetField.pm100644000000000000 217213306510157 22234 0ustar00rootroot000000000000Mail-MtPolicyd-2.03/lib/Mail/MtPolicyd/Pluginpackage Mail::MtPolicyd::Plugin::SetField; use Moose; use namespace::autoclean; our $VERSION = '2.03'; # VERSION # ABSTRACT: mtpolicyd plugin which just sets and key=value in the session extends 'Mail::MtPolicyd::Plugin'; use Mail::MtPolicyd::Plugin::Result; has 'key' => ( is => 'rw', isa => 'Str', required => 1 ); has 'value' => ( is => 'rw', isa => 'Str', required => 1 ); sub run { my ( $self, $r ) = @_; $r->session->{$self->key} = $self->value; return; } __PACKAGE__->meta->make_immutable; 1; __END__ =pod =encoding UTF-8 =head1 NAME Mail::MtPolicyd::Plugin::SetField - mtpolicyd plugin which just sets and key=value in the session =head1 VERSION version 2.03 =head1 DESCRIPTION This plugin can be used to set key/values within the session. =head1 EXAMPLE module = "SetField" key=mail-is-scanned value=1 =head1 AUTHOR Markus Benning =head1 COPYRIGHT AND LICENSE This software is Copyright (c) 2014 by Markus Benning . This is free software, licensed under: The GNU General Public License, Version 2, June 1991 =cut Greylist.pm100644000000000000 2304713306510157 22363 0ustar00rootroot000000000000Mail-MtPolicyd-2.03/lib/Mail/MtPolicyd/Pluginpackage Mail::MtPolicyd::Plugin::Greylist; use Moose; use namespace::autoclean; our $VERSION = '2.03'; # VERSION # ABSTRACT: This plugin implements a greylisting mechanism with an auto whitelist. extends 'Mail::MtPolicyd::Plugin'; with 'Mail::MtPolicyd::Plugin::Role::Scoring'; with 'Mail::MtPolicyd::Plugin::Role::UserConfig' => { 'uc_attributes' => [ 'enabled' ], }; use Mail::MtPolicyd::Plugin::Result; use Time::Piece; use Time::Seconds; has 'enabled' => ( is => 'rw', isa => 'Str', default => 'on' ); has 'score' => ( is => 'rw', isa => 'Maybe[Num]' ); has 'mode' => ( is => 'rw', isa => 'Str', default => 'passive'); has 'defer_message' => ( is => 'rw', isa => 'Str', default => 'defer greylisting is active'); has 'append_waittime' => ( is => 'rw', isa => 'Bool', default => 1 ); has 'use_autowl' => ( is => 'rw', isa => 'Bool', default => 1 ); has 'autowl_threshold' => ( is => 'rw', isa => 'Int', default => 3 ); has 'query_autowl' => ( is => 'rw', isa => 'Bool', default => 1 ); has 'create_ticket' => ( is => 'rw', isa => 'Bool', default => 1 ); sub _load_backend { my ( $self, $backend ) = @_; my $module = $self->$backend->{'module'}; if( ! defined $module ) { die("module must be specified for $backend backend!"); } my $module_full = join('::', 'Mail::MtPolicyd::Plugin::Greylist', $backend, $module); my $code = "require ".$module_full.";"; eval $code; ## no critic (ProhibitStringyEval) if($@) { die("could not load $backend backend: $@"); } my $instance; eval { $instance = $module_full->new(); }; if($@) { die("could not create $backend backend: $@"); } return $instance; } has 'AWL' => ( is => 'rw', isa => 'HashRef', default => sub { { module => 'Sql', } }, ); has '_awl' => ( is => 'ro', isa => 'Mail::MtPolicyd::Plugin::Greylist::AWL::Base', lazy => 1, default => sub { my $self = shift; return $self->_load_backend('AWL'); }, ); has 'Ticket' => ( is => 'rw', isa => 'HashRef', default => sub { { module => 'Memcached', } }, ); has '_ticket' => ( is => 'ro', isa => 'Mail::MtPolicyd::Plugin::Greylist::Ticket::Base', lazy => 1, default => sub { my $self = shift; return $self->_load_backend('Ticket'); }, ); sub init { my $self = shift; $self->_awl->init; $self->_ticket->init; return; } sub run { my ( $self, $r ) = @_; my $ip = $r->attr('client_address'); my $sender = $r->attr('sender'); my $recipient = $r->attr('recipient'); my @triplet = ($sender, $ip, $recipient); my $session = $r->session; my $enabled = $self->get_uc( $session, 'enabled' ); if( $enabled eq 'off' ) { return; } if( $self->use_autowl && $self->query_autowl ) { my ( $is_autowl ) = $r->do_cached('greylist-is_autowl', sub { $self->is_autowl( $r, @triplet ); } ); if( $is_autowl ) { $self->log($r, 'client on greylist autowl'); return $self->success( $r ); } } my ( $ticket ) = $r->do_cached('greylist-ticket', sub { $self->_ticket->get($r, @triplet) } ); if( defined $ticket ) { if( $self->_ticket->is_valid( $ticket ) ) { $self->log($r, join(',', @triplet).' has a valid greylisting ticket'); if( $self->use_autowl && ! $r->is_already_done('greylist-autowl-add') ) { $self->add_autowl( $r, @triplet ); } $self->_ticket->remove( $r, @triplet ); return $self->success( $r ); } $self->log($r, join(',', @triplet).' has a invalid greylisting ticket. wait again'); return( $self->defer( $ticket ) ); } if( $self->create_ticket ) { $self->log($r, 'creating new greylisting ticket'); $self->_ticket->create($r, @triplet); return( $self->defer ); } return; } sub defer { my ( $self, $ticket ) = @_; my $message = $self->defer_message; if( defined $ticket && $self->append_waittime ) { $message .= ' ('.( $ticket - time ).'s left)' } return( Mail::MtPolicyd::Plugin::Result->new( action => $message, abort => 1, ) ); } sub success { my ( $self, $r ) = @_; if( defined $self->score && ! $r->is_already_done('greylist-score') ) { $self->add_score($r, $self->name => $self->score); } if( $self->mode eq 'accept' || $self->mode eq 'dunno' ) { return( Mail::MtPolicyd::Plugin::Result->new( action => $self->mode, abort => 1, ) ); } return; } sub _extract_sender_domain { my ( $self, $sender ) = @_; my $sender_domain; if( $sender =~ /@/ ) { ( $sender_domain ) = $sender =~ /@([^@]+)$/; } else { # fallback to just the sender? $sender_domain = $sender; } return($sender_domain); } sub is_autowl { my ( $self, $r, $sender, $client_ip ) = @_; my $sender_domain = $self->_extract_sender_domain( $sender ); my $count = $r->do_cached('greylist-autowl-count', sub { $self->_awl->get( $sender_domain, $client_ip ); } ); if( ! defined $count ) { $self->log($r, 'client is not on autowl'); return(0); } if( $count < $self->autowl_threshold ) { $self->log($r, 'client has not yet reached autowl_threshold'); return(0); } $self->log($r, 'client has valid autowl. updating database'); $self->_awl->incr( $sender_domain, $client_ip ); return(1); } sub add_autowl { my ( $self, $r, $sender, $client_ip ) = @_; my $sender_domain = $self->_extract_sender_domain( $sender ); my $count = $r->do_cached('greylist-autowl-count', sub { $self->_awl->get( $sender_domain, $client_ip ); } ); if( defined $count ) { $self->log($r, 'client already on autowl, just incrementing count'); $self->_awl->incr( $sender_domain, $client_ip ); return; } $self->log($r, 'creating initial autowl entry'); $self->_awl->create( $sender_domain, $client_ip ); return; } sub cron { my $self = shift; my $server = shift; if( grep { $_ eq 'hourly' } @_ ) { $server->log(3, 'expiring greylist autowl...'); $self->_awl->expire( $self->autowl_expire_days ); $server->log(3, 'expiring greylist tickets...'); $self->_ticket->expire; } return; } __PACKAGE__->meta->make_immutable; 1; __END__ =pod =encoding UTF-8 =head1 NAME Mail::MtPolicyd::Plugin::Greylist - This plugin implements a greylisting mechanism with an auto whitelist. =head1 VERSION version 2.03 =head1 DESCRIPTION This plugin implements a greylisting mechanism with an auto whitelist. If a client connects it will return an defer and create a greylisting "ticket" for the combination of the address of the sender, the senders address and the recipient address. The ticket will be stored in memcached and will contain the time when the client was seen for the first time. The ticket will expire after the max_retry_wait timeout. The client will be defered until the min_retry_wait timeout has been reached. Only in the time between the min_retry_wait and max_retry_wait the request will pass the greylisting test. When the auto-whitelist is enabled (default) a record for every client which passes the greylisting test will be stored in the autowl_table. The table is based on the combination of the sender domain and client_address. If a client passed the test at least autowl_threshold (default 3) times the greylisting test will be skipped. Additional an last_seen timestamp is stored in the record and records which are older then the autowl_expire_days will expire. Please note the greylisting is done on a triplet based on the client_address + sender + recipient The auto-white list is based on the client_address + sender_domain =head1 PARAMETERS =over =item (uc_)enabled (default: on) Enable/disable this check. =item score (default: empty) Apply an score to this message if it _passed_ the greylisting test. In most cases you want to assign a negative score. (eg. -10) =item mode (default: passive) The default is to return no action if the client passed the greylisting test and continue. You can set this 'accept' or 'dunno' if you want skip further checks. =item defer_message (default: defer greylisting is active) This action is returned to the MTA if a message is defered. If a client retries too fast the time left till min_retry_wait is reach will be appended to the string. =item min_retry_wait (default: 300 (5m)) A client will have to wait at least for this timeout. (in seconds) =item max_retry_wait (default: 7200 (2h)) A client must retry to deliver the message before this timeout. (in seconds) =item use_autowl (default: 1) Could be used to disable the use of the auto-whitelist. =item autowl_threshold (default: 3) How often a client/sender_domain pair must pass the check before it is whitelisted. =item autowl_expire_days (default: 60) After how many days an auto-whitelist entry will expire if no client with this client/sender pair is seen. =item autowl_table (default: autowl) The name of the table to use. The database handle specified in the global configuration will be used. (see man mtpolicyd) =item query_autowl, create_ticket (default: 1) This options could be used to disable the creation of a new ticket or to query the autowl. This can be used to catch early retries at the begin of your configuration before more expensive checks are processed. Example: module = "Greylist" score = -5 mode = "passive" create_ticket = 0 query_autowl = 0 # ... a lot of RBL checks, etc... module = "ScoreAction" threshold = 5 module = "Greylist" score = -5 mode = "passive" This will prevent early retries from running thru all checks. =back =head1 AUTHOR Markus Benning =head1 COPYRIGHT AND LICENSE This software is Copyright (c) 2014 by Markus Benning . This is free software, licensed under: The GNU General Public License, Version 2, June 1991 =cut Role000755000000000000 013306510157 17500 5ustar00rootroot000000000000Mail-MtPolicyd-2.03/lib/Mail/MtPolicydConnection.pm100644000000000000 317713306510157 22305 0ustar00rootroot000000000000Mail-MtPolicyd-2.03/lib/Mail/MtPolicyd/Rolepackage Mail::MtPolicyd::Role::Connection; use strict; use MooseX::Role::Parameterized; use Mail::MtPolicyd::ConnectionPool; # ABSTRACT: role to consume connections from connection pool our $VERSION = '2.03'; # VERSION parameter name => ( isa => 'Str', default => 'db', ); parameter type => ( isa => 'Str', default => 'Sql', ); parameter initialize_early => ( isa => 'Bool', default => 1, ); role { my $p = shift; my $name = $p->name; my $conn_attr = '_'.$p->name; my $handle_attr = $conn_attr.'_handle'; my $conn_class = 'Mail::MtPolicyd::Connection::'.$p->type; if( $p->initialize_early ) { before 'init' => sub { my $self = shift; $self->$conn_attr; return; }; } has $name => ( is => 'ro', isa => 'Str', default => $name, ); has $conn_attr => ( is => 'ro', isa => $conn_class, lazy => 1, default => sub { my $self = shift; my $conn = Mail::MtPolicyd::ConnectionPool->get_connection($self->$name); if( ! defined $conn ) { die("no connection $name configured!"); } return $conn; }, ); method $handle_attr => sub { my $self = shift; return $self->$conn_attr->handle; }; }; 1; __END__ =pod =encoding UTF-8 =head1 NAME Mail::MtPolicyd::Role::Connection - role to consume connections from connection pool =head1 VERSION version 2.03 =head1 AUTHOR Markus Benning =head1 COPYRIGHT AND LICENSE This software is Copyright (c) 2014 by Markus Benning . This is free software, licensed under: The GNU General Public License, Version 2, June 1991 =cut Redis.pm100644000000000000 566213306510157 22453 0ustar00rootroot000000000000Mail-MtPolicyd-2.03/lib/Mail/MtPolicyd/Connectionpackage Mail::MtPolicyd::Connection::Redis; use Moose; our $VERSION = '2.03'; # VERSION # ABSTRACT: a mtpolicy connection for redis databases extends 'Mail::MtPolicyd::Connection'; use Redis; has 'server' => ( is => 'ro', isa => 'Str', default => '127.0.0.1:6379' ); has 'sock' => ( is => 'ro', isa => 'Maybe[Str]' ); has 'sentinels' => ( is => 'ro', isa => 'Maybe[Str]' ); has '_sentinels' => ( is => 'ro', isa => 'ArrayRef[Str]', lazy => 1, default => sub { [ split(/ \s*,\s*/, shift->sentinels ) ] }, ); has 'service' => ( is => 'ro', isa => 'Maybe[Str]' ); has 'debug' => ( is => 'ro', isa => 'Bool', default => 0 ); has 'password' => ( is => 'ro', isa => 'Maybe[Str]' ); has 'db' => ( is => 'ro', isa => 'Int', default => 0 ); sub _create_handle { my $self = shift; my %server = ( 'server' => $self->server ); if( defined $self->sentinels && $self->service ) { %server = ( 'sentinels' => $self->_sentinels, service => $self->service ); } elsif( defined $self->sock ) { %server = ( 'sock' => $self->sock ); } my $redis = Redis->new( %server, 'debug' => $self->debug, defined $self->password ? ( 'password' => $self->password ) : (), ); $redis->select( $self->db ); return $redis; } has 'handle' => ( is => 'rw', isa => 'Redis', lazy => 1, default => sub { my $self = shift; return $self->_create_handle; }, ); sub reconnect { my $self = shift; $self->handle( $self->_create_handle ); return; } sub shutdown { my $self = shift; $self->handle->wait_all_responses; $self->handle->quit; return; } 1; __END__ =pod =encoding UTF-8 =head1 NAME Mail::MtPolicyd::Connection::Redis - a mtpolicy connection for redis databases =head1 VERSION version 2.03 =head1 SYNOPSIS server = "127.0.0.1:6379" # or # sock = "/path/to/sock" # or # sentinels = "127.0.0.1:12345,127.0.0.1:23456" # service = "mymaster" db = 0 # password = "secret" =head1 PARAMETERS =over =item server (default: '127.0.0.1:6379') Connect to redis server with TCP/IP. Format: : =item sock (default: undef) Connect to redis server UNIX domain socket. Specify the path to the UNIX domain socket. =item sentinels (default: undef) Specify a comma separated list of sentinel instances to contact for finding the master for the service specified by "service" below. =item service (default: undef) Specify the service to ask the sentinel servers for. =item debug (default: 0) Set to 1 to enable debugging of redis connection. =item password (default: undef) Set password if required for redis connection. =item db (default: 0) Select a redis database to use. =back =head1 AUTHOR Markus Benning =head1 COPYRIGHT AND LICENSE This software is Copyright (c) 2014 by Markus Benning . This is free software, licensed under: The GNU General Public License, Version 2, June 1991 =cut Condition.pm100644000000000000 1215213306510157 22502 0ustar00rootroot000000000000Mail-MtPolicyd-2.03/lib/Mail/MtPolicyd/Pluginpackage Mail::MtPolicyd::Plugin::Condition; use Moose; use namespace::autoclean; our $VERSION = '2.03'; # VERSION # ABSTRACT: mtpolicyd plugin for conditions based on session values extends 'Mail::MtPolicyd::Plugin'; with 'Mail::MtPolicyd::Plugin::Role::Scoring'; with 'Mail::MtPolicyd::Plugin::Role::UserConfig' => { 'uc_attributes' => [ 'score', 'action' ], }; with 'Mail::MtPolicyd::Plugin::Role::PluginChain'; use Mail::MtPolicyd::Plugin::Result; has 'key' => ( is => 'rw', isa => 'Str', required => 1 ); has 'score' => ( is => 'rw', isa => 'Maybe[Num]' ); has 'action' => ( is => 'rw', isa => 'Maybe[Str]' ); has 'match' => ( is => 'rw', isa => 'Maybe[Str]' ); has 're_match' => ( is => 'rw', isa => 'Maybe[Str]' ); has 'gt_match' => ( is => 'rw', isa => 'Maybe[Num]' ); has 'lt_match' => ( is => 'rw', isa => 'Maybe[Num]' ); has 'invert' => ( is => 'rw', isa => 'Bool', default => 0 ); sub _match { my ( $self, $value ) = @_; if( defined $self->match && $value eq $self->match ) { return 1; } my $regex = $self->re_match; if( defined $regex && $value =~ m/$regex/ ) { return 1; } if( defined $self->lt_match && $value < $self->lt_match ) { return 1; } if( defined $self->gt_match && $value > $self->gt_match ) { return 1; } return 0; } sub run { my ( $self, $r ) = @_; my $key = $self->key; my $session = $r->session; my $value = $r->get( $key ); if( ! defined $value ) { return; } my $matched = $self->_match($value); if( $self->invert ) { $matched = ! $matched; } if( $matched ) { $self->log($r, $key.' matched '.$value); my $score = $self->get_uc($session, 'score'); if( defined $score ) { $self->add_score($r, $self->name => $score); } my $action = $self->get_uc($session, 'action'); if( defined $action ) { return Mail::MtPolicyd::Plugin::Result->new( action => $action, abort => 1, ); } if( defined $self->chain ) { my $chain_result = $self->chain->run( $r ); return( @{$chain_result->plugin_results} ); } } return; } __PACKAGE__->meta->make_immutable; 1; __END__ =pod =encoding UTF-8 =head1 NAME Mail::MtPolicyd::Plugin::Condition - mtpolicyd plugin for conditions based on session values =head1 VERSION version 2.03 =head1 DESCRIPTION Will return an action, score or execute futher plugins if the specified condition matched. =head1 PARAMETERS =over =item key (required) The name of the variable to check. Syntax is (:)? If no scope is give it defaults to request. Possible scopes are: =over =item session, s Session variables. =item request, r Request attribute variables. =back Examples: session:user_policy s:user_policy request:queue_id r:queue_id queue_id =back At least one of the following parameters should be given or your condition will never match: =over =item match (default: empty) Simple string equal match. =item re_match (default: empty) Match content of the session variable against an regex. =item lt_match (default: empty) Match if numerical less than. =item gt_match (default: empty) Match if numerical greater than. =item invert (default: 0) If set to 1 the logic will be inverted. =back Finally an action must be specified. First the score will be applied the the action will be executed or if specified additional plugins will be executed. =over =item action (default: empty) The action to return when the condition matched. =item score (default: empty) The score to add if the condition matched. =item Plugin (default: empty) Execute this plugins when the condition matched. =back =head1 EXAMPLE: use of postfix policy_context The policy_context of postfix could be used to trigger checks in mtpolicyd. To activate additional checks in mtpolicyd from within postfix use may use a configuration in postfix main.cf like: # check, no additional checks check_policy_service inet:localhost:12345 ... # check with additional checks! check_policy_service { inet:localhost:12345, policy_context=strict_checks } In mtpolicyd.conf: module = "Condition" key = "policy_context" match = "strict_checks" # ... # more checks ... The policy_context feature will be available in postfix 3.1 and later. If you need completely different checks consider using the vhost_by_policy_context (L) option with different virtual hosts. =head1 EXAMPLE: execute postgrey action in postfix If the session variable "greylisting" is "on" return the postfix action "postgrey": module = "Condition" key = "greylisting" match = "on" action = "postgrey" The variable may be set by a UserConfig module like SqlUserConfig. The postgrey action in postfix may look like: smtpd_restriction_classes = postgrey postgrey = check_policy_service inet:127.0.0.1:11023 =head1 AUTHOR Markus Benning =head1 COPYRIGHT AND LICENSE This software is Copyright (c) 2014 by Markus Benning . This is free software, licensed under: The GNU General Public License, Version 2, June 1991 =cut RBLAction.pm100644000000000000 1042513306510157 22332 0ustar00rootroot000000000000Mail-MtPolicyd-2.03/lib/Mail/MtPolicyd/Pluginpackage Mail::MtPolicyd::Plugin::RBLAction; use Moose; use namespace::autoclean; our $VERSION = '2.03'; # VERSION # ABSTRACT: mtpolicyd plugin for checking the client-address against an RBL extends 'Mail::MtPolicyd::Plugin'; with 'Mail::MtPolicyd::Plugin::Role::Scoring'; with 'Mail::MtPolicyd::Plugin::Role::UserConfig' => { 'uc_attributes' => [ 'enabled', 'mode' ], }; use Mail::MtPolicyd::Plugin::Result; use Mail::RBL; has 'result_from' => ( is => 'rw', isa => 'Str', required => 1 ); has 'enabled' => ( is => 'rw', isa => 'Str', default => 'on' ); has 'mode' => ( is => 'rw', isa => 'Str', default => 'reject' ); has 're_match' => ( is => 'rw', isa => 'Str', required => 1 ); has 'reject_message' => ( is => 'ro', isa => 'Str', default => 'delivery from %IP% rejected %INFO%', ); has 'score' => ( is => 'rw', isa => 'Maybe[Num]' ); sub run { my ( $self, $r ) = @_; my $ip = $r->attr('client_address'); my $session = $r->session; my $mode = $self->get_uc( $session, 'mode' ); my $enabled = $self->get_uc( $session, 'enabled' ); if( $enabled eq 'off' ) { return; } my $result_key = 'rbl-'.$self->result_from.'-result'; if( ! defined $session->{$result_key} || ref( $session->{$result_key} ) ne 'ARRAY' ) { $self->log( $r, 'no RBL check result for '.$self->name.' found!'); return; } my ( $ip_result, $info ) = @{$session->{$result_key}}; if( ! defined $ip_result ) { return; } my $regex = $self->re_match; if( $ip_result->addr !~ m/$regex/ ) { $self->log( $r, $ip_result->addr.' did not match regex '.$regex); return; } $self->log( $r, $ip_result->addr.' match regex '.$regex); if( defined $self->score && ! $r->is_already_done('rbl-'.$self->name.'-score') ) { $self->add_score($r, $self->name => $self->score); } if( $mode eq 'reject' ) { return Mail::MtPolicyd::Plugin::Result->new( action => $self->_get_reject_action($ip, $info), abort => 1, ); } if( $mode eq 'accept' ) { return Mail::MtPolicyd::Plugin::Result->new_dunno; } return; } sub _get_reject_action { my ( $self, $ip, $info ) = @_; my $message = $self->reject_message; $message =~ s/%IP%/$ip/; if( defined $info && $info ne '' ) { $message =~ s/%INFO%/($info)/; } else { $message =~ s/%INFO%//; } return('reject '.$message); } __PACKAGE__->meta->make_immutable; 1; __END__ =pod =encoding UTF-8 =head1 NAME Mail::MtPolicyd::Plugin::RBLAction - mtpolicyd plugin for checking the client-address against an RBL =head1 VERSION version 2.03 =head1 DESCRIPTION This plugin can be used when a more complex evaluation of an RBL result is needed that just match/not-match. With this plugin you can take the same actions as with the RBL plugin, but it can match the result with a regular expression. This allows one to take action based on the category in combined blacklists. =head1 PARAMETERS =over =item result_from (required) Use the query result of this RBL check. =item (uc_)enabled (default: on) Enable/disable this check. =item (uc_)mode (default: reject) =over =item reject Reject the message. (reject) =item accept Stop processing an accept this message. (dunno) =item passive Only apply the score if one is given. =back =item re_match (required) An regular expression to check the RBL result. =item reject_message (default: delivery from %IP% rejected %INFO%) A pattern for the reject message if mode is set to 'reject'. =item score (default: empty) Apply this score if the check matched. =back =head1 EXAMPLE module = "RBL" mode = "passive" domain="zen.spamhaus.org" module = "RBLAction" result_from = "spamhaus-rbl" mode = "passive" re_match = "^127\.0\.0\.[23]$" score = 5 module = "RBLAction" result_from = "spamhaus-rbl" mode = "passive" re_match = "^127\.0\.0\.[4-7]$" score = 5 module = "RBLAction" result_from = "spamhaus-rbl" mode = "passive" re_match = "^127\.0\.0\.1[01]$" score = 3 =head1 AUTHOR Markus Benning =head1 COPYRIGHT AND LICENSE This software is Copyright (c) 2014 by Markus Benning . This is free software, licensed under: The GNU General Public License, Version 2, June 1991 =cut RegexList.pm100644000000000000 1145413306510157 22466 0ustar00rootroot000000000000Mail-MtPolicyd-2.03/lib/Mail/MtPolicyd/Pluginpackage Mail::MtPolicyd::Plugin::RegexList; use Moose; use namespace::autoclean; our $VERSION = '2.03'; # VERSION # ABSTRACT: mtpolicyd plugin for regex matching extends 'Mail::MtPolicyd::Plugin'; with 'Mail::MtPolicyd::Plugin::Role::Scoring'; with 'Mail::MtPolicyd::Plugin::Role::UserConfig' => { 'uc_attributes' => [ 'enabled', 'score', 'action' ], }; with 'Mail::MtPolicyd::Plugin::Role::PluginChain'; use Mail::MtPolicyd::Plugin::Result; use File::Slurp; has 'enabled' => ( is => 'rw', isa => 'Str', default => 'on' ); has 'key' => ( is => 'rw', isa => 'Str', required => 1 ); has 'invert' => ( is => 'rw', isa => 'Bool', default => 0 ); has 'score' => ( is => 'rw', isa => 'Maybe[Num]' ); has 'action' => ( is => 'rw', isa => 'Maybe[Str]' ); around BUILDARGS => sub { my $orig = shift; my $class = shift; my %params = @_; if ( defined $params{'regex'} ) { if( ! ref($params{'regex'}) ) { $params{'regex'} = [ $params{'regex'} ]; } } return $class->$orig(%params); }; has 'regex' => ( is => 'rw', isa => 'ArrayRef[Str]', default => sub { [] }); has 'file' => ( is => 'rw', isa => 'Maybe[Str]' ); has '_file_regex_list' => ( is => 'ro', isa => 'ArrayRef', lazy => 1, default => sub { my $self = shift; if( ! defined $self->file ) { return []; } my @regexes; foreach my $line ( read_file($self->file) ) { chomp $line; if( $line =~ /^\s*$/ ) { next; } if( $line =~ /^\s*#/ ) { next; } push( @regexes, $line ); } return \@regexes; }, ); has '_regex_list' => ( is => 'ro', isa => 'ArrayRef', lazy => 1, default => sub { my $self = shift; return [ @{$self->regex}, @{$self->_file_regex_list} ] }, ); sub _match_regex_list { my ( $self, $r, $value ) = @_; foreach my $regex_str ( @{$self->_regex_list} ) { my $regex = eval { qr/$regex_str/ }; if( $@ ) { $self->log($r, "invalid regex $regex: $@"); next; } if( $value =~ /$regex/ ) { return $regex_str; } } return; } sub run { my ( $self, $r ) = @_; my $value = $r->get( $self->key ); my $session = $r->session; if( $self->get_uc( $session, 'enabled') eq 'off' ) { return; } if( ! defined $value) { $self->log($r, 'no attribute \''.$self->key.'\' in request'); return; } my ( $regex ) = $r->do_cached( $self->name.'-result', sub { $self->_match_regex_list($r, $value) } ); if( ( ! $self->invert && defined $regex ) || ( $self->invert && ! defined $regex ) ) { $self->log($r, $self->key.'='.$value.' matched '.$self->name); my $score = $self->get_uc( $session, 'score'); if( defined $score && ! $r->is_already_done($self->name.'-score') ) { $self->add_score($r, $self->name => $score); } # apply action my $action = $self->get_uc( $session, 'action'); if( defined $action ) { return Mail::MtPolicyd::Plugin::Result->new( action => $action, abort => 1, ); } # or cascade if( defined $self->chain ) { my $chain_result = $self->chain->run( $r ); return( @{$chain_result->plugin_results} ); } } return; } __PACKAGE__->meta->make_immutable; 1; __END__ =pod =encoding UTF-8 =head1 NAME Mail::MtPolicyd::Plugin::RegexList - mtpolicyd plugin for regex matching =head1 VERSION version 2.03 =head1 SYNOPSIS module = "RegexList" key = "request:client_name" regex = "^mail-[a-z][a-z]0-f[0-9]*\.google\.com$" regex = "\.bofh-noc\.de$" # file = "/etc/mtpolicyd/regex-whitelist.txt" action = "accept" =head1 DESCRIPTION This plugin matches a value against a list of regular expressions and executes an action if it matched. =head2 PARAMETERS The module takes the following parameters: =over =item (uc_)enabled (default: "on") Could be set to 'off' to deactivate check. Could be used to activate/deactivate check per user. =item key (default: "request:client_address") Field to query. =item invert (default: 0) If set to 1 the logic will be inverted. =item regex (default: empty) One or more regular expressions =item file (default: empty) A file to load regular expressions from. One regex per line. Empty lines and lines starting with # will be ignored. =back By default the plugin will do nothing. One of the following actions should be specified: =over =item action (default: empty) If given this action will be returned to the MTA if the SQL query matched. =item score (default: empty) If given this score will be applied to the session. =item Plugin (default: empty) Execute this plugins when the condition matched. =back =head1 AUTHOR Markus Benning =head1 COPYRIGHT AND LICENSE This software is Copyright (c) 2014 by Markus Benning . This is free software, licensed under: The GNU General Public License, Version 2, June 1991 =cut PostfixMap.pm100644000000000000 1163713306510157 22655 0ustar00rootroot000000000000Mail-MtPolicyd-2.03/lib/Mail/MtPolicyd/Pluginpackage Mail::MtPolicyd::Plugin::PostfixMap; use Moose; use namespace::autoclean; our $VERSION = '2.03'; # VERSION # ABSTRACT: mtpolicyd plugin for accessing a postfix access map extends 'Mail::MtPolicyd::Plugin'; with 'Mail::MtPolicyd::Plugin::Role::Scoring'; with 'Mail::MtPolicyd::Plugin::Role::UserConfig' => { 'uc_attributes' => [ 'enabled' ], }; use Mail::MtPolicyd::Plugin::Result; use BerkeleyDB; use BerkeleyDB::Hash; has 'enabled' => ( is => 'rw', isa => 'Str', default => 'on' ); has 'db_file' => ( is => 'rw', isa => 'Str', required => 1 ); has _map => ( is => 'ro', isa => 'HashRef', lazy => 1, default => sub { my $self = shift; my %map; my $db = tie %map, 'BerkeleyDB::Hash', -Filename => $self->db_file, -Flags => DB_RDONLY or die "Cannot open ".$self->db_file.": $!\n" ; $db->filter_fetch_key ( sub { s/\0$// } ) ; $db->filter_store_key ( sub { $_ .= "\0" } ) ; $db->filter_fetch_value( sub { s/\0$// } ) ; $db->filter_store_value( sub { $_ .= "\0" } ) ; return(\%map); }, ); has 'score' => ( is => 'rw', isa => 'Maybe[Num]' ); has 'match_action' => ( is => 'rw', isa => 'Maybe[Str]' ); has 'not_match_action' => ( is => 'rw', isa => 'Maybe[Str]' ); sub _match_ipv4 { my ( $self, $ip ) = @_; my @octs = split('\.', $ip); while( @octs ) { my $key = join('.', @octs); my $value = $self->_map->{$key}; if( defined $value ) { return( $key, $value ); } pop(@octs); } return; } sub _match_ipv6 { my ( $self, $ip ) = @_; for(;;) { my $value = $self->_map->{$ip}; if( $value ) { return( $ip, $value ); } if( $ip !~ m/:/) { last; } # remove last part $ip =~ s/:+[^:]+$//; } return; } sub _query_db { my ( $self, $ip ) = @_; my ( $key, $value ); if( $ip =~ m/^\d+\.\d+\.\d+\.\d+$/) { ( $key, $value ) = $self->_match_ipv4( $ip ); } elsif( $ip =~ m/^[:0-9a-f]+$/) { ( $key, $value ) = $self->_match_ipv6( $ip ); } else { die('ip is neither a valid ipv4 nor ipv6 address.'); } if( ! defined $value ) { return; } if( $value eq 'OK' || $value =~ m/^\d+$/) { return( 1, $key, $value ); } return(0, $key, $value); } sub run { my ( $self, $r ) = @_; my $ip = $r->attr('client_address'); my $session = $r->session; my $config; if( $self->get_uc( $session, 'enabled') eq 'off' ) { return; } if( ! defined $ip) { $self->log($r, 'no attribute \'client_address\' in request'); return; } my ( $match, $key, $value ) = $r->do_cached( $self->name.'-result', sub { $self->_query_db($ip) } ); if( $match ) { $self->log($r, 'client_address '.$ip.' matched '.$self->name.' ('. $key.' '.$value.')' ); if( defined $self->score && ! $r->is_already_done($self->name.'-score') ) { $self->add_score($r, $self->name => $self->score); } if( defined $self->match_action ) { return Mail::MtPolicyd::Plugin::Result->new( action => $self->match_action, abort => 1, ); } } else { $self->log($r, 'client_address '.$ip.' did not match '.$self->name); if( defined $self->not_match_action ) { return Mail::MtPolicyd::Plugin::Result->new( action => $self->not_match_action, abort => 1, ); } } return; } __PACKAGE__->meta->make_immutable; 1; __END__ =pod =encoding UTF-8 =head1 NAME Mail::MtPolicyd::Plugin::PostfixMap - mtpolicyd plugin for accessing a postfix access map =head1 VERSION version 2.03 =head1 SYNOPSIS module="PostfixMap" db_file="/etc/postfix/whitelist.db" match_action=dunno moduel="PostfixMap" db_file="/etc/postfix/blacklist.db" match_action="reject you are blacklisted!" =head1 DESCRIPTION Plugin checks the client_address against a postfix hash table. It will only check if the IP address matches the list. 'OK' or a numerical value will be interpreted as a 'true' value. All other actions or values will be treaded as 'false'. =head1 EXAMPLE TABLE /etc/postfix/whitelist: 123.123.123.123 OK 123.123.122 OK 123.12 OK fe80::250:56ff:fe85:56f5 OK fe80::250:56ff:fe83 OK generate whitelist.db: $ postmap whitelist =head2 PARAMETERS The module takes the following parameters: =over =item (uc_)enabled (default: "on") Could be set to 'off' to deactivate check. Could be used to activate/deactivate check per user. =back By default the plugin will do nothing. One of the following actions should be specified: =over =item match_action (default: empty) If given this action will be returned to the MTA if the SQL query matched. =item not_match_action (default: empty) If given this action will be returned to the MTA if the SQL query DID NOT matched. =item score (default: empty) If given this score will be applied to the session. =back =head1 AUTHOR Markus Benning =head1 COPYRIGHT AND LICENSE This software is Copyright (c) 2014 by Markus Benning . This is free software, licensed under: The GNU General Public License, Version 2, June 1991 =cut SMTPVerify.pm100644000000000000 2136713306510157 22534 0ustar00rootroot000000000000Mail-MtPolicyd-2.03/lib/Mail/MtPolicyd/Pluginpackage Mail::MtPolicyd::Plugin::SMTPVerify; use Moose; use namespace::autoclean; our $VERSION = '2.03'; # VERSION # ABSTRACT: mtpolicyd plugin for remote SMTP address checks extends 'Mail::MtPolicyd::Plugin'; with 'Mail::MtPolicyd::Plugin::Role::Scoring'; with 'Mail::MtPolicyd::Plugin::Role::UserConfig' => { 'uc_attributes' => [ 'enabled' ], }; use Mail::MtPolicyd::Plugin::Result; use Net::SMTP::Verify; has 'enabled' => ( is => 'rw', isa => 'Str', default => 'on' ); has 'host' => ( is => 'ro', isa => 'Maybe[Str]' ); has 'port' => ( is => 'ro', isa => 'Maybe[Int]' ); has 'check_tlsa' => ( is => 'ro', isa => 'Str', default => 'off' ); has 'check_openpgp' => ( is => 'ro', isa => 'Str', default => 'off' ); with 'Mail::MtPolicyd::Plugin::Role::ConfigurableFields' => { 'fields' => { 'size' => { isa => 'Str', default => 'size', value_isa => 'Int', }, 'sender' => { isa => 'Str', default => 'recipient', value_isa => 'Str', }, 'recipient' => { isa => 'Str', default => 'sender', value_isa => 'Str', }, }, }; has 'temp_fail_action' => ( is => 'rw', isa => 'Maybe[Str]' ); has 'temp_fail_score' => ( is => 'rw', isa => 'Maybe[Num]' ); has 'perm_fail_action' => ( is => 'rw', isa => 'Maybe[Str]' ); has 'perm_fail_score' => ( is => 'rw', isa => 'Maybe[Num]' ); has 'has_starttls_score' => ( is => 'rw', isa => 'Maybe[Num]' ); has 'no_starttls_score' => ( is => 'rw', isa => 'Maybe[Num]' ); has 'has_tlsa_score' => ( is => 'rw', isa => 'Maybe[Num]' ); has 'no_tlsa_score' => ( is => 'rw', isa => 'Maybe[Num]' ); has 'has_openpgp_score' => ( is => 'rw', isa => 'Maybe[Num]' ); has 'no_openpgp_score' => ( is => 'rw', isa => 'Maybe[Num]' ); has 'sender' => ( is => 'ro', isa => 'Maybe[Str]' ); # store current request for logging_callback has '_current_request' => ( is => 'rw', isa => 'Maybe[Mail::MtPolicyd::Request]' ); has '_verify' => ( is => 'ro', isa => 'Net::SMTP::Verify', lazy => 1, default => sub { my $self = shift; return Net::SMTP::Verify->new( defined $self->host ? ( host => $self->host ) : (), defined $self->port ? ( port => $self->port ) : (), $self->check_tlsa eq 'on' ? ( tlsa => 1 ) : (), $self->check_openpgp eq 'on' ? ( openpgp => 1 ) : (), logging_callback => sub { my $msg = shift; my $r = $self->_current_request; if( defined $r ) { $self->log( $r, $msg ); } return; }, ); }, ); sub get_sender { my ( $self, $r ) = @_; if( defined $self->sender ) { return( $self->sender ); } return $self->get_sender_value( $r ); } sub run { my ( $self, $r ) = @_; $self->_current_request( $r ); my $session = $r->session; if( $self->get_uc( $session, 'enabled') eq 'off' ) { return; } my $size = $self->get_size_value( $r ); my $sender = $self->get_sender( $r ); my $recipient = $self->get_recipient_value( $r ); if( $r->is_already_done('verify-'.$recipient) ) { return; } my $result = $self->_verify->check( $size, $sender, $recipient ); if( ! $result->count ) { die('Net::SMTP::Verify returned empty resultset!'); # should not happen } my ( $rcpt ) = $result->entries; $self->_apply_score( $r, $rcpt, 'starttls' ); if( $self->check_tlsa eq 'on' ) { $self->_apply_score( $r, $rcpt, 'tlsa' ); } if( $self->check_openpgp eq 'on' ) { $self->_apply_score( $r, $rcpt, 'openpgp' ); } if( $rcpt->is_error ) { return $self->_handle_rcpt_error( $r, $rcpt ); } $self->_current_request( undef ); return; } sub _apply_score { my ( $self, $r, $rcpt, $name ) = @_; my $field = 'has_'.$name; my $value = $rcpt->$field; if( ! defined $value ) { return; } my $score_field; if( $value ) { $score_field = 'has_'.$name.'_score'; } else { $score_field = 'no_'.$name.'_score'; } my $score = $self->$score_field; if( ! defined $score ) { return; } $self->add_score($r, $self->name.'-'.$rcpt->address.'-'.$name => $score ); return; } sub _handle_rcpt_error { my ( $self, $r, $rcpt ) = @_; my $action; if( $rcpt->is_perm_error ) { if( defined $self->perm_fail_action ) { $action = $self->perm_fail_action; } if( defined $self->perm_fail_score ) { $self->add_score($r, $self->name.'-'.$rcpt->address => $self->perm_fail_score); } } elsif( $rcpt->is_temp_error ) { if( defined $self->temp_fail_action ) { $action = $self->temp_fail_action; } if( defined $self->temp_fail_score ) { $self->add_score($r, $self->name.'-'.$rcpt->address => $self->temp_fail_score ); } } else { return; } if( ! defined $action ) { return; } my $msg = $rcpt->smtp_message; $action =~ s/%MSG%/$msg/; return Mail::MtPolicyd::Plugin::Result->new( action => $action, abort => 1, ); } __PACKAGE__->meta->make_immutable; 1; __END__ =pod =encoding UTF-8 =head1 NAME Mail::MtPolicyd::Plugin::SMTPVerify - mtpolicyd plugin for remote SMTP address checks =head1 VERSION version 2.03 =head1 DESCRIPTION This plugin can be used to do remote SMTP verification of addresses. =head1 Example To check if the recipient exists on a internal relay and mailbox is able to recieve a message of this size: module = "SMTPVerify" host = "mail.company.internal" sender_field = "sender" recipient_field = "recipient" # send SIZE to check quota size_field = "size" temp_fail_action = "defer %MSG%" perm_fail_action = "reject %MSG%" Do some very strict checks on sender address: module = "SMTPVerify" # use a verifiable address in MAIL FROM: sender = "horst@mydomain.tld" recipient_field = "sender" no_starttls_action = "reject sender address does not support STARTTLS" temp_fail_action = "defer sender address failed verification: %MSG%" perm_fail_action = "reject sender address does not accept mail: %MSG%" Or do advanced checking of sender address and apply a score: module = "SMTPVerify" # use a verifiable address in MAIL FROM: sender = "horst@mydomain.tld" recipient_field = "sender" check_tlsa = "on" check_openpgp = "on" temp_fail_score = "1" perm_fail_score = "3" has_starttls_score = "-1" no_starttls_score = "5" has_tlsa_score = "-3" has_openpgp_score = "-3" Based on the score you can later apply greylisting or other actions. =head1 Configuration =head2 Parameters The module takes the following parameters: =over =item (uc_)enabled (default: on) Enable/disable this check. =item host (default: empty) If defined this host will be used for checks instead of a MX. =item port (default: 25) Port to use for connection. =item check_tlsa (default: off) Set to 'on' to enable check if an TLSA record for the MX exists. This requires that your DNS resolver returnes the AD flag for DNSSEC secured records. =item check_openpgp (default: off) Set to 'on' to enable check if an OPENPGPKEY records for the recipients exists. =item sender_field (default: recipient) Field to take the MAIL FROM address from. =item sender (default: empty) If set use this fixed sender in MAIL FROM instead of sender_field. =item recipient_field (default: sender) Field to take the RCPT TO address from. =item size_field (default: size) Field to take the message SIZE from. =item perm_fail_action (default: empty) Action to return if the remote server returned an permanent error for this recipient. The string "%MSG%" will be replaced by the smtp message: perm_fail_action = "reject %MSG%" =item temp_fail_action (default: empty) Like perm_fail_action but this message is returned when an temporary error is returned by the remote smtp server. temp_fail_action = "defer %MSG%" =item perm_fail_score (default: empty) Score to apply when a permanent error is returned for this recipient. =item temp_fail_score (default: empty) Score to apply when a temporary error is returned for this recipient. =item has_starttls_score (default: emtpy) =item no_starttls_score (default: emtpy) Score to apply when the smtp server of the recipient announces support for STARTTLS extension. =item has_tlsa_score (default: empty) =item no_tlsa_score (default: empty) Score to apply when there is a TLSA or no TLSA record for the remote SMTP server. =item has_openpgp_score (default: empty) =item no_openpgp_score (default: empty) Score to apply when a OPENPGPKEY record for the recpient exists or not exists. =back =head1 AUTHOR Markus Benning =head1 COPYRIGHT AND LICENSE This software is Copyright (c) 2014 by Markus Benning . This is free software, licensed under: The GNU General Public License, Version 2, June 1991 =cut Accounting.pm100644000000000000 1724013306510157 22651 0ustar00rootroot000000000000Mail-MtPolicyd-2.03/lib/Mail/MtPolicyd/Pluginpackage Mail::MtPolicyd::Plugin::Accounting; use Moose; use namespace::autoclean; our $VERSION = '2.03'; # VERSION # ABSTRACT: mtpolicyd plugin for accounting in sql tables extends 'Mail::MtPolicyd::Plugin'; with 'Mail::MtPolicyd::Plugin::Role::UserConfig' => { 'uc_attributes' => [ 'enabled' ], }; use Mail::MtPolicyd::Plugin::Result; use Time::Piece; has 'enabled' => ( is => 'rw', isa => 'Str', default => 'on' ); has 'fields' => ( is => 'rw', isa => 'Str', required => 1); has '_fields' => ( is => 'ro', isa => 'ArrayRef', lazy => 1, default => sub { my $self = shift; return [ split('\s*,\s*', $self->fields) ]; }, ); has 'time_pattern' => ( is => 'rw', isa => 'Str', default => '%Y-%m'); with 'Mail::MtPolicyd::Role::Connection' => { name => 'db', type => 'Sql', }; with 'Mail::MtPolicyd::Plugin::Role::SqlUtils'; sub get_timekey { my $self = shift; return Time::Piece->new->strftime( $self->time_pattern ); } has 'table_prefix' => ( is => 'rw', isa => 'Str', default => 'acct_'); sub run { my ( $self, $r ) = @_; my $session = $r->session; if( $self->get_uc( $session, 'enabled') eq 'off' ) { return; } if( $r->is_already_done( $self->name.'-acct' ) ) { $self->log( $r, 'accounting already done for this mail, skipping...'); return; } my $metrics = $self->get_request_metrics( $r ); foreach my $field ( @{$self->_fields} ) { my $key = $r->attr($field); if( ! defined $key || $key =~ /^\s*$/ ) { $self->log( $r, $field.' not defined in request, skipping...'); next; } $self->log( $r, 'updating accounting info for '.$field.' '.$key); $self->update_accounting($field, $key, $metrics); } return; } sub init { my $self = shift; $self->check_sql_tables( %{$self->_table_definitions} ); return; } has '_single_table_create' => ( is => 'ro', isa => 'HashRef', lazy => 1, default => sub { { 'mysql' => 'CREATE TABLE %TABLE_NAME% ( `id` int(11) NOT NULL AUTO_INCREMENT, `key` VARCHAR(255) NOT NULL, `time` VARCHAR(255) NOT NULL, `count` INT UNSIGNED NOT NULL, `count_rcpt` INT UNSIGNED NOT NULL, `size` INT UNSIGNED NOT NULL, `size_rcpt` INT UNSIGNED NOT NULL, PRIMARY KEY (`id`), UNIQUE KEY `time_key` (`key`, `time`), KEY(`key`), KEY(`time`) ) ENGINE=%MYSQL_ENGINE% DEFAULT CHARSET=latin1', 'SQLite' => 'CREATE TABLE %TABLE_NAME% ( `id` INTEGER PRIMARY KEY AUTOINCREMENT, `key` VARCHAR(255) NOT NULL, `time` VARCHAR(255) NOT NULL, `count` INT UNSIGNED NOT NULL, `count_rcpt` INT UNSIGNED NOT NULL, `size` INT UNSIGNED NOT NULL, `size_rcpt` INT UNSIGNED NOT NULL )', } } ); sub get_table_name { my ( $self, $field ) = @_; return( $self->table_prefix . $field ); } has '_table_definitions' => ( is => 'ro', isa => 'HashRef', lazy => 1, default => sub { my $self = shift; my $tables = {}; foreach my $field ( @{$self->_fields} ) { my $table_name = $self->get_table_name($field); $tables->{$table_name} = $self->_single_table_create; } return $tables; }, ); sub get_request_metrics { my ( $self, $r ) = @_; my $recipient_count = $r->attr('recipient_count'); my $size = $r->attr('size'); my $metrics = {}; my $rcpt_cnt = defined $recipient_count ? $recipient_count : 1; $metrics->{'size'} = defined $size ? $size : 0; $metrics->{'count'} = 1; $metrics->{'count_rcpt'} = $rcpt_cnt ? $rcpt_cnt : 1; $metrics->{'size_rcpt'} = $rcpt_cnt ? $size * $rcpt_cnt : $size; return( $metrics ); } sub update_accounting { my ( $self, $field, $key, $metrics ) = @_; eval { $self->update_accounting_row($field, $key, $metrics); }; if( $@ =~ /^accounting row does not exist/ ) { $self->insert_accounting_row($field, $key, $metrics); } elsif( $@ ) { die( $@ ); } return; } sub insert_accounting_row { my ( $self, $field, $key, $metrics ) = @_; my $dbh = $self->_db_handle; my $table_name = $dbh->quote_identifier( $self->get_table_name($field) ); my $values = { 'key' => $key, 'time' => $self->get_timekey, %$metrics, }; my $col_str = join(', ', map { $dbh->quote_identifier($_) } keys %$values); my $values_str = join(', ', map { $dbh->quote($_) } values %$values); my $sql = "INSERT INTO $table_name ($col_str) VALUES ($values_str)"; $self->execute_sql($sql); return; } sub update_accounting_row { my ( $self, $field, $key, $metrics ) = @_; my $dbh = $self->_db_handle; my $table_name = $dbh->quote_identifier( $self->get_table_name($field) ); my $where = { 'key' => $key, 'time' => $self->get_timekey, }; my $values_str = join(', ', map { $dbh->quote_identifier($_).'='. $dbh->quote_identifier($_).'+'.$dbh->quote($metrics->{$_}) } keys %$metrics); my $where_str = join(' AND ', map { $dbh->quote_identifier($_).'='.$dbh->quote($where->{$_}) } keys %$where ); my $sql = "UPDATE $table_name SET $values_str WHERE $where_str"; my $rows = $dbh->do($sql); if( $rows == 0 ) { die('accounting row does not exist'); } return; } __PACKAGE__->meta->make_immutable; 1; __END__ =pod =encoding UTF-8 =head1 NAME Mail::MtPolicyd::Plugin::Accounting - mtpolicyd plugin for accounting in sql tables =head1 VERSION version 2.03 =head1 SYNOPSIS module = "Accounting" # per ip and user fields = "client_address,sasl_username" # statistics per month time_pattern = "%Y-%m" table_prefix = "acct_" This will create a table acct_client_address and a table acct_sasl_username. If a request is received containing the field the plugin will update the row in the fields table. The key is the fields value(ip or username) and the time string build from the time_pattern. For each key the following counters are stored: * count * count_rcpt (count per recipient) * size * size_rcpt (size * recipients) The resulting tables will look like: mysql> select * from acct_client_address; +----+--------------+---------+-------+------------+--------+-----------+ | id | key | time | count | count_rcpt | size | size_rcpt | +----+--------------+---------+-------+------------+--------+-----------+ | 1 | 192.168.0.1 | 2014-12 | 11 | 11 | 147081 | 147081 | | 2 | 192.168.1.1 | 2014-12 | 1 | 1 | 13371 | 13371 | | 12 | 192.168.2.1 | 2014-12 | 10 | 100 | 133710 | 1337100 | ... =head2 PARAMETERS The module takes the following parameters: =over =item (uc_)enabled (default: on) Enable/disable this check. =item fields (required) A comma separated list of fields used for accounting. For each field a table will be created. For a list of available fields see postfix documentation: http://www.postfix.org/SMTPD_POLICY_README.html =item time_pattern (default: "%Y-%m") A format string for building the time key used to store counters. Default is to build counters on a monthly base. For example use: * "%Y-%W" for weekly * "%Y-%m-%d" for daily See "man date" for format string sequences. =item table_prefix (default: "acct_") A prefix to add to every table. The table name will be the prefix + field_name. =back =head1 DESCRIPTION This plugin can be used to do accounting based on request fields. =head1 AUTHOR Markus Benning =head1 COPYRIGHT AND LICENSE This software is Copyright (c) 2014 by Markus Benning . This is free software, licensed under: The GNU General Public License, Version 2, June 1991 =cut SessionCache000755000000000000 013306510157 21146 5ustar00rootroot000000000000Mail-MtPolicyd-2.03/lib/Mail/MtPolicydBase.pm100644000000000000 142213306510157 22515 0ustar00rootroot000000000000Mail-MtPolicyd-2.03/lib/Mail/MtPolicyd/SessionCachepackage Mail::MtPolicyd::SessionCache::Base; use Moose; our $VERSION = '2.03'; # VERSION # ABSTRACT: base class for session cache adapters sub retrieve_session { my ($self, $instance ) = @_; return {}; } sub store_session { my ($self, $session ) = @_; return; } sub init { my ( $self ) = @_; return; } sub shutdown { my ( $self ) = @_; return; } 1; __END__ =pod =encoding UTF-8 =head1 NAME Mail::MtPolicyd::SessionCache::Base - base class for session cache adapters =head1 VERSION version 2.03 =head1 AUTHOR Markus Benning =head1 COPYRIGHT AND LICENSE This software is Copyright (c) 2014 by Markus Benning . This is free software, licensed under: The GNU General Public License, Version 2, June 1991 =cut None.pm100644000000000000 112213306510157 22537 0ustar00rootroot000000000000Mail-MtPolicyd-2.03/lib/Mail/MtPolicyd/SessionCachepackage Mail::MtPolicyd::SessionCache::None; use Moose; our $VERSION = '2.03'; # VERSION # ABSTRACT: dummy session caching adapter extends 'Mail::MtPolicyd::SessionCache::Base'; 1; __END__ =pod =encoding UTF-8 =head1 NAME Mail::MtPolicyd::SessionCache::None - dummy session caching adapter =head1 VERSION version 2.03 =head1 AUTHOR Markus Benning =head1 COPYRIGHT AND LICENSE This software is Copyright (c) 2014 by Markus Benning . This is free software, licensed under: The GNU General Public License, Version 2, June 1991 =cut ClearFields.pm100644000000000000 435013306510157 22712 0ustar00rootroot000000000000Mail-MtPolicyd-2.03/lib/Mail/MtPolicyd/Pluginpackage Mail::MtPolicyd::Plugin::ClearFields; use Moose; use namespace::autoclean; our $VERSION = '2.03'; # VERSION # ABSTRACT: mtpolicyd plugin to unset session variables extends 'Mail::MtPolicyd::Plugin'; use Mail::MtPolicyd::Plugin::Result; has 'fields' => ( is => 'rw', isa => 'Maybe[Str]' ); has 'fields_prefix' => ( is => 'rw', isa => 'Maybe[Str]' ); sub clear_fields { my ( $self, $r ) = @_; my @fields = split(/\s*,\s*/, $self->fields); $self->log($r, 'clearing fields '.join(', ', @fields)); foreach my $field ( @fields ) { delete $r->session->{$field}; } return; } sub clear_fields_prefix { my ( $self, $r ) = @_; my @prefixes = split(/\s*,\s*/, $self->fields_prefix); $self->log($r, 'clearing fields with prefixes: '.join(', ', @prefixes)); foreach my $prefix ( @prefixes ) { foreach my $field ( keys %{$r->session} ) { if( $field !~ /^\Q$prefix\E/) { next; } delete $r->session->{$field}; } } return; } sub run { my ( $self, $r ) = @_; if( defined $self->fields) { $self->clear_fields( $r ); } if( defined $self->fields_prefix) { $self->clear_fields_prefix( $r ); } return; } __PACKAGE__->meta->make_immutable; 1; __END__ =pod =encoding UTF-8 =head1 NAME Mail::MtPolicyd::Plugin::ClearFields - mtpolicyd plugin to unset session variables =head1 VERSION version 2.03 =head1 DESCRIPTION This plugin could be used to reset some session variables. =head1 PARAMETERS =over =item fields (default: empty) A comma separated list of session variables to unset. =item fields_prefix (default: empty) A comma separated list of prefixes. All session variables with this prefixes will be unset. =back =head1 EXAMPLE module = "ClearFields" fields = "spamhaus-rbl,spamhaus-dbl" Will remove both fields from the session. module = "ClearFields" fields_prefix = "spamhaus-" Will also remove both fields and everything else starting with "spamhaus-" from the session. =head1 AUTHOR Markus Benning =head1 COPYRIGHT AND LICENSE This software is Copyright (c) 2014 by Markus Benning . This is free software, licensed under: The GNU General Public License, Version 2, June 1991 =cut GeoIPAction.pm100644000000000000 715313306510157 22642 0ustar00rootroot000000000000Mail-MtPolicyd-2.03/lib/Mail/MtPolicyd/Pluginpackage Mail::MtPolicyd::Plugin::GeoIPAction; use Moose; use namespace::autoclean; our $VERSION = '2.03'; # VERSION # ABSTRACT: mtpolicyd plugin for checking geo information of an ip extends 'Mail::MtPolicyd::Plugin'; with 'Mail::MtPolicyd::Plugin::Role::Scoring'; with 'Mail::MtPolicyd::Plugin::Role::UserConfig' => { 'uc_attributes' => [ 'enabled', 'mode' ], }; use Mail::MtPolicyd::Plugin::Result; has 'result_from' => ( is => 'rw', isa => 'Str', required => 1 ); has 'enabled' => ( is => 'rw', isa => 'Str', default => 'on' ); has 'mode' => ( is => 'rw', isa => 'Str', default => 'reject' ); has 'country_codes' => ( is => 'rw', isa => 'Str', required => 1 ); has '_country_codes' => ( is => 'ro', isa => 'ArrayRef', lazy => 1, default => sub { my $self = shift; return [ split(/\s*,\s*/, $self->country_codes) ]; }, ); sub is_in_country_codes { my ( $self, $cc ) = @_; if ( grep { $_ eq $cc } @{$self->_country_codes} ) { return(1); } return(0); } has 'reject_message' => ( is => 'ro', isa => 'Str', default => 'delivery from %CC% (%IP%) rejected', ); has 'score' => ( is => 'rw', isa => 'Maybe[Num]' ); sub run { my ( $self, $r ) = @_; my $ip = $r->attr('client_address'); my $session = $r->session; my $mode = $self->get_uc( $session, 'mode' ); my $enabled = $self->get_uc( $session, 'enabled' ); if( $enabled eq 'off' ) { return; } my $result_key = 'geoip-'.$self->result_from.'-result'; if( ! defined $session->{$result_key} ) { $self->log( $r, 'no GeoIP check result for '.$self->name.' found!'); return; } my ( $country_code ) = @{$session->{$result_key}}; if( ! defined $country_code ) { return; } if( ! $self->is_in_country_codes( $country_code ) ) { $self->log( $r, 'country_code '.$country_code.' of IP not in country_code list'.$self->name); return; } $self->log( $r, 'country code '.$country_code.' on list'.$self->name ); if( defined $self->score && ! $r->is_already_done('geoip-'.$self->name.'-score') ) { $self->add_score($r, $self->name => $self->score); } if( $mode eq 'reject' ) { return Mail::MtPolicyd::Plugin::Result->new( action => $self->_get_reject_action($ip, $country_code ), abort => 1, ); } if( $mode eq 'accept' || $mode eq 'dunno' ) { return Mail::MtPolicyd::Plugin::Result->new_dunno; } return; } sub _get_reject_action { my ( $self, $ip, $cc ) = @_; my $message = $self->reject_message; $message =~ s/%IP%/$ip/; $message =~ s/%CC%/$cc/; return('reject '.$message); } __PACKAGE__->meta->make_immutable; 1; __END__ =pod =encoding UTF-8 =head1 NAME Mail::MtPolicyd::Plugin::GeoIPAction - mtpolicyd plugin for checking geo information of an ip =head1 VERSION version 2.03 =head1 DESCRIPTION This plugin will execute an action or score based on a previous lookup done with GeoIPLookup plugin. =head1 PARAMETERS =over =item result_from (required) Take the GeoIP information from the result of this plugin. The plugin in must be executed before this plugin. =item (uc_)enabled (default: on) Enable/disable this plugin. =item country_codes (required) A comma separated list of 2 letter country codes to match. =item (uc_)mode (default: reject) If set to 'passive' no action will be returned. =item reject_message (default: 'delivery from %CC% (%IP%) rejected) Could be used to specify an custom reject message. =item score (default: empty) A score to apply to the message. =back =head1 AUTHOR Markus Benning =head1 COPYRIGHT AND LICENSE This software is Copyright (c) 2014 by Markus Benning . This is free software, licensed under: The GNU General Public License, Version 2, June 1991 =cut GeoIPLookup.pm100644000000000000 364513306510157 22700 0ustar00rootroot000000000000Mail-MtPolicyd-2.03/lib/Mail/MtPolicyd/Pluginpackage Mail::MtPolicyd::Plugin::GeoIPLookup; use Moose; use namespace::autoclean; our $VERSION = '2.03'; # VERSION # ABSTRACT: mtpolicyd plugin for checking geo information of an client_address extends 'Mail::MtPolicyd::Plugin'; use Mail::MtPolicyd::Plugin::Result; use Geo::IP; has '_geoip' => ( is => 'ro', isa => 'Geo::IP', lazy => 1, default => sub { my $self = shift; Geo::IP->open( $self->database, GEOIP_STANDARD ); }, ); has 'database' => ( is => 'rw', isa => 'Str', default => '/usr/share/GeoIP/GeoIP.dat'); sub run { my ( $self, $r ) = @_; my $ip = $r->attr('client_address'); my $session = $r->session; my ( $result ) = $r->do_cached('geoip-'.$self->name.'-result', sub { $self->_geoip->country_code_by_addr( $ip ) } ); if( ! defined $result ) { $self->log($r, 'no GeoIP record for '.$ip.' found'); } return; } __PACKAGE__->meta->make_immutable; 1; __END__ =pod =encoding UTF-8 =head1 NAME Mail::MtPolicyd::Plugin::GeoIPLookup - mtpolicyd plugin for checking geo information of an client_address =head1 VERSION version 2.03 =head1 DESCRIPTION This plugin queries a GeoIP for the country code of the client_address. The plugin is divided in this plugin which does the Lookup and the GeoIPAction plugin which can be used to take actions based on country code. =head1 PARAMETERS =over =item database (default: /usr/share/GeoIP/GeoIP.dat) The path to the geoip country database. =back =head1 MAXMIND GEOIP COUNTRY DATABASE On a debian system you can install the country database with the geoip-database package. You also download it directly from Maxmind: http://dev.maxmind.com/geoip/geoip2/geolite2/ (choose "GeoLite2 Country/DB") =head1 AUTHOR Markus Benning =head1 COPYRIGHT AND LICENSE This software is Copyright (c) 2014 by Markus Benning . This is free software, licensed under: The GNU General Public License, Version 2, June 1991 =cut SaAwlAction.pm100644000000000000 1564613306510157 22734 0ustar00rootroot000000000000Mail-MtPolicyd-2.03/lib/Mail/MtPolicyd/Pluginpackage Mail::MtPolicyd::Plugin::SaAwlAction; use Moose; use namespace::autoclean; our $VERSION = '2.03'; # VERSION # ABSTRACT: mtpolicyd plugin for checking spamassassin AWL reputation extends 'Mail::MtPolicyd::Plugin'; with 'Mail::MtPolicyd::Plugin::Role::Scoring'; with 'Mail::MtPolicyd::Plugin::Role::UserConfig' => { 'uc_attributes' => [ 'enabled', 'mode' ], }; use Mail::MtPolicyd::Plugin::Result; has 'result_from' => ( is => 'rw', isa => 'Str', required => 1 ); has 'enabled' => ( is => 'rw', isa => 'Str', default => 'on' ); has 'mode' => ( is => 'rw', isa => 'Str', default => 'reject' ); has 'reject_message' => ( is => 'ro', isa => 'Str', default => 'sender address/ip has bad reputation', ); has 'score' => ( is => 'rw', isa => 'Maybe[Num]' ); has 'score_factor' => ( is => 'rw', isa => 'Maybe[Num]' ); has 'min_count' => ( is => 'rw', isa => 'Int', default => 10 ); has 'threshold' => ( is => 'rw', isa => 'Num', default => 5 ); has 'match' => ( is => 'rw', isa => 'Str', default => 'gt'); sub matches { my ( $self, $score ) = @_; if( $self->match eq 'gt' && $score >= $self->threshold ) { return 1; } elsif ( $self->match eq 'lt' && $score <= $self->threshold ) { return 1; } return 0; } sub run { my ( $self, $r ) = @_; my $addr = $r->attr('sender'); my $ip = $r->attr('client_address'); my $session = $r->session; my $enabled = $self->get_uc( $session, 'enabled' ); if( $enabled eq 'off' ) { return; } my $result_key = 'sa-awl-'.$self->result_from.'-result'; if( ! defined $session->{$result_key} ) { $self->log( $r, 'no SaAwlLookup result for '.$self->result_from.' found!'); return; } my ( $count, $score ) = @{$session->{$result_key}}; if( ! defined $count || ! defined $score) { return; # there was no entry in AWL } if( $count < $self->min_count ) { $self->log( $r, 'sender awl reputation below min_count' ); return; } if( ! $self->matches( $score ) ) { return; } $self->log( $r, 'matched SA AWL threshold action '.$self->name ); if( ! $r->is_already_done('sa-awl-'.$self->name.'-score') ) { if( $self->score ) { $self->add_score($r, $self->name => $self->score); } elsif( $self->score_factor ) { $self->add_score($r, $self->name => $score * $self->score_factor); } } my $mode = $self->get_uc( $session, 'mode' ); if( $mode eq 'reject' ) { return Mail::MtPolicyd::Plugin::Result->new( action => $self->_get_reject_action( $addr, $ip, $score ), abort => 1, ); } if( $mode eq 'accept' || $mode eq 'dunno' ) { return Mail::MtPolicyd::Plugin::Result->new_dunno; } return; } sub _get_reject_action { my ( $self, $sender, $ip, $score ) = @_; my $message = $self->reject_message; $message =~ s/%IP%/$ip/; $message =~ s/%SENDER%/$sender/; $message =~ s/%SCORE%/$score/; return('reject '.$message); } __PACKAGE__->meta->make_immutable; 1; __END__ =pod =encoding UTF-8 =head1 NAME Mail::MtPolicyd::Plugin::SaAwlAction - mtpolicyd plugin for checking spamassassin AWL reputation =head1 VERSION version 2.03 =head1 DESCRIPTION This plugin will execute an action or score based on a previous lookup done with SaAwlLookup plugin. =head1 PARAMETERS =over =item result_from (required) Take the AWL information from the result of this plugin. The plugin in must be executed before this plugin. =item (uc_)enabled (default: on) Enable/disable this plugin. =item (uc_)mode (default: reject) If set to 'passive' no action will be returned. =item reject_message (default: 'sender address/ip has bad reputation') Could be used to specify an custom reject message. =item score (default: empty) A score to apply to the message. =item score_factor (default: empty) A factor to apply the SA score to the message. Do not configure a score if you want to use the factor. =item min_count (default: 10) The minimum count of mails/scores spamassassin must have done on this sender/ip before the AWL entry is used. If the count in AWLs auto-whitelist table is below this count the test will be skipped. =item threshold (default: 5) At this threshold the action or score will be applied. =item match (default: gt) The default is to match values greater("gt") than the threshold. When configured with 'lt' AWL scores less than the threshold will be matched. =back =head1 EXAMPLE Check that AWL is active in your SA/amavis configuration: loadplugin Mail::SpamAssassin::Plugin::AWL use_auto_whitelist 1 Make sure that mtpolicyd has permissions to read the auto-whitelist db: $ usermod -G amavis mtpolicyd $ chmod g+rx /var/lib/amavis/.spamassassin $ chmod g+r /var/lib/amavis/.spamassassin/auto-whitelist Make sure it stays like this when its recreated in your SA local.cf: auto_whitelist_file_mode 0770 Net::Server does not automatically set supplementary groups. You have to do that in mtpolicyd.conf: group="mtpolicyd amavis" Permissions may be different on your system. To check that mtpolicyd can access the file try: $ sudo -u mtpolicyd -- head -n0 /var/lib/amavis/.spamassassin/auto-whitelist Now use it in mtpolicyd.conf: module = "SaAwlLookup" db_file = "/var/lib/amavis/.spamassassin/auto-whitelist" For whitelisting you may configure it like: module = "SaAwlAction" result_from = "amavis-reputation" mode = "accept" match = "lt" threshold = "0" Or apply a score based for bad AWL reputation (score > 5): module = "SaAwlAction" result_from = "amavis-reputation" mode = "passive" match = "gt" threshold = 6 score = 5 Or apply the score value from AWL with an factor: module = "SaAwlAction" result_from = "amavis-reputation" mode = "passive" match = "gt" threshold = 5 score_factor = 0.5 If the score in AWL is >5 it will apply the score with an factor of 0.5. When the score in AWL is 8 it will apply a score of 4. Or just reject all mail with a bad reputation: module = "SaAwlAction" result_from = "amavis-reputation" mode = "reject" match = "gt" threshold = 5 reject_message = "bye bye..." =head1 Troubleshooting =head2 Check content of spamassassin AWL auto-whitelist To check the content of the auto-whitelist database use the sa-awl command: $ sa-awl /var/lib/amavis/.spamassassin/auto-whitelist | grep =head1 SEE ALSO =over =item Spamassassin AutoWhitelist manual L =item Spamassassin AWL plugin reference L =back =head1 AUTHOR Markus Benning =head1 COPYRIGHT AND LICENSE This software is Copyright (c) 2014 by Markus Benning . This is free software, licensed under: The GNU General Public License, Version 2, June 1991 =cut SaAwlLookup.pm100644000000000000 655313306510157 22745 0ustar00rootroot000000000000Mail-MtPolicyd-2.03/lib/Mail/MtPolicyd/Pluginpackage Mail::MtPolicyd::Plugin::SaAwlLookup; use Moose; use namespace::autoclean; our $VERSION = '2.03'; # VERSION # ABSTRACT: mtpolicyd plugin for querying a spamassassin AWL database for reputation extends 'Mail::MtPolicyd::Plugin'; use Mail::MtPolicyd::Plugin::Result; use BerkeleyDB; use BerkeleyDB::Hash; use NetAddr::IP; has 'db_file' => ( is => 'rw', isa => 'Str', default => '/var/lib/amamvis/.spamassassin/auto-whitelist' ); has '_awl' => ( is => 'ro', isa => 'HashRef', lazy => 1, default => sub { my $self = shift; my %map; my $db = tie %map, 'BerkeleyDB::Hash', -Filename => $self->db_file, -Flags => DB_RDONLY or die "Cannot open ".$self->db_file.": $!\n" ; return(\%map); }, ); sub truncate_ip_v4 { my ( $self, $ip ) = @_; if( $ip =~ m/^(\d+\.\d+).\d+.\d+$/ ) { return( $1 ); } return; } sub truncate_ip_v6 { my ( $self, $ip ) = @_; my $addr = NetAddr::IP->new6( $ip.'/48' ); if( ! defined $addr ) { return; } my $result = $addr->network->full6; $result =~ s/(:0000)+/::/; return $result; } sub truncate_ip { my ( $self, $ip ) = @_; if( $ip =~ /:/) { return $self->truncate_ip_v6($ip); } return $self->truncate_ip_v4($ip); } sub query_awl { my ( $self, $addr, $ip ) = @_; my $ip_key = $self->truncate_ip( $ip ); if( ! defined $ip_key ) { return; } my $count = $self->_awl->{$addr.'|ip='.$ip_key}; if( ! defined $count ) { return; } my $total = $self->_awl->{$addr.'|ip='.$ip_key.'|totscore'}; if( ! defined $total ) { return; } my $score = $total / $count; return( $count, $score ); } sub run { my ( $self, $r ) = @_; my $addr = $r->attr('sender'); my $ip = $r->attr('client_address'); my $session = $r->session; if( ! defined $addr || ! defined $ip ) { return; } my ( $count, $score ) = $r->do_cached('sa-awl-'.$self->name.'-result', sub { $self->query_awl( $addr, $ip ) } ); if( ! defined $count || ! defined $score ) { $self->log($r, 'no AWL record for '.$addr.'/'.$ip.' found'); return; } $self->log($r, 'AWL record for '.$addr.'/'.$ip.' count='.$count.', score='.$score); return; } __PACKAGE__->meta->make_immutable; 1; __END__ =pod =encoding UTF-8 =head1 NAME Mail::MtPolicyd::Plugin::SaAwlLookup - mtpolicyd plugin for querying a spamassassin AWL database for reputation =head1 VERSION version 2.03 =head1 DESCRIPTION This plugin queries the auto_whitelist database used by spamassassins AWL plugin for the reputation of sender ip/address combination. Based on the AWL score a score or action in mtpolicyd can be applied in combination with the SaAwlAction plugin. =head1 PARAMETERS =over =item db_file (default: /var/lib/amavis/.spamassassin/auto-whitelist) The path to the auto-whitelist database file. =back =head1 EXAMPLE To read reputation from amavis/spamassassin AWL use: module = "SaAwlLookup" db_file = "/var/lib/amamvis/.spamassassin/auto-whitelist" The location of auto-whitelist may be different on your system. Make sure mtpolicyd is allowed to read the db_file. =head1 AUTHOR Markus Benning =head1 COPYRIGHT AND LICENSE This software is Copyright (c) 2014 by Markus Benning . This is free software, licensed under: The GNU General Public License, Version 2, June 1991 =cut ScoreAction.pm100644000000000000 642413306510157 22752 0ustar00rootroot000000000000Mail-MtPolicyd-2.03/lib/Mail/MtPolicyd/Pluginpackage Mail::MtPolicyd::Plugin::ScoreAction; use Moose; use namespace::autoclean; our $VERSION = '2.03'; # VERSION # ABSTRACT: mtpolicyd plugin for running an action based on the score extends 'Mail::MtPolicyd::Plugin'; with 'Mail::MtPolicyd::Plugin::Role::Scoring'; with 'Mail::MtPolicyd::Plugin::Role::UserConfig' => { 'uc_attributes' => [ 'threshold' ], }; with 'Mail::MtPolicyd::Plugin::Role::PluginChain'; use Mail::MtPolicyd::Plugin::Result; has 'threshold' => ( is => 'ro', isa => 'Num', required => 1 ); has 'match' => ( is => 'rw', isa => 'Str', default => 'gt' ); has 'action' => ( is => 'ro', isa => 'Maybe[Str]' ); sub run { my ( $self, $r ) = @_; my $score = $self->_get_score($r); my $score_detail = $self->_get_score_detail($r); my $threshold = $self->get_uc( $r->session, 'threshold' ); if( $self->match eq 'gt' && $score < $threshold ) { return; } elsif( $self->match eq 'lt' && $score > $threshold ) { return; } elsif( $self->match !~ m/^[lg]t$/) { die('unknown value for parameter match.'); } my $action = $self->action; if( defined $action ) { my $ip = $r->attr('client_address'); if( defined $ip ) { $action =~ s/%IP%/$ip/; } else { $action =~ s/%IP%/unknown/; } $action =~ s/%SCORE%/$score/; if( defined $score_detail ) { $action =~ s/%SCORE_DETAIL%/, $score_detail/; } else { $action =~ s/%SCORE_DETAIL%//; } return Mail::MtPolicyd::Plugin::Result->new( action => $action, abort => 1, ); } if( defined $self->chain ) { my $chain_result = $self->chain->run( $r ); return( @{$chain_result->plugin_results} ); } return; } __PACKAGE__->meta->make_immutable; 1; __END__ =pod =encoding UTF-8 =head1 NAME Mail::MtPolicyd::Plugin::ScoreAction - mtpolicyd plugin for running an action based on the score =head1 VERSION version 2.03 =head1 DESCRIPTION Returns a action based on the score. =head1 PARAMETERS =over =item threshold (required) If the score is higher than this value the action will be executed. =item match (default: gt) If it should match if the score if >= or <= the threshold. Possible values: gt, lt =item uc_threshold (default: undef) If set the value for threshold will be fetched from this user-config value if defined. =item score_field (default: score) Specifies the name of the field the score is stored in. Could be set if you need multiple scores. =item action (default: empty) The action to be executed. The following patterns in the string will be replaced: %IP%, %SCORE%, %SCORE_DETAIL% =item Plugin (default: empty) Execute this plugins when the condition matched. =back =head1 EXAMPLE Reject everything with a score >= 15. and do greylisting for the remaining request with a score >=5. module = "ScoreAction" threshold = 15 action = "reject sender ip %IP% is blocked (score=%SCORE%%SCORE_DETAIL%)" module = "ScoreAction" threshold = 5 module = "Greylist" score = -5 mode = "passive" =head1 AUTHOR Markus Benning =head1 COPYRIGHT AND LICENSE This software is Copyright (c) 2014 by Markus Benning . This is free software, licensed under: The GNU General Public License, Version 2, June 1991 =cut Redis.pm100644000000000000 623213306510157 22715 0ustar00rootroot000000000000Mail-MtPolicyd-2.03/lib/Mail/MtPolicyd/SessionCachepackage Mail::MtPolicyd::SessionCache::Redis; use Moose; our $VERSION = '2.03'; # VERSION # ABSTRACT: a session cache adapter for redis use Time::HiRes qw(usleep); use Storable; extends 'Mail::MtPolicyd::SessionCache::Base'; with 'Mail::MtPolicyd::Role::Connection' => { name => 'redis', type => 'Redis', }; has 'expire' => ( is => 'ro', isa => 'Int', default => 5 * 60 ); has 'lock_wait' => ( is => 'rw', isa => 'Int', default => 50 ); has 'lock_max_retry' => ( is => 'rw', isa => 'Int', default => 50 ); has 'lock_timeout' => ( is => 'rw', isa => 'Int', default => 10 ); sub _acquire_session_lock { my ( $self, $instance ) = @_; my $lock = 'lock_'.$instance; for( my $try = 1 ; $try < $self->lock_max_retry ; $try++ ) { if( $self->_redis_handle->set($lock, 1, 'EX', $self->lock_timeout, 'NX' ) ) { return; # lock created } usleep( $self->lock_wait * $try ); } die('could not acquire lock for session '.$instance); return; } sub _release_session_lock { my ( $self, $instance ) = @_; my $lock = 'lock_'.$instance; $self->_redis_handle->del($lock); return; } sub retrieve_session { my ($self, $instance ) = @_; if( ! defined $instance ) { return; } $self->_acquire_session_lock( $instance ); if( my $blob = $self->_redis_handle->get($instance) ) { my $session; eval { $session = Storable::thaw( $blob ) }; if( $@ ) { die("could not restore session $instance: $@"); } return($session); } return( { '_instance' => $instance } ); } sub store_session { my ($self, $session ) = @_; my $instance = $session->{'_instance'}; if( ! defined $session || ! defined $instance ) { return; } my $data = Storable::freeze( $session ); $self->_redis_handle->set($instance, $data, 'EX', $self->expire); $self->_release_session_lock($instance); return; } 1; __END__ =pod =encoding UTF-8 =head1 NAME Mail::MtPolicyd::SessionCache::Redis - a session cache adapter for redis =head1 VERSION version 2.03 =head1 SYNOPSIS module = "Redis" #redis = "redis" # expire session cache entries expire = "300" # wait timeout will be increased each time 50,100,150,... (usec) lock_wait=50 # abort after n retries lock_max_retry=50 # session lock times out after (sec) lock_timeout=10 =head1 PARAMETERS =over =item redis (default: redis) Name of the database connection to use. You have to define this connection first. see L =item expire (default: 5*60) Timeout in seconds for sessions. =item lock_wait (default: 50) Timeout for retry when session is locked in milliseconds. The retry will be done in multiples of this timeout. When set to 50 retry will be done in 50, 100, 150ms... =item lock_max_retry (default: 50) Maximum number of retries before giving up to obtain lock on a session. =item lock_timeout (default: 10) Timeout of session locks in seconds. =back =head1 AUTHOR Markus Benning =head1 COPYRIGHT AND LICENSE This software is Copyright (c) 2014 by Markus Benning . This is free software, licensed under: The GNU General Public License, Version 2, June 1991 =cut server-vhost-by-policy-context.feature100644000000000000 247213306510157 23266 0ustar00rootroot000000000000Mail-MtPolicyd-2.03/tFeature: vhost by policy_context The mtpolicyd must select the hostname by the policy_context field in case the vhost_by_policy_context option is set in configuration. Scenario: mtpolicyd must select the correct vhost (fred) Given that a mtpolicyd is running with configuration t-data/vhost-by-policy-context.conf When the following request is executed on mtpolicyd: """ policy_context=fred """ Then mtpolicyd must respond with a action like ^reject my name is fred And the mtpolicyd server must be stopped successfull Scenario: mtpolicyd must select the correct vhost (horst) Given that a mtpolicyd is running with configuration t-data/vhost-by-policy-context.conf When the following request is executed on mtpolicyd: """ policy_context=horst """ Then mtpolicyd must respond with a action like ^reject my name is horst And the mtpolicyd server must be stopped successfull Scenario: mtpolicyd must select the correct vhost (default is fred) Given that a mtpolicyd is running with configuration t-data/vhost-by-policy-context.conf When the following request is executed on mtpolicyd: """ client_address=127.0.0.1 """ Then mtpolicyd must respond with a action like ^reject my name is fred And the mtpolicyd server must be stopped successfull Role000755000000000000 013306510157 20736 5ustar00rootroot000000000000Mail-MtPolicyd-2.03/lib/Mail/MtPolicyd/PluginScoring.pm100644000000000000 300713306510157 23040 0ustar00rootroot000000000000Mail-MtPolicyd-2.03/lib/Mail/MtPolicyd/Plugin/Rolepackage Mail::MtPolicyd::Plugin::Role::Scoring; use Moose::Role; our $VERSION = '2.03'; # VERSION # ABSTRACT: role for plugins using scoring has 'score_field' => ( is => 'ro', isa => 'Str', default => 'score', ); sub _get_score { my ( $self, $r ) = @_; my $session = $r->session; if( defined $session->{$self->score_field} ) { return $session->{$self->score_field}; } return 0; } sub _set_score { my ( $self, $r, $value ) = @_; my $session = $r->session; return $session->{$self->score_field} = $value; } sub _push_score_detail { my ( $self, $r, $string ) = @_; my $session = $r->session; my $field = $self->score_field . '_detail'; if( ! defined $session->{$field} ) { $session->{$field} = $string; return; } $session->{$field} .= ', '.$string; return; } sub _get_score_detail { my ( $self, $r ) = @_; my $field = $self->score_field . '_detail'; return( $r->session->{$field} ); } sub add_score { my ( $self, $r, $key, $value ) = @_; my $score = $self->_get_score($r); $score += $value; $self->_set_score($r, $score); $self->_push_score_detail($r, $key.'='.$value); return $score; } 1; __END__ =pod =encoding UTF-8 =head1 NAME Mail::MtPolicyd::Plugin::Role::Scoring - role for plugins using scoring =head1 VERSION version 2.03 =head1 AUTHOR Markus Benning =head1 COPYRIGHT AND LICENSE This software is Copyright (c) 2014 by Markus Benning . This is free software, licensed under: The GNU General Public License, Version 2, June 1991 =cut mtpolicyd_run_steps.pl100644000000000000 110613306510157 23655 0ustar00rootroot000000000000Mail-MtPolicyd-2.03/t/step_definitions#!perl use strict; use warnings; use Test::More; use Test::Exception; Given qr/that a mtpolicyd is running with configuration (\S+)/, sub { my $server; lives_ok { $server = Test::Net::Server->new( class => 'Mail::MtPolicyd', config_file => $1, ); } 'creation of server object muss succeed'; isa_ok($server, 'Test::Net::Server'); lives_ok { $server->run; } 'startup of mtpolicyd test server'; S->{'server'} = $server; }; Then qr/the mtpolicyd server must be stopped successfull/, sub { my $server = S->{'server'}; $server->shutdown; }; Memcached.pm100644000000000000 361713306510157 23251 0ustar00rootroot000000000000Mail-MtPolicyd-2.03/lib/Mail/MtPolicyd/Connectionpackage Mail::MtPolicyd::Connection::Memcached; use Moose; our $VERSION = '2.03'; # VERSION # ABSTRACT: a memcached connection plugin for mtpolicyd extends 'Mail::MtPolicyd::Connection'; use Cache::Memcached; has 'servers' => ( is => 'ro', isa => 'Str', default => '127.0.0.1:11211' ); has '_servers' => ( is => 'ro', isa => 'ArrayRef[Str]', lazy => 1, default => sub { my $self = shift; return [ split(/\s*,\s*/, $self->servers) ]; }, ); has 'debug' => ( is => 'ro', isa => 'Bool', default => 0 ); has 'namespace' => ( is => 'ro', isa => 'Str', default => ''); sub _create_handle { my $self = shift; return Cache::Memcached->new( { 'servers' => $self->_servers, 'debug' => $self->debug, 'namespace' => $self->namespace, } ); } has 'handle' => ( is => 'rw', isa => 'Cache::Memcached', lazy => 1, default => sub { my $self = shift; $self->_create_handle }, ); sub reconnect { my $self = shift; $self->handle( $self->_create_handle ); return; } sub shutdown { my $self = shift; $self->handle->disconnect_all; return; } 1; __END__ =pod =encoding UTF-8 =head1 NAME Mail::MtPolicyd::Connection::Memcached - a memcached connection plugin for mtpolicyd =head1 VERSION version 2.03 =head1 SYNOPSIS module = "Memcached" servers = "127.0.0.1:11211" # namespace = "mt-" =head1 PARAMETERS =over =item servers (default: 127.0.0.1:11211) Comma separated list for memcached servers to connect. =item debug (default: 0) Enable to debug memcached connection. =item namespace (default: '') Set a prefix used for all keys of this connection. =back =head1 AUTHOR Markus Benning =head1 COPYRIGHT AND LICENSE This software is Copyright (c) 2014 by Markus Benning . This is free software, licensed under: The GNU General Public License, Version 2, June 1991 =cut SqlUserConfig.pm100644000000000000 627713306510157 23273 0ustar00rootroot000000000000Mail-MtPolicyd-2.03/lib/Mail/MtPolicyd/Pluginpackage Mail::MtPolicyd::Plugin::SqlUserConfig; use Moose; use namespace::autoclean; our $VERSION = '2.03'; # VERSION # ABSTRACT: mtpolicyd plugin for retrieving the user config of a user extends 'Mail::MtPolicyd::Plugin'; use Mail::MtPolicyd::Plugin::Result; use JSON; has 'sql_query' => ( is => 'rw', isa => 'Str', default => 'SELECT config FROM user_config WHERE address=?', ); has '_json' => ( is => 'ro', isa => 'JSON', lazy => 1, default => sub { return JSON->new; } ); has 'field' => ( is => 'rw', isa => 'Str', default => 'recipient' ); with 'Mail::MtPolicyd::Role::Connection' => { name => 'db', type => 'Sql', }; with 'Mail::MtPolicyd::Plugin::Role::SqlUtils'; sub _get_config { my ( $self, $r ) = @_; my $key = $r->attr( $self->field ); if( ! defined $key || $key =~ /^\s*$/ ) { die('key field '.$self->field.' not defined or empty in request'); } my $sth = $self->execute_sql( $self->sql_query, $key ); my ( $json ) = $sth->fetchrow_array; if( ! defined $json ) { die( 'no user-config found for '.$key ); } return $self->_json->decode( $json ); } sub run { my ( $self, $r ) = @_; my $config; eval { $config = $self->_get_config($r) }; if( $@ ) { $self->log($r, 'unable to retrieve user-config: '.$@); return; } foreach my $key ( keys %$config ) { $r->session->{$key} = $config->{$key}; } return; } __PACKAGE__->meta->make_immutable; 1; __END__ =pod =encoding UTF-8 =head1 NAME Mail::MtPolicyd::Plugin::SqlUserConfig - mtpolicyd plugin for retrieving the user config of a user =head1 VERSION version 2.03 =head1 DESCRIPTION This plugin will retrieve a JSON string from an SQL database and will merge the data structure into the current session. This could be used to retrieve configuration values for users from a database. =head1 PARAMETERS =over =item sql_query (default: SELECT config FROM user_config WHERE address=?) The SQL query to retrieve the JSON configuration string. The content of the first row/column is used. =item field (default: recipient) The request field used in the sql query to retrieve the user configuration. =back =head1 EXAMPLE USER SPECIFIC GREYLISTING Create the following table in the SQL database: CREATE TABLE `user_config` ( `id` int(11) NOT NULL AUTO_INCREMENT, `address` varchar(255) DEFAULT NULL, `config` TEXT NOT NULL, PRIMARY KEY (`id`), UNIQUE KEY `address` (`address`) ) ENGINE=MyISAM DEFAULT CHARSET=latin1 INSERT INTO TABLE `user_config` VALUES( NULL, 'karlson@vomdach.de', '{"greylisting":"on"}' ); In mtpolicyd.conf: db_dsn="dbi:mysql:mail" db_user=mail db_password=password module = "SqlUserConfig" sql_query = "SELECT config FROM user_config WHERE address=?" enabled = "off" # off by default uc_enabled = "greylisting" # override with value of key 'greylisting' is set in session module = "Greylist" score = -5 mode = "passive" =head1 AUTHOR Markus Benning =head1 COPYRIGHT AND LICENSE This software is Copyright (c) 2014 by Markus Benning . This is free software, licensed under: The GNU General Public License, Version 2, June 1991 =cut SqlUtils.pm100644000000000000 421513306510157 23216 0ustar00rootroot000000000000Mail-MtPolicyd-2.03/lib/Mail/MtPolicyd/Plugin/Rolepackage Mail::MtPolicyd::Plugin::Role::SqlUtils; use strict; use Moose::Role; # ABSTRACT: role with support function for plugins using sql our $VERSION = '2.03'; # VERSION requires '_db_handle'; has 'mysql_engine' => ( is => 'rw', isa => 'Str', default => 'MyISAM', ); sub sql_table_exists { my ( $self, $name ) = @_; my $dbh = $self->_db_handle; my $sql = 'SELECT * FROM '.$dbh->quote_identifier($name).' WHERE 1=0;'; eval { $dbh->do($sql); }; if( $@ ) { return 0; } return 1; } sub create_sql_table { my ( $self, $name, $definitions ) = @_; my $dbh = $self->_db_handle; my $table_name = $dbh->quote_identifier($name); my $mysql_engine = $dbh->quote_identifier($self->mysql_engine); my $sql; my $driver = $dbh->{Driver}->{Name}; if( defined $definitions->{$driver} ) { $sql = $definitions->{$driver}; } elsif ( defined $definitions->{'*'} ) { $sql = $definitions->{'*'}; } else { die('no data definition for table '.$name.'/'.$driver.' found'); } $sql =~ s/%TABLE_NAME%/$table_name/g; if($driver eq 'mysql') { $sql =~ s/%MYSQL_ENGINE%/$mysql_engine/g; } $dbh->do( $sql ); return; } sub check_sql_tables { my ( $self, %tables ) = @_; foreach my $table ( keys %tables ) { if( ! $self->sql_table_exists( $table ) ) { eval { $self->create_sql_table( $table, $tables{$table} ) }; if( $@ ) { die('sql table '.$table.' does not exist and creating it failed: '.$@); } } } } sub execute_sql { my ( $self, $sql, @params ) = @_; my $dbh = $self->_db_handle; my $sth = $dbh->prepare( $sql ); $sth->execute( @params ); return $sth; } 1; __END__ =pod =encoding UTF-8 =head1 NAME Mail::MtPolicyd::Plugin::Role::SqlUtils - role with support function for plugins using sql =head1 VERSION version 2.03 =head1 AUTHOR Markus Benning =head1 COPYRIGHT AND LICENSE This software is Copyright (c) 2014 by Markus Benning . This is free software, licensed under: The GNU General Public License, Version 2, June 1991 =cut Cookbook000755000000000000 013306510157 20345 5ustar00rootroot000000000000Mail-MtPolicyd-2.03/lib/Mail/MtPolicydBasicPlugin.pod100644000000000000 631713306510157 23420 0ustar00rootroot000000000000Mail-MtPolicyd-2.03/lib/Mail/MtPolicyd/Cookbook# PODNAME: Mail::MtPolicyd::Cookbook::BasicModule # ABSTRACT: how to write your own mtpolicyd plugin __END__ =pod =encoding UTF-8 =head1 NAME Mail::MtPolicyd::Cookbook::BasicModule - how to write your own mtpolicyd plugin =head1 VERSION version 2.03 =head1 How to write your own mtpolicyd plugin mtpolicyd makes use of L. If you're not yet familiar with L you should start reading the L first. =head2 Basic skeleton of a mtpolicyd plugin A plugin in mtpolicyd is basicly a class which inherits from L and is located below the Mail::MtPolicyd::Plugin:: namespace: package Mail::MtPolicyd::Plugin::HelloWorld; use Moose; use namespace::autoclean; # VERSION # ABSTRACT: a mtpolicyd plugin which just returns a hello world reject extends 'Mail::MtPolicyd::Plugin'; use Mail::MtPolicyd::Plugin::Result; sub run { my ( $self, $r ) = @_; return Mail::MtPolicyd::Plugin::Result->new( action => 'reject Hello World!', abort => 1, ); } __PACKAGE__->meta->make_immutable; 1; Every plugin must implement a run() method. mtpolicyd will call run() everytime your module is called from the configuration to process a request. A L object containing the current request is passed to the method. The run() method must return undef or a object. If undef is return mtpolicyd will continue with the next plugin. If a result is returned mtpolicyd will push the result to the list of results and abort processing the request if abort is set. After you placed the module with your lib search path you should be able to use the plugin within mtpolicyd.conf: module = "HelloWorld" For now our plugin will just return an "reject Hello World!" action to the MTA. =head2 Adding configuration options All options defined in the configuration file will be passed to the object constructor new() when creating an object of your plugin class. The parameter "module" is not passed to the object constructor because it contains the name of your class. You can defined configuration parameters by adding attributes to your class. You're class already inherits 3 attributes from the Plugin base class: =over =item name (required) Which contains the name of your section. =item log_level (default: 4) Which contains the level used when your plugin calls $self->log( $r, '...');. =item on_error (default: undef) Tells mtpolicyd what to do when the plugin dies. If set to "continue" mtpolicyd will continue processing and just leaves a line in the log. =back Add a new attribute to your plugin class: has 'text' => ( is => 'rw', isa => 'Str', default => 'Hello World!'); Return this string instead of the hard coded string: action => 'reject '.$self->text, The string is now configurable from the config: module = "HelloWorld" text = "Hello Universe!" =head1 AUTHOR Markus Benning =head1 COPYRIGHT AND LICENSE This software is Copyright (c) 2014 by Markus Benning . This is free software, licensed under: The GNU General Public License, Version 2, June 1991 =cut AddScoreHeader.pm100644000000000000 440013306510157 23326 0ustar00rootroot000000000000Mail-MtPolicyd-2.03/lib/Mail/MtPolicyd/Pluginpackage Mail::MtPolicyd::Plugin::AddScoreHeader; use Moose; use namespace::autoclean; our $VERSION = '2.03'; # VERSION # ABSTRACT: mtpolicyd plugin for adding the score as header to the mail extends 'Mail::MtPolicyd::Plugin'; with 'Mail::MtPolicyd::Plugin::Role::Scoring'; with 'Mail::MtPolicyd::Plugin::Role::UserConfig' => { 'uc_attributes' => [ 'spam_score' ], }; use Mail::MtPolicyd::Plugin::Result; has 'header_name' => ( is => 'ro', isa => 'Str', default => 'X-MtScore', ); has 'spam_score' => ( is => 'ro', isa => 'Num', default => '5' ); sub run { my ( $self, $r ) = @_; my $score = $self->_get_score($r); my $spam_score = $self->get_uc($r->session, 'spam_score'); my $value; if( ! defined $score ) { $self->log($r, 'score is undefined'); } if( $score >= $spam_score ) { $value = 'YES '; } else { $value = 'NO '; } $value .= 'score='.$score; if( my $details = $self->_get_score_detail($r) ) { $value .= ' ['.$details.']'; } return Mail::MtPolicyd::Plugin::Result->new_header_once( $r->is_already_done('score-'.$self->score_field.'-tag'), $self->header_name, $value ); } __PACKAGE__->meta->make_immutable; 1; __END__ =pod =encoding UTF-8 =head1 NAME Mail::MtPolicyd::Plugin::AddScoreHeader - mtpolicyd plugin for adding the score as header to the mail =head1 VERSION version 2.03 =head1 DESCRIPTION Adds an header with the current score and score details to the mail. =head1 PARAMETERS =over =item (uc_)spam_score (default: 5) If the score is higher than this value it'll be tagged as 'YES'. Otherwise 'NO'. =item score_field (default: score) Specifies the name of the field the score is stored in. Could be set if you need multiple scores. =item header_name (default: X-MtScore) The name of the header to set. =back =head1 EXAMPLE module = "AddScoreHeader" # score_field = "score" # header_name = "X-MtScore" spam_score = 5 Will return an action like: X-MtScore: YES score=7.5 [CTIPREP_TEMP=2.5, spamhaus-rbl=5] =head1 AUTHOR Markus Benning =head1 COPYRIGHT AND LICENSE This software is Copyright (c) 2014 by Markus Benning . This is free software, licensed under: The GNU General Public License, Version 2, June 1991 =cut LdapUserConfig.pm100644000000000000 760213306510157 23405 0ustar00rootroot000000000000Mail-MtPolicyd-2.03/lib/Mail/MtPolicyd/Pluginpackage Mail::MtPolicyd::Plugin::LdapUserConfig; use Moose; use namespace::autoclean; our $VERSION = '2.03'; # VERSION # ABSTRACT: mtpolicyd plugin for retrieving per user configuration from LDAP extends 'Mail::MtPolicyd::Plugin'; use Mail::MtPolicyd::Plugin::Result; use Net::LDAP::Util qw( escape_filter_value ); has 'basedn' => ( is => 'rw', isa => 'Str', default => '' ); has 'filter' => ( is => 'rw', isa => 'Str', required => 1 ); with 'Mail::MtPolicyd::Plugin::Role::ConfigurableFields' => { 'fields' => { 'filter' => { isa => 'Str', default => 'sasl_username', value_isa => 'Str', }, }, }; has 'config_fields' => ( is => 'rw', isa => 'Str', required => 1 ); has '_config_fields' => ( is => 'ro', isa => 'ArrayRef[Str]', lazy => 1, default => sub { my $self = shift; return [ split(/\s*,\s*/, $self->config_fields ) ]; }, ); has 'connection' => ( is => 'ro', isa => 'Str', default => 'ldap' ); has 'connection_type' => ( is => 'ro', isa => 'Str', default => 'Ldap' ); with 'Mail::MtPolicyd::Role::Connection' => { name => 'ldap', type => 'Ldap', }; sub retrieve_ldap_entry { my ( $self, $r ) = @_; my $ldap = $self->_ldap_handle; my $value = $self->get_filter_value( $r ); if( ! defined $value ) { $self->log( $r, 'filter_field('.$self->filter_field.') is not defined in request. skipping ldap search.'); return; } my $filter = $self->filter; my $filter_value = escape_filter_value($value); $filter =~ s/%s/$filter_value/g; $self->log( $r, 'ldap filter is: '.$filter); my $msg; eval { $msg = $ldap->search( base => $self->basedn, filter => $filter, ); }; if( $@ ) { $self->log( $r, 'ldap search failed: '.$@ ); return; } if( $msg->count != 1 ) { $self->log( $r, 'ldap search return '.$msg->count.' entries' ); return; } my $entry = $msg->entry( 0 ); $self->log( $r, 'found in ldap: '.$entry->dn ); return $entry; } sub run { my ( $self, $r ) = @_; my $entry = $self->retrieve_ldap_entry( $r ); if( defined $entry ) { foreach my $field ( @{$self->_config_fields} ) { my ($value) = $entry->get_value( $field ); if( defined $value && $value ne '' ) { $self->log( $r, 'retrieved ldap attribute: '.$field.'='.$value ); $r->session->{$field} = $value; } else { $self->log( $r, 'LDAP attribute '.$field.' is empty. skipping.' ); } } } return; } __PACKAGE__->meta->make_immutable; 1; __END__ =pod =encoding UTF-8 =head1 NAME Mail::MtPolicyd::Plugin::LdapUserConfig - mtpolicyd plugin for retrieving per user configuration from LDAP =head1 VERSION version 2.03 =head1 SYNOPSIS ldap_host="localhost" ldap_binddn="cn=readonly,dc=domain,dc=com" ldap_password="secret" module="LdapUserConfig" basedn="ou=users,dc=domain,dc=com" filter="(mail=%s)" filter_field="sasl_username" config_fields="mailMessageLimit,mailSendExternal" =head1 DESCRIPTION This plugin could be used to retrieve session variables/user configuration from a LDAP server. =head1 PARAMETERS The LDAP connection must be configured in the global configuration section of mtpolicyd. See L. =over =item basedn (default: '') The basedn to use for the search. =item filter (required) The filter to use for the search. The pattern %s will be replaced with the content of filter_field. =item filter_field (required) The content of this request field will be used to replace %s in the filter string. =item config_fields (required) A comma separated list of LDAP attributes to retrieve and copy into the current mtpolicyd session. =back =head1 AUTHOR Markus Benning =head1 COPYRIGHT AND LICENSE This software is Copyright (c) 2014 by Markus Benning . This is free software, licensed under: The GNU General Public License, Version 2, June 1991 =cut Installation.pod100644000000000000 655713306510157 23667 0ustar00rootroot000000000000Mail-MtPolicyd-2.03/lib/Mail/MtPolicyd/Cookbook# PODNAME: Mail::MtPolicyd::Cookbook::Installation # ABSTRACT: How to install mtpolicyd __END__ =pod =encoding UTF-8 =head1 NAME Mail::MtPolicyd::Cookbook::Installation - How to install mtpolicyd =head1 VERSION version 2.03 =head1 GET STARTED WITH BASIC MTPOLICYD INSTALLATION =head2 INSTALL MEMCACHED memcached is required for mtpolicyd. A package of memcached should come with your os distribution. On Debian based distributions it can be installed by: apt-get install memcached Check /etc/default/memcached if the service is enabled: ENABLE_MEMCACHED=yes Start the memcached service /etc/init.d/memcached start =head2 INSTALL MTPOLICYD =head3 FROM PACKAGE Packages for mtpolicyd are included in the Debian package repositories. =head3 FROM SOURCE/CPAN Since mtpolicyd source is shipped as a perl/CPAN package it could be installed from CPAN. To install the Mail::Mtpolicyd package with all dependencies required make sure you have installed cpanminus: apt-get install cpanminus Then install the Mail::Mtpolicyd distribution with: cpanm Mail::MtPolicyd It is recommended to create an system user and group for the daemon. You can get a default configuration file etc/mtpolicyd.conf from the tarball. The init scripts for the debian packages are located at debian/mtpolicyd.init and for redhat systems at rpm/mtpolicyd.init within the tarball. =head2 TEST MTPOLICYD Now the daemon should be up: $ ps -u mtpolicyd f PID TTY STAT TIME COMMAND 2566 ? Ss 0:12 /usr/bin/mtpolicyd (master) 2731 ? S 0:28 \_ /usr/bin/mtpolicyd (idle) 19464 ? S 0:26 \_ /usr/bin/mtpolicyd (idle) 28858 ? S 0:26 \_ /usr/bin/mtpolicyd (idle) 32372 ? S 0:24 \_ /usr/bin/mtpolicyd (idle) And it should be listening on localhost:12345: $ netstat -aenpt | grep :12345 tcp 0 0 127.0.0.1:12345 0.0.0.0:* LISTEN 0 17333578 - Now test it with a simple query: $ policyd-client -h localhost:12345 Paste the following request to the command: reverse_client_name=smtp.google.com sender=bob@gmail.com client_address=192.168.1.1 recipient=ich@markusbenning.de helo_name=smtp.google.com Terminate the request by a blank line. Just press enter. The mtpolicyd should respond with a action like: PREPEND X-MtScore: NO score =head2 ADD A MTPOLICYD QUERY TO YOUR POSTFIX SMTPD Open you postfix main.cf configuration file in a text editor. It should be located below /etc/postfix. Add a 'check_policyd_service inet:127.0.0.1:12345' check to your smtpd_recipient_restrictions. It should look like this one: smtpd_recipient_restrictions = permit_mynetworks, permit_sasl_authenticated, reject_unauth_destination, check_policy_service inet:127.0.0.1:12345 Now restart postfix. Now follow your maillog as new mails arrive. There should be a mtpolicyd line for every query. =head2 CONGRATULATIONS Your mtpolicyd is now configured and running with the default configuration. You may now want to continue with reading L which explains what the default configuration does. =head1 AUTHOR Markus Benning =head1 COPYRIGHT AND LICENSE This software is Copyright (c) 2014 by Markus Benning . This is free software, licensed under: The GNU General Public License, Version 2, June 1991 =cut UserConfig.pm100644000000000000 236713306510157 23510 0ustar00rootroot000000000000Mail-MtPolicyd-2.03/lib/Mail/MtPolicyd/Plugin/Rolepackage Mail::MtPolicyd::Plugin::Role::UserConfig; use strict; # make critic happy use MooseX::Role::Parameterized; our $VERSION = '2.03'; # VERSION # ABSTRACT: role for plugins using per user/request configuration parameter uc_attributes => ( isa => 'ArrayRef', required => 1, ); role { my $p = shift; foreach my $attribute ( @{$p->uc_attributes} ) { has 'uc_'.$attribute => ( is => 'rw', isa => 'Maybe[Str]', ); } }; sub get_uc { my ($self, $session, $attr) = @_; my $uc_attr = 'uc_'.$attr; if( ! $self->can($uc_attr) ) { die('there is no user config attribute '.$uc_attr.'!'); } if( ! defined $self->$uc_attr ) { return $self->$attr; } my $session_value = $session->{$self->$uc_attr}; if( ! defined $session_value ) { return $self->$attr; } return $session_value; } 1; __END__ =pod =encoding UTF-8 =head1 NAME Mail::MtPolicyd::Plugin::Role::UserConfig - role for plugins using per user/request configuration =head1 VERSION version 2.03 =head1 AUTHOR Markus Benning =head1 COPYRIGHT AND LICENSE This software is Copyright (c) 2014 by Markus Benning . This is free software, licensed under: The GNU General Public License, Version 2, June 1991 =cut Memcached.pm100644000000000000 600613306510157 23514 0ustar00rootroot000000000000Mail-MtPolicyd-2.03/lib/Mail/MtPolicyd/SessionCachepackage Mail::MtPolicyd::SessionCache::Memcached; use Moose; our $VERSION = '2.03'; # VERSION # ABSTRACT: session cache adapter for memcached extends 'Mail::MtPolicyd::SessionCache::Base'; with 'Mail::MtPolicyd::Role::Connection' => { name => 'memcached', type => 'Memcached', }; use Time::HiRes qw(usleep); has 'expire' => ( is => 'ro', isa => 'Int', default => 5 * 60 ); has 'lock_wait' => ( is => 'rw', isa => 'Int', default => 50 ); has 'lock_max_retry' => ( is => 'rw', isa => 'Int', default => 50 ); has 'lock_timeout' => ( is => 'rw', isa => 'Int', default => 10 ); sub _acquire_session_lock { my ( $self, $instance ) = @_; my $lock = 'lock_'.$instance; for( my $try = 1 ; $try < $self->lock_max_retry ; $try++ ) { if( $self->_memcached_handle->add($lock, 1, $self->lock_timeout) ) { return; # lock created } usleep( $self->lock_wait * $try ); } die('could not acquire lock for session '.$instance); return; } sub _release_session_lock { my ( $self, $instance ) = @_; my $lock = 'lock_'.$instance; $self->_memcached_handle->delete($lock); return; } sub retrieve_session { my ($self, $instance ) = @_; if( ! defined $instance ) { return; } $self->_acquire_session_lock( $instance ); if( my $session = $self->_memcached_handle->get($instance) ) { return($session); } return( { '_instance' => $instance } ); } sub store_session { my ($self, $session ) = @_; my $instance = $session->{'_instance'}; if( ! defined $session || ! defined $instance ) { return; } $self->_memcached_handle->set($instance, $session, $self->expire); $self->_release_session_lock($instance); return; } 1; __END__ =pod =encoding UTF-8 =head1 NAME Mail::MtPolicyd::SessionCache::Memcached - session cache adapter for memcached =head1 VERSION version 2.03 =head1 SYNOPSIS module = "Memcached" #memcached = "memcached" # expire session cache entries expire = "300" # wait timeout will be increased each time 50,100,150,... (usec) lock_wait=50 # abort after n retries lock_max_retry=50 # session lock times out after (sec) lock_timeout=10 =head1 PARAMETERS =over =item memcached (default: memcached) Name of the database connection to use. You have to define this connection first. see L =item expire (default: 5*60) Timeout in seconds for sessions. =item lock_wait (default: 50) Timeout for retry when session is locked in milliseconds. The retry will be done in multiples of this timeout. When set to 50 retry will be done in 50, 100, 150ms... =item lock_max_retry (default: 50) Maximum number of retries before giving up to obtain lock on a session. =item lock_timeout (default: 10) Timeout of session locks in seconds. =back =head1 AUTHOR Markus Benning =head1 COPYRIGHT AND LICENSE This software is Copyright (c) 2014 by Markus Benning . This is free software, licensed under: The GNU General Public License, Version 2, June 1991 =cut PluginChain.pm100644000000000000 214313306510157 23635 0ustar00rootroot000000000000Mail-MtPolicyd-2.03/lib/Mail/MtPolicyd/Plugin/Rolepackage Mail::MtPolicyd::Plugin::Role::PluginChain; use Moose::Role; our $VERSION = '2.03'; # VERSION # ABSTRACT: role for plugins to support a nested plugin chain use Mail::MtPolicyd::PluginChain; has 'chain' => ( is => 'ro', isa => 'Maybe[Mail::MtPolicyd::PluginChain]', lazy => 1, default => sub { my $self = shift; if( defined $self->Plugin ) { return Mail::MtPolicyd::PluginChain->new_from_config( $self->vhost_name, $self->Plugin, ); } return; }, ); has 'Plugin' => ( is => 'rw', isa => 'Maybe[HashRef]' ); after 'cron' => sub { my $self = shift; if( defined $self->chain ) { return $self->chain->cron(@_); } return; }; 1; __END__ =pod =encoding UTF-8 =head1 NAME Mail::MtPolicyd::Plugin::Role::PluginChain - role for plugins to support a nested plugin chain =head1 VERSION version 2.03 =head1 AUTHOR Markus Benning =head1 COPYRIGHT AND LICENSE This software is Copyright (c) 2014 by Markus Benning . This is free software, licensed under: The GNU General Public License, Version 2, June 1991 =cut AWL000755000000000000 013306510157 22262 5ustar00rootroot000000000000Mail-MtPolicyd-2.03/lib/Mail/MtPolicyd/Plugin/GreylistSql.pm100644000000000000 641613306510157 23526 0ustar00rootroot000000000000Mail-MtPolicyd-2.03/lib/Mail/MtPolicyd/Plugin/Greylist/AWLpackage Mail::MtPolicyd::Plugin::Greylist::AWL::Sql; use Moose; # ABSTRACT: backend for SQL greylisting awl storage our $VERSION = '2.03'; # VERSION use Time::Seconds; extends 'Mail::MtPolicyd::Plugin::Greylist::AWL::Base'; with 'Mail::MtPolicyd::Role::Connection' => { name => 'db', type => 'Sql', }; with 'Mail::MtPolicyd::Plugin::Role::SqlUtils'; has 'autowl_table' => ( is => 'rw', isa => 'Str', default => 'autowl' ); sub get { my ( $self, $sender_domain, $client_ip ) = @_; my $sql = sprintf("SELECT * FROM %s WHERE sender_domain=? AND client_ip=?", $self->autowl_table ); my $row = $self->execute_sql($sql, $sender_domain, $client_ip)->fetchrow_hashref; return unless defined $row; my $last_seen = $row->{'last_seen'}; my $expires = $last_seen + ( ONE_DAY * $self->autowl_expire_days ); my $now = Time::Piece->new->epoch; if( $now > $expires ) { return; } return $row->{'count'}; } sub create { my ( $self, $sender_domain, $client_ip ) = @_; my $timestamp = my $sql = sprintf("INSERT INTO %s VALUES(NULL, ?, ?, 1, %d)", $self->autowl_table, Time::Piece->new->epoch ); $self->execute_sql($sql, $sender_domain, $client_ip); return; } sub incr { my ( $self, $sender_domain, $client_ip ) = @_; my $sql = sprintf( "UPDATE %s SET count=count+1, last_seen=%d WHERE sender_domain=? AND client_ip=?", $self->autowl_table, Time::Piece->new->epoch ); $self->execute_sql($sql, $sender_domain, $client_ip); return; } sub remove { my ( $self, $sender_domain, $client_ip ) = @_; my $sql = sprintf("DELETE FROM %s WHERE sender_domain=? AND client_ip=?", $self->autowl_table ); $self->execute_sql($sql, $sender_domain, $client_ip); return; } sub expire { my ( $self ) = @_; my $timeout = ONE_DAY * $self->autowl_expire_days; my $now = Time::Piece->new->epoch; my $sql = sprintf("DELETE FROM %s WHERE ? > last_seen + ?", $self->autowl_table ); $self->execute_sql($sql, $now, $timeout); return; } sub init { my $self = shift; $self->check_sql_tables( %{$self->_table_definitions} ); } has '_table_definitions' => ( is => 'ro', isa => 'HashRef', lazy => 1, default => sub { { 'autowl' => { 'mysql' => 'CREATE TABLE %TABLE_NAME% ( `id` int(11) NOT NULL AUTO_INCREMENT, `sender_domain` VARCHAR(255) NOT NULL, `client_ip` VARCHAR(39) NOT NULL, `count` INT UNSIGNED NOT NULL, `last_seen` INT UNSIGNED NOT NULL, PRIMARY KEY (`id`), UNIQUE KEY `domain_ip` (`client_ip`, `sender_domain`), KEY(`client_ip`), KEY(`sender_domain`) ) ENGINE=%MYSQL_ENGINE% DEFAULT CHARSET=latin1', 'SQLite' => 'CREATE TABLE %TABLE_NAME% ( `id` INTEGER PRIMARY KEY AUTOINCREMENT, `sender_domain` VARCHAR(255) NOT NULL, `client_ip` VARCHAR(39) NOT NULL, `count` INT UNSIGNED NOT NULL, `last_seen` INTEGER NOT NULL )', }, } }, ); 1; __END__ =pod =encoding UTF-8 =head1 NAME Mail::MtPolicyd::Plugin::Greylist::AWL::Sql - backend for SQL greylisting awl storage =head1 VERSION version 2.03 =head1 AUTHOR Markus Benning =head1 COPYRIGHT AND LICENSE This software is Copyright (c) 2014 by Markus Benning . This is free software, licensed under: The GNU General Public License, Version 2, June 1991 =cut 00test-net-server_steps.pl100644000000000000 1145613306510157 24225 0ustar00rootroot000000000000Mail-MtPolicyd-2.03/t/step_definitions#!perl use strict; use warnings; package Test::Net::Server; use Test::More; use Test::Exception; use File::Temp; use IO::File; use POSIX; use File::ReadBackwards; use Template; use Moose; has 'class' => ( is => 'ro', isa => 'Str', required => 1 ); has 'config_file' => ( is => 'ro', isa => 'Str', required => 1 ); has 'log_level' => ( is => 'ro', isa => 'Int', default => 4 ); has 'tmpdir' => ( is => 'ro', isa => 'File::Temp::Dir', lazy => 1, default => sub { File::Temp->newdir }, ); has 'tmp_config_file' => ( is => 'ro', isa => 'Str', lazy => 1, default => sub { my $self = shift; return $self->tmpdir.'/mtpolicyd.conf'; }, ); has 'pid_file' => ( is => 'ro', isa => 'Str', lazy => 1, default => sub { my $self = shift; return( $self->tmpdir.'/pid'); } ); has 'log_file' => ( is => 'ro', isa => 'Str', lazy => 1, default => sub { my $self = shift; return( $self->tmpdir.'/log'); } ); has 'port' => ( is => 'ro', isa => 'Int', lazy => 1, default => sub { # may work for now return( 50000 + int(rand(10000)) ); }, ); sub pid { my $self = shift; if( ! -e $self->pid_file ) { return; } my $file = IO::File->new( $self->pid_file, 'r'); if( ! defined $file ) { die( 'could not open pid_file '.$self->pid_file.': '.$!); } my $pid = $file->getline; chomp( $pid ); $file->close; if( ! defined $pid ) { return; } return( $pid ); } has 'timeout' => ( is => 'ro', isa => 'Int', default => 10 ); sub wait_for_logfile { my $self = shift; my $retry = 0; while( ! -e $self->log_file ) { if( $retry >= $self->timeout ) { die('timeout while waiting for log_file to appear!'); } sleep(1); $retry++; } return; } has 'lastlog' => ( is => 'ro', isa => 'ArrayRef', lazy => 1, default => sub {[]}, ); sub wait_for_logmessage { my $self = shift; my $regex = shift; my $log = IO::File->new( $self->log_file, 'r'); if( ! defined $log ) { die('could not open logfile '.$self->log_file.': '.$!); } my $retry = 0; for(;;) { while( my $line = $log->getline ) { chomp( $line ); push( @{$self->lastlog}, $line ); if( $line =~ /$regex/ ) { return $line; } } if( $retry >= $self->timeout ) { die('timeout waiting for log message like '.$regex); } sleep(1); $retry++; } return; } sub tail_log { my $self = shift; my @lines; my $num_lines = 5; if( @_ ) { $num_lines = shift; } my $file = File::ReadBackwards->new( $self->log_file ) or die "can't read 'log_file' $!" ; while( @lines < $num_lines ) { my $line = $file->getline; if( ! defined $line ) { last; } chomp( $line ); push( @lines, $line ); } return( join("\n", reverse @lines) ); } sub generate_config { my $self = shift; my $template = Template->new(); $template->process( $self->config_file, { port => $self->port, }, $self->tmp_config_file ) || die "error processing config: ".$template->error(), "\n"; return; } sub run { my $self = shift; my $class = $self->class; $self->generate_config; eval "require $class"; if( $@ ) { fail('could not load server class: '.$@); return; } my $server; lives_ok { $server = "$class"->new( config_file => $self->tmp_config_file, log_file => $self->log_file, pid_file => $self->pid_file, port => $self->port, user => getuid(), group => getgid(), log_level => $self->log_level, background => undef, setsid => undef, ); } 'creation of server object'; my $pid = fork; if( ! defined $pid ) { fail('failed to fork'); return; } if( $pid == 0 ) { diag('child process running with pid '.$$); if( open my $log_fh, '>>', $self->log_file ) { *STDOUT = $log_fh; *STDERR = $log_fh; } else { fail('could no open log_file: '.$@); exit 1; } eval { $server->run; }; exit 0; } pass('started server '.$self->class.' on port '.$self->port); eval { $self->wait_for_logfile; }; if( $@ ) { fail( $@ ); return; } eval { $self->wait_for_logmessage('^Parent ready'); }; if( $@ ) { fail( $@."\nLogfile:\n".join("\n", @{$self->lastlog} ) ); return; } pass('server is ready'); return; } sub shutdown { my $self = shift; my $pid = $self->pid; if( defined $pid ) { kill( 'QUIT', $pid ); pass('sent SIGQUIT to server with pid '.$pid); } } 1; ExtendedPlugin.pod100644000000000000 1365213306510157 24157 0ustar00rootroot000000000000Mail-MtPolicyd-2.03/lib/Mail/MtPolicyd/Cookbook# PODNAME: Mail::MtPolicyd::Cookbook::ExtendedModule # ABSTRACT: how to archieve certain tasks within a plugin __END__ =pod =encoding UTF-8 =head1 NAME Mail::MtPolicyd::Cookbook::ExtendedModule - how to archieve certain tasks within a plugin =head1 VERSION version 2.03 =head1 Extending your mtpolicyd plugin How to archieve common task within your plugin. =head2 Logging You can output log messages to the mail.log from within your plugin by calling: $self->log( $r, '' ); The log() method is inherited from the Plugin base class. The default log_level used is 4. To debug your plugin you can overwrite the log_level in your plugins configuration: module = "HelloWorld" log_level = 2 This will cause your plugin to log with an higher log_level of 2. =head2 Caching lookup results If your plugin is called from the smtpd_recipient_restrictions if will be called once for every recipient. If your plugin does an lookup (dns, database, ...) should cache the result. The L object implements the method do_cached() to archieve this: my ( $ip_result, $info ) = $r->do_cached('rbl-'.$self->name.'-result', sub { $self->_rbl->check( $ip ) } ); The first parameter is the key in the session to store the cached result. The second parameter is a function reference. It will check if theres already an result stored in the given key within the session. In this case it will return the cached result as an array. If there is no result it will execute the code reference, store the result within the session and will also return an array containing the return values of the result. =head2 Doing things only once per mail If your plugin is called from the smtpd_recipient_restrictions if will be called once for every recipient but some tasks should only be performed once per mail. The L object implements the method is_already_done() to archieve this: if( defined $self->score && ! $r->is_already_done( $self->name.'-score' ) ) { $self->add_score($r, $self->name => $self->score); } The method takes the key in the session in which the flag is stored. The example above will add a new score to the scoring, but only once per mail since the session is persisted across different checks. =head2 Use scoring To add scoring to your plugin your plugin needs to consume the role L. This will add the method add_score( $r, $key, $value ) to your plugin class. The $key is a name for the score you'll see when you display the detailed scores. eg. with the AddScoreHeader or ScoreAction plugin. The $value is positive or negative number. In most cases you want to make this value configurable. It is also recommended that you check that you add an score only once. See is_already_done() method above. Here is an example: with 'Mail::MtPolicyd::Plugin::Role::Scoring'; has 'score' => ( is => 'rw', isa => 'Maybe[Num]' ); And somewhere in your run() method: if( defined $self->score && ! $r->is_already_done( $self->name.'-score' ) ) { $self->add_score( $r, $self->name => $self->score ); } =head2 Make a configuration value user-configurable To add user configurable parameters to your plugin the class must consume the L role. with 'Mail::MtPolicyd::Plugin::Role::UserConfig' => { 'uc_attributes' => [ 'enabled', 'mode' ], }; The regular attributes: has 'enabled' => ( is => 'rw', isa => 'Str', default => 'on' ); has 'mode' => ( is => 'rw', isa => 'Str', default => 'reject' ); The UserConfig role adds the get_uc( $session, $param ) method to your class. To retrieve the user-configurable values for this attributes use: my $session = $r->session; my $mode = $self->get_uc( $session, 'mode' ); my $enabled = $self->get_uc( $session, 'enabled' ); Per user configuration in mtpolicyd works like this: =over =item Retrieve configuration values and store them in the session A plugin like SqlUserConfig retrieves configuration values and stores them in the current session. For example it may set the following key value: hello_world_enabled = off =item A Plugin with user configurable parameters Our HelloWorld plugin may be configured like this: module = "HelloWorld" enabled = on uc_enabled = "hello_world_enabled" If the key "hello_world_enabled" is defined in the session it will use its value for $mode. If it is not defined it will fall back to value of the "enabled" attribute. =back =head2 Set a mail header The L object has an extra constructor for returning a PREPEND action for setting a header: Mail::MtPolicyd::Plugin::Result->new_header_once( $is_already_done, $header_name, $value ); It could be used like this: return Mail::MtPolicyd::Plugin::Result->new_header_once( $r->is_already_done( $self->name.'-tag' ), $header_name, $value ); =head2 Adding periodically scheduled tasks When mtpolicyd is called with the option --cron it will execute all plugins that implement a cron() function. The function is expected to take the following parameters: $plugin->cron( $server, @tasks ); By default mtpolicyd ships with a crontab that will execute the tasks hourly,daily,weekly and monthly. A plugin that implements a weekly task may look like this: sub cron { my $self = shift; my $server = shift; if( grep { $_ eq 'weekly' } @_ ) { # do some weekly tasks $server->log(3, 'i am a weekly task'); } } The $server object could be used for logging. To see the output on the commandline you may call mtpolicyd like this: mtpolicyd -f -l 4 --cron=weekly =head1 AUTHOR Markus Benning =head1 COPYRIGHT AND LICENSE This software is Copyright (c) 2014 by Markus Benning . This is free software, licensed under: The GNU General Public License, Version 2, June 1991 =cut Base.pm100644000000000000 207713306510157 23640 0ustar00rootroot000000000000Mail-MtPolicyd-2.03/lib/Mail/MtPolicyd/Plugin/Greylist/AWLpackage Mail::MtPolicyd::Plugin::Greylist::AWL::Base; use Moose; # ABSTRACT: base class for grelisting AWL storage backends our $VERSION = '2.03'; # VERSION has 'autowl_expire_days' => ( is => 'rw', isa => 'Int', default => 60 ); sub init { my $self = shift; return; } sub get { my ( $self, $sender_domain, $client_ip ) = @_; die('not implemented'); } sub create { my ( $self, $sender_domain, $client_ip ) = @_; die('not implemented'); } sub incr { my ( $self, $sender_domain, $client_ip ) = @_; die('not implemented'); } sub remove { my ( $self, $sender_domain, $client_ip ) = @_; die('not implemented'); } sub expire { } 1; __END__ =pod =encoding UTF-8 =head1 NAME Mail::MtPolicyd::Plugin::Greylist::AWL::Base - base class for grelisting AWL storage backends =head1 VERSION version 2.03 =head1 AUTHOR Markus Benning =head1 COPYRIGHT AND LICENSE This software is Copyright (c) 2014 by Markus Benning . This is free software, licensed under: The GNU General Public License, Version 2, June 1991 =cut Redis.pm100644000000000000 343413306510157 24032 0ustar00rootroot000000000000Mail-MtPolicyd-2.03/lib/Mail/MtPolicyd/Plugin/Greylist/AWLpackage Mail::MtPolicyd::Plugin::Greylist::AWL::Redis; use Moose; # ABSTRACT: backend for redis greylisting awl storage our $VERSION = '2.03'; # VERSION use Time::Seconds; extends 'Mail::MtPolicyd::Plugin::Greylist::AWL::Base'; with 'Mail::MtPolicyd::Role::Connection' => { name => 'redis', type => 'Redis', }; has 'prefix' => ( is => 'rw', isa => 'Str', default => 'awl-' ); sub _get_key { my ( $self, $domain, $ip ) = @_; return join(',', $self->prefix, $domain, $ip); } sub get { my ( $self, $sender_domain, $client_ip ) = @_; my $key = $self->_get_key($sender_domain, $client_ip); return $self->_redis_handle->get($key); } sub create { my ( $self, $sender_domain, $client_ip ) = @_; my $key = $self->_get_key($sender_domain, $client_ip); my $expire = ONE_DAY * $self->autowl_expire_days; $self->_redis_handle->set( $key, '1', 'EX', $expire ); return; } sub incr { my ( $self, $sender_domain, $client_ip ) = @_; my $key = $self->_get_key($sender_domain, $client_ip); my $count = $self->_redis_handle->incr($key, sub {}); my $expire = ONE_DAY * $self->autowl_expire_days; $self->_redis_handle->expire( $key, $expire, sub {}); $self->_redis_handle->wait_all_responses; return; } sub remove { my ( $self, $sender_domain, $client_ip ) = @_; my $key = $self->_get_key($sender_domain, $client_ip); $self->_redis_handle->del($key); return; } 1; __END__ =pod =encoding UTF-8 =head1 NAME Mail::MtPolicyd::Plugin::Greylist::AWL::Redis - backend for redis greylisting awl storage =head1 VERSION version 2.03 =head1 AUTHOR Markus Benning =head1 COPYRIGHT AND LICENSE This software is Copyright (c) 2014 by Markus Benning . This is free software, licensed under: The GNU General Public License, Version 2, June 1991 =cut Ticket000755000000000000 013306510157 23062 5ustar00rootroot000000000000Mail-MtPolicyd-2.03/lib/Mail/MtPolicyd/Plugin/GreylistBase.pm100644000000000000 243713306510157 24440 0ustar00rootroot000000000000Mail-MtPolicyd-2.03/lib/Mail/MtPolicyd/Plugin/Greylist/Ticketpackage Mail::MtPolicyd::Plugin::Greylist::Ticket::Base; use Moose; # ABSTRACT: base class for greylisting ticket storage backends our $VERSION = '2.03'; # VERSION has 'min_retry_wait' => ( is => 'rw', isa => 'Int', default => 60*5 ); has 'max_retry_wait' => ( is => 'rw', isa => 'Int', default => 60*60*2 ); has 'prefix' => ( is => 'rw', isa => 'Str', default => '' ); sub _get_key { my ( $self, $sender, $ip, $rcpt ) = @_; return join(",", $sender, $ip, $rcpt ); } sub init { my $self = shift; return; } sub get { my ( $self, $r, $sender, $ip, $rcpt ) = @_; die('not implemented'); } sub is_valid { my ( $self, $ticket ) = @_; die('not implemented'); } sub remove { my ( $self, $r, $sender, $ip, $rcpt ) = @_; die('not implemented'); } sub create { my ( $self, $r, $sender, $ip, $rcpt ) = @_; die('not implemented'); } sub expire { } 1; __END__ =pod =encoding UTF-8 =head1 NAME Mail::MtPolicyd::Plugin::Greylist::Ticket::Base - base class for greylisting ticket storage backends =head1 VERSION version 2.03 =head1 AUTHOR Markus Benning =head1 COPYRIGHT AND LICENSE This software is Copyright (c) 2014 by Markus Benning . This is free software, licensed under: The GNU General Public License, Version 2, June 1991 =cut Redis.pm100644000000000000 263313306510157 24632 0ustar00rootroot000000000000Mail-MtPolicyd-2.03/lib/Mail/MtPolicyd/Plugin/Greylist/Ticketpackage Mail::MtPolicyd::Plugin::Greylist::Ticket::Redis; use Moose; # ABSTRACT: greylisting ticket storage backend for redis our $VERSION = '2.03'; # VERSION extends 'Mail::MtPolicyd::Plugin::Greylist::Ticket::Base'; with 'Mail::MtPolicyd::Role::Connection' => { name => 'redis', type => 'Redis', }; sub get { my ( $self, $r, $sender, $ip, $rcpt ) = @_; my $key = $self->_get_key($sender, $ip, $rcpt); if( my $ticket = $self->_redis_handle->get( $key ) ) { return( $ticket ); } return; } sub is_valid { my ( $self, $ticket ) = @_; if( time > $ticket ) { return 1; } return 0; } sub remove { my ( $self, $r, $sender, $ip, $rcpt ) = @_; my $key = $self->_get_key($sender, $ip, $rcpt); $self->_redis_handle->del( $key ); return; } sub create { my ( $self, $r, $sender, $ip, $rcpt ) = @_; my $ticket = time + $self->min_retry_wait; my $key = $self->_get_key($sender, $ip, $rcpt); $self->_redis_handle->set( $key, $ticket, 'EX', $self->max_retry_wait ); return; } 1; __END__ =pod =encoding UTF-8 =head1 NAME Mail::MtPolicyd::Plugin::Greylist::Ticket::Redis - greylisting ticket storage backend for redis =head1 VERSION version 2.03 =head1 AUTHOR Markus Benning =head1 COPYRIGHT AND LICENSE This software is Copyright (c) 2014 by Markus Benning . This is free software, licensed under: The GNU General Public License, Version 2, June 1991 =cut HowtoAccountingQuota.pod100644000000000000 1352613306510157 25365 0ustar00rootroot000000000000Mail-MtPolicyd-2.03/lib/Mail/MtPolicyd/Cookbook# PODNAME: Mail::MtPolicyd::Cookbook::HowtoAccountingQuota # ABSTRACT: How to setup smtp level accounting and quotas __END__ =pod =encoding UTF-8 =head1 NAME Mail::MtPolicyd::Cookbook::HowtoAccountingQuota - How to setup smtp level accounting and quotas =head1 VERSION version 2.03 =head1 SMTP level accounting and quotas with mtpolicyd The mtpolicyd could be used to implement a smtp level accounting and quota system. This guide explains how to setup accounting and quotas based on the sender ip on a monthly base and configurable quota limits. The how to expects that mtpolicyd is already installed, working and assumes a MySQL database is used to hold accounting data and quota configuration. =head2 Set up Accounting The accounting and quota checks should be implemented in postfix smtpd_end_of_data_restrictions. If you're already using mtpolicyd for other check it may be necessary to setup a second virtual host for the accounting/quota configuration. Otherwise you can use the default port 12345 virual host. =head3 Setup a second virtual host First tell mtpolicyd to also listen on an addition port. In the global configuration add the new port to the port option: port="127.0.0.1:12345,127.0.0.1:12346" Then add a new virtual host at the end of the configuration file: name="accounting" # TODO: add plugins... =head3 Configure the Accounting plugin Now add the Accounting plugin to your virtual host: module = "Accounting" fields = "client_address" # time_pattern = "%Y-%m" # table_prefix = "acct_" And the restart mtpolicyd to reload the configuration. The plugin will create a table for every field listed in "fields". By default the table prefix is acct_ so the table name will be acct_client_address in our example. The plugin will create a row within this table for every client_address and expanded time_pattern: mysql> select * from acct_client_address; +----+-------------------+---------+-------+------------+---------+-----------+ | id | key | time | count | count_rcpt | size | size_rcpt | +----+-------------------+---------+-------+------------+---------+-----------+ | 1 | 2604:8d00:0:1::3 | 2015-01 | 18 | 18 | 95559 | 95559 | | 2 | 2604:8d00:0:1::4 | 2015-01 | 21 | 21 | 99818 | 99818 | ... +----+-------------------+---------+-------+------------+---------+-----------+ =head3 Activate the check in postfix To active the check add the policyd to your smtpd_end_of_data_restrictions in main.cf: smtpd_end_of_data_restrictions = check_policy_service inet:127.0.0.1:12346 If you have multiple smtpd process configured in a smtp-filter setup make sure only one smtpd is doing accounting/quota checks. Deactivate the restrictions by adding the following option the the re-inject smtpd processes in master.cf: -o smtpd_end_of_data_restrictions= =head2 Setup quota limits To limit the number of messages a client_address is allowed to send add the following Quota plugin to your virtual host configuration B the Accounting plugin: module = "Quota" field = "client_address" metric = "count" threshold = 1000 action = "defer you exceeded your monthly limit, please insert coin" # time_pattern = "%Y-%m" # table_prefix = "acct_" =head2 Using per client_address quota limits Create the following table structure in your MySQL database: CREATE TABLE `relay_policies` ( `id` int(11) NOT NULL auto_increment, `desc` VARCHAR(64) NOT NULL, `config` TEXT NOT NULL, PRIMARY KEY (`id`) ) ENGINE=InnoDB; INSERT INTO relay_policies VALUES(1, 'standard relay host', '{"quota_count":"10000"}'); INSERT INTO relay_policies VALUES(2, 'premium relay host', '{"quota_count":"100000"}'); CREATE TABLE `relay_hosts` ( `id` int(11) NOT NULL auto_increment, `client_address` VARCHAR(64) NOT NULL, `relay_policy` int(11) NOT NULL, PRIMARY KEY (`id`), KEY `relay_policy` (`relay_policy`), CONSTRAINT `relay_hosts_ibfk_1` FOREIGN KEY (`relay_policy`) REFERENCES `relay_policies` (`id`) ) ENGINE=InnoDB; INSERT INTO relay_hosts VALUES(NULL, '2604:8d00:0:1::3', 1); INSERT INTO relay_hosts VALUES(NULL, '2604:8d00:0:1::4', 2); You can use the following SELECT statement to retrieve the configuration for a relay_host: mysql> SELECT p.config FROM relay_policies p JOIN relay_hosts h ON (h.relay_policy = p.id) WHERE h.client_address = '2604:8d00:0:1::4'; +--------------------------+ | config | +--------------------------+ | {"quota_count":"100000"} | +--------------------------+ 1 row in set (0.00 sec) To load the (JSON) configuration into the mtpolicyd session variables use the SqlUserConfig plugin and this SQL statement: module = "SqlUserConfig" sql_query = "SELECT p.config FROM relay_policies p JOIN relay_hosts h ON (h.relay_policy = p.id) WHERE h.client_address=?" field = "client_address" This plugin must be added B your Accounting and Quota plugins. To use the quota_count value instead of the default threshold adjust your Quota plugin configuration: module = "Quota" field = "client_address" metric = "count" threshold = 1000 uc_threshold = "quota_count" action = "defer you exceeded your monthly limit, please insert coin" # time_pattern = "%Y-%m" # table_prefix = "acct_" If the session variable quota_count is defined it will be used as threshold instead of the value configured in mtpolicyd.conf. =head1 AUTHOR Markus Benning =head1 COPYRIGHT AND LICENSE This software is Copyright (c) 2014 by Markus Benning . This is free software, licensed under: The GNU General Public License, Version 2, June 1991 =cut ConfigurableFields.pm100644000000000000 373313306510157 25171 0ustar00rootroot000000000000Mail-MtPolicyd-2.03/lib/Mail/MtPolicyd/Plugin/Rolepackage Mail::MtPolicyd::Plugin::Role::ConfigurableFields; use strict; # make critic happy use MooseX::Role::Parameterized; use Moose::Util::TypeConstraints; our $VERSION = '2.03'; # VERSION # ABSTRACT: role for plugins using configurable fields parameter fields => ( isa => 'HashRef[HashRef]', required => 1, ); role { my $p = shift; foreach my $attr ( keys %{$p->fields} ) { my $value_isa = $p->fields->{$attr}->{'value_isa'}; delete $p->fields->{$attr}->{'value_isa'}; has $attr.'_field' => ( is => 'rw', isa => 'Maybe[Str]', %{$p->fields->{$attr}}, ); method 'get_'.$attr.'_value' => sub { my ( $self, $r ) = @_; return $self->get_configurable_field_value( $r, $attr, $value_isa ); }; } }; sub get_configurable_field_value { my ( $self, $r, $name, $type ) = @_; my $conf_field = $name.'_field'; my $request_field = $self->$conf_field; if( ! defined $request_field || $request_field eq '' ) { $self->log( $r, 'no request field configured in '.$conf_field ); return; } my $value = $r->attr( $request_field ); if( ! defined $value || $value eq '' ) { $self->log( $r, 'value of field '.$request_field. ' not defined or empty' ); return; } if( defined $type ) { my $constraint = find_type_constraint( $type ); my $err = $constraint->validate( $value ); if( defined $err ) { $self->log( $r, 'value of field '.$request_field. ' failed validation for '.$type.': '.$err ); return; } } return $value; } 1; __END__ =pod =encoding UTF-8 =head1 NAME Mail::MtPolicyd::Plugin::Role::ConfigurableFields - role for plugins using configurable fields =head1 VERSION version 2.03 =head1 AUTHOR Markus Benning =head1 COPYRIGHT AND LICENSE This software is Copyright (c) 2014 by Markus Benning . This is free software, licensed under: The GNU General Public License, Version 2, June 1991 =cut Memcached.pm100644000000000000 267413306510157 25437 0ustar00rootroot000000000000Mail-MtPolicyd-2.03/lib/Mail/MtPolicyd/Plugin/Greylist/Ticketpackage Mail::MtPolicyd::Plugin::Greylist::Ticket::Memcached; use Moose; # ABSTRACT: greylisting ticket storage backend for memcached our $VERSION = '2.03'; # VERSION extends 'Mail::MtPolicyd::Plugin::Greylist::Ticket::Base'; with 'Mail::MtPolicyd::Role::Connection' => { name => 'memcached', type => 'Memcached', }; sub get { my ( $self, $r, $sender, $ip, $rcpt ) = @_; my $key = $self->_get_key($sender, $ip, $rcpt); if( my $ticket = $self->_memcached_handle->get( $key ) ) { return( $ticket ); } return; } sub is_valid { my ( $self, $ticket ) = @_; if( time > $ticket ) { return 1; } return 0; } sub remove { my ( $self, $r, $sender, $ip, $rcpt ) = @_; my $key = $self->_get_key($sender, $ip, $rcpt); $self->_memcached_handle->delete( $key ); return; } sub create { my ( $self, $r, $sender, $ip, $rcpt ) = @_; my $ticket = time + $self->min_retry_wait; my $key = $self->_get_key($sender, $ip, $rcpt); $self->_memcached_handle->set( $key, $ticket, $self->max_retry_wait ); return; } 1; __END__ =pod =encoding UTF-8 =head1 NAME Mail::MtPolicyd::Plugin::Greylist::Ticket::Memcached - greylisting ticket storage backend for memcached =head1 VERSION version 2.03 =head1 AUTHOR Markus Benning =head1 COPYRIGHT AND LICENSE This software is Copyright (c) 2014 by Markus Benning . This is free software, licensed under: The GNU General Public License, Version 2, June 1991 =cut