t000755000000000000 013720747620 13517 5ustar00rootroot000000000000Mail-MtPolicyd-2.05use.t100755000000000000 54313720747620 14625 0ustar00rootroot000000000000Mail-MtPolicyd-2.05/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); Mail-MtPolicyd-2.05000755000000000000 013720747620 13333 5ustar00rootroot000000000000LICENSE100644000000000000 4353313720747620 14451 0ustar00rootroot000000000000Mail-MtPolicyd-2.05This 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 1160313720747620 14430 0ustar00rootroot000000000000Mail-MtPolicyd-2.05================================================== Changes from 2019-08-25 00:00:00 +0000 to present. ================================================== ----------------------------------------- version 2.05 at 2020-08-24 14:31:17 +0000 ----------------------------------------- Change: 23a4c606ce978eb0dce60f46e9c9ccf81005a582 Author: Markus Benning Date : 2020-08-24 16:22:18 +0000 Allow configuration of error behaviour in SPF This adds support for configuring actions/score for SPF temperror and permerror cases. ----------------------------------------- version 2.04 at 2020-06-01 17:59:30 +0000 ----------------------------------------- Change: 9bdd895e08a6b5afd8804a16fc011888482e9b83 Author: Markus Benning Date : 2020-06-01 19:59:30 +0000 Fix openldap container in docker-compose env Change: 267afbef3de10f3307f087c99f454f1277f9b584 Author: Markus Benning Date : 2020-06-01 19:41:55 +0000 Fix duplicate initialization in SqlList plugin Change: 606c751f7e597a76787c34f2f7a00b72e4032539 Author: Markus Benning Date : 2020-06-01 19:34:50 +0000 Generate README from bin/mtpolicyd Change: 8d5a00a71d3d52027985ec98292deb315682810d Author: Markus Benning Date : 2020-06-01 19:30:09 +0000 Add README.md generation Change: 053db08c816b78d9a7b78a8c28a64c349c4d83d7 Author: Markus Benning Date : 2020-05-31 07:32:43 +0000 Allow to configure the field for SQL lookups This adds a option `field` to the SqlList plugin to allow setting the field used for the SQL lookup. Change: 1e86aab20c562c7baa3cda47d4ad345b874a1d7e Author: Markus Benning Date : 2020-05-31 07:29:12 +0000 Handle Mail::SPF perm/temp errors This adds handling of permerror and temperror returned by Mail::SPF. It also exposes the following options of Mail::SPF: * max_dns_interactive_terms * max_name_lookups_per_term * max_void_dns_lookups Change: a9afcc0bd8fadccf9e9b99eacfd7a92e40b73253 Author: Markus Benning Date : 2020-05-28 14:53:02 +0000 Retab code Change: b9568062702df9bc5510259d62496ecc4f48793a Author: Markus Benning Date : 2018-07-18 17:50:39 +0000 Add mariadb to docker environment This adds a mariadb database to the docker-compose development environment. Change: 606e88f49ecd13595a454614ed812a47dce26438 Author: Markus Benning Date : 2018-06-22 10:48:33 +0000 Fix spell errors in documentation Change: c7b5541c7c5fc61f05bea7c76a9eaa81cbbec783 Author: Markus Benning Date : 2018-06-22 10:06:10 +0000 Move ldap to new examples/ folder Change: 7599f207afa29f1bd6ea6e488fd1a7caafc925ea Author: Markus Benning Date : 2018-06-22 09:24:49 +0000 Merge pull request #30 from falon/master A complete example of accounting over LDAP Change: 2012886de6356fba506c4b84f7623d7b9dd16db5 Author: Marco Favero Date : 2018-06-21 10:33:00 +0000 Update README.md Change: a82a68484b9a70a045f02f90a684b6b09f68d6a7 Author: Marco Favero Date : 2018-06-21 10:31:13 +0000 Update README.md Change: 963cf7227b7607a003e43798672a557e59d8cb63 Author: Marco Favero Date : 2018-06-21 10:25:10 +0000 Update and rename LDAP.readme.md to README.md Change: 1fd7933e1b3db2c92487dc47c219c3cdeb426d1f Author: Marco Favero Date : 2018-06-21 10:08:57 +0000 Merge pull request #3 from falon/patch-3 Create mtpolicyd.conf Change: 417ad7278940c05367aa7178fde880f4a3ea9a30 Author: Marco Favero Date : 2018-06-21 10:07:55 +0000 Merge pull request #2 from falon/patch-2 Create 97mtpolicyd.ldif Change: ab7a505f3a99b82172833294b9644d0f5036e4ca Author: Marco Favero Date : 2018-06-21 10:07:03 +0000 Merge pull request #1 from falon/patch-1 Create LDAP.readme.md Change: 3797754d766f0feaabe591960d608a6f70a3ac2c Author: Marco Favero Date : 2018-06-20 12:35:59 +0000 Create mtpolicyd.conf A working mtpolicyd conf for accounting usernames over LDAP. Change: efa528fec375cb0905517a4222202531eb5393a4 Author: Marco Favero Date : 2018-06-20 12:31:08 +0000 Create 97mtpolicyd.ldif A possible LDAP schema for accounting plugin. Change: 6e57fc2974e824fd49e95fb4e01c41f44032a060 Author: Marco Favero Date : 2018-06-20 12:27:46 +0000 Create LDAP.readme.md A case study for MtPolicyd over LDAP. ================================================= Plus 16 releases after 2019-08-25 00:00:00 +0000. ================================================= cpanfile100644000000000000 514213720747620 15122 0ustar00rootroot000000000000Mail-MtPolicyd-2.05#!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'; requires 'Dist::Zilla::Plugin::ReadmeAnyFromPod'; requires 'Dist::Zilla::Plugin::ReadmeFromPod'; }; feature 'mysql' => sub { recommends 'DBD::mysql'; } dist.ini100755000000000000 170713720747620 15070 0ustar00rootroot000000000000Mail-MtPolicyd-2.05name = 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$ [ReadmeFromPod] [ReadmeAnyFromPod / ReadmePodInRoot] type = markdown filename = README.md location = root source_filename = bin/mtpolicyd cron.t100644000000000000 262513720747620 15012 0ustar00rootroot000000000000Mail-MtPolicyd-2.05/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 2144413720747620 14712 0ustar00rootroot000000000000Mail-MtPolicyd-2.05--- 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.015, 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.05' Mail::MtPolicyd::AddressList: file: lib/Mail/MtPolicyd/AddressList.pm version: '2.05' Mail::MtPolicyd::Client: file: lib/Mail/MtPolicyd/Client.pm version: '2.05' Mail::MtPolicyd::Client::App: file: lib/Mail/MtPolicyd/Client/App.pm version: '2.05' Mail::MtPolicyd::Client::Request: file: lib/Mail/MtPolicyd/Client/Request.pm version: '2.05' Mail::MtPolicyd::Client::Response: file: lib/Mail/MtPolicyd/Client/Response.pm version: '2.05' Mail::MtPolicyd::Connection: file: lib/Mail/MtPolicyd/Connection.pm version: '2.05' Mail::MtPolicyd::Connection::Ldap: file: lib/Mail/MtPolicyd/Connection/Ldap.pm version: '2.05' Mail::MtPolicyd::Connection::Memcached: file: lib/Mail/MtPolicyd/Connection/Memcached.pm version: '2.05' Mail::MtPolicyd::Connection::Redis: file: lib/Mail/MtPolicyd/Connection/Redis.pm version: '2.05' Mail::MtPolicyd::Connection::Sql: file: lib/Mail/MtPolicyd/Connection/Sql.pm version: '2.05' Mail::MtPolicyd::ConnectionPool: file: lib/Mail/MtPolicyd/ConnectionPool.pm version: '2.05' Mail::MtPolicyd::Plugin: file: lib/Mail/MtPolicyd/Plugin.pm version: '2.05' Mail::MtPolicyd::Plugin::Accounting: file: lib/Mail/MtPolicyd/Plugin/Accounting.pm version: '2.05' Mail::MtPolicyd::Plugin::Action: file: lib/Mail/MtPolicyd/Plugin/Action.pm version: '2.05' Mail::MtPolicyd::Plugin::AddScoreHeader: file: lib/Mail/MtPolicyd/Plugin/AddScoreHeader.pm version: '2.05' Mail::MtPolicyd::Plugin::ClearFields: file: lib/Mail/MtPolicyd/Plugin/ClearFields.pm version: '2.05' Mail::MtPolicyd::Plugin::Condition: file: lib/Mail/MtPolicyd/Plugin/Condition.pm version: '2.05' Mail::MtPolicyd::Plugin::CtIpRep: file: lib/Mail/MtPolicyd/Plugin/CtIpRep.pm version: '2.05' Mail::MtPolicyd::Plugin::DBL: file: lib/Mail/MtPolicyd/Plugin/DBL.pm version: '2.05' Mail::MtPolicyd::Plugin::Eval: file: lib/Mail/MtPolicyd/Plugin/Eval.pm version: '2.05' Mail::MtPolicyd::Plugin::Fail2Ban: file: lib/Mail/MtPolicyd/Plugin/Fail2Ban.pm version: '2.05' Mail::MtPolicyd::Plugin::GeoIPAction: file: lib/Mail/MtPolicyd/Plugin/GeoIPAction.pm version: '2.05' Mail::MtPolicyd::Plugin::GeoIPLookup: file: lib/Mail/MtPolicyd/Plugin/GeoIPLookup.pm version: '2.05' Mail::MtPolicyd::Plugin::Greylist: file: lib/Mail/MtPolicyd/Plugin/Greylist.pm version: '2.05' Mail::MtPolicyd::Plugin::Greylist::AWL::Base: file: lib/Mail/MtPolicyd/Plugin/Greylist/AWL/Base.pm version: '2.05' Mail::MtPolicyd::Plugin::Greylist::AWL::Redis: file: lib/Mail/MtPolicyd/Plugin/Greylist/AWL/Redis.pm version: '2.05' Mail::MtPolicyd::Plugin::Greylist::AWL::Sql: file: lib/Mail/MtPolicyd/Plugin/Greylist/AWL/Sql.pm version: '2.05' Mail::MtPolicyd::Plugin::Greylist::Ticket::Base: file: lib/Mail/MtPolicyd/Plugin/Greylist/Ticket/Base.pm version: '2.05' Mail::MtPolicyd::Plugin::Greylist::Ticket::Memcached: file: lib/Mail/MtPolicyd/Plugin/Greylist/Ticket/Memcached.pm version: '2.05' Mail::MtPolicyd::Plugin::Greylist::Ticket::Redis: file: lib/Mail/MtPolicyd/Plugin/Greylist/Ticket/Redis.pm version: '2.05' Mail::MtPolicyd::Plugin::Honeypot: file: lib/Mail/MtPolicyd/Plugin/Honeypot.pm version: '2.05' Mail::MtPolicyd::Plugin::LdapUserConfig: file: lib/Mail/MtPolicyd/Plugin/LdapUserConfig.pm version: '2.05' Mail::MtPolicyd::Plugin::PostfixMap: file: lib/Mail/MtPolicyd/Plugin/PostfixMap.pm version: '2.05' Mail::MtPolicyd::Plugin::Proxy: file: lib/Mail/MtPolicyd/Plugin/Proxy.pm version: '2.05' Mail::MtPolicyd::Plugin::Quota: file: lib/Mail/MtPolicyd/Plugin/Quota.pm version: '2.05' Mail::MtPolicyd::Plugin::RBL: file: lib/Mail/MtPolicyd/Plugin/RBL.pm version: '2.05' Mail::MtPolicyd::Plugin::RBLAction: file: lib/Mail/MtPolicyd/Plugin/RBLAction.pm version: '2.05' Mail::MtPolicyd::Plugin::RegexList: file: lib/Mail/MtPolicyd/Plugin/RegexList.pm version: '2.05' Mail::MtPolicyd::Plugin::Result: file: lib/Mail/MtPolicyd/Plugin/Result.pm version: '2.05' Mail::MtPolicyd::Plugin::Role::ConfigurableFields: file: lib/Mail/MtPolicyd/Plugin/Role/ConfigurableFields.pm version: '2.05' Mail::MtPolicyd::Plugin::Role::PluginChain: file: lib/Mail/MtPolicyd/Plugin/Role/PluginChain.pm version: '2.05' Mail::MtPolicyd::Plugin::Role::Scoring: file: lib/Mail/MtPolicyd/Plugin/Role/Scoring.pm version: '2.05' Mail::MtPolicyd::Plugin::Role::SqlUtils: file: lib/Mail/MtPolicyd/Plugin/Role/SqlUtils.pm version: '2.05' Mail::MtPolicyd::Plugin::Role::UserConfig: file: lib/Mail/MtPolicyd/Plugin/Role/UserConfig.pm version: '2.05' Mail::MtPolicyd::Plugin::SMTPVerify: file: lib/Mail/MtPolicyd/Plugin/SMTPVerify.pm version: '2.05' Mail::MtPolicyd::Plugin::SPF: file: lib/Mail/MtPolicyd/Plugin/SPF.pm version: '2.05' Mail::MtPolicyd::Plugin::SaAwlAction: file: lib/Mail/MtPolicyd/Plugin/SaAwlAction.pm version: '2.05' Mail::MtPolicyd::Plugin::SaAwlLookup: file: lib/Mail/MtPolicyd/Plugin/SaAwlLookup.pm version: '2.05' Mail::MtPolicyd::Plugin::ScoreAction: file: lib/Mail/MtPolicyd/Plugin/ScoreAction.pm version: '2.05' Mail::MtPolicyd::Plugin::SetField: file: lib/Mail/MtPolicyd/Plugin/SetField.pm version: '2.05' Mail::MtPolicyd::Plugin::SqlList: file: lib/Mail/MtPolicyd/Plugin/SqlList.pm version: '2.05' Mail::MtPolicyd::Plugin::SqlUserConfig: file: lib/Mail/MtPolicyd/Plugin/SqlUserConfig.pm version: '2.05' Mail::MtPolicyd::Plugin::Stress: file: lib/Mail/MtPolicyd/Plugin/Stress.pm version: '2.05' Mail::MtPolicyd::PluginChain: file: lib/Mail/MtPolicyd/PluginChain.pm version: '2.05' Mail::MtPolicyd::Profiler: file: lib/Mail/MtPolicyd/Profiler.pm version: '2.05' Mail::MtPolicyd::Profiler::Timer: file: lib/Mail/MtPolicyd/Profiler/Timer.pm version: '2.05' Mail::MtPolicyd::Request: file: lib/Mail/MtPolicyd/Request.pm version: '2.05' Mail::MtPolicyd::Result: file: lib/Mail/MtPolicyd/Result.pm version: '2.05' Mail::MtPolicyd::Role::Connection: file: lib/Mail/MtPolicyd/Role/Connection.pm version: '2.05' Mail::MtPolicyd::SessionCache: file: lib/Mail/MtPolicyd/SessionCache.pm version: '2.05' Mail::MtPolicyd::SessionCache::Base: file: lib/Mail/MtPolicyd/SessionCache/Base.pm version: '2.05' Mail::MtPolicyd::SessionCache::Memcached: file: lib/Mail/MtPolicyd/SessionCache/Memcached.pm version: '2.05' Mail::MtPolicyd::SessionCache::None: file: lib/Mail/MtPolicyd/SessionCache/None.pm version: '2.05' Mail::MtPolicyd::SessionCache::Redis: file: lib/Mail/MtPolicyd/SessionCache/Redis.pm version: '2.05' Mail::MtPolicyd::VirtualHost: file: lib/Mail/MtPolicyd/VirtualHost.pm version: '2.05' 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.05' x_generated_by_perl: v5.24.0 x_serialization_backend: 'YAML::Tiny version 1.73' x_spdx_expression: GPL-2.0-only MANIFEST100644000000000000 1011013720747620 14556 0ustar00rootroot000000000000Mail-MtPolicyd-2.05# This file was automatically generated by Dist::Zilla::Plugin::Manifest v6.015. CHANGES Dockerfile LICENSE MANIFEST META.json META.yml Makefile.PL bin/mtpolicyd bin/policyd-client cpanfile dist.ini docker-compose.yml etc/docker.conf etc/mtpolicyd.conf etc/mtpolicyd.crontab examples/ldap/97mtpolicyd.ldif examples/ldap/README.md examples/ldap/mtpolicyd.conf 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 3367613720747620 15074 0ustar00rootroot000000000000Mail-MtPolicyd-2.05{ "abstract" : "a modular policy daemon for postfix", "author" : [ "Markus Benning " ], "dynamic_config" : 0, "generated_by" : "Dist::Zilla version 6.015, 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::ReadmeAnyFromPod" : "0", "Dist::Zilla::Plugin::ReadmeFromPod" : "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.05" }, "Mail::MtPolicyd::AddressList" : { "file" : "lib/Mail/MtPolicyd/AddressList.pm", "version" : "2.05" }, "Mail::MtPolicyd::Client" : { "file" : "lib/Mail/MtPolicyd/Client.pm", "version" : "2.05" }, "Mail::MtPolicyd::Client::App" : { "file" : "lib/Mail/MtPolicyd/Client/App.pm", "version" : "2.05" }, "Mail::MtPolicyd::Client::Request" : { "file" : "lib/Mail/MtPolicyd/Client/Request.pm", "version" : "2.05" }, "Mail::MtPolicyd::Client::Response" : { "file" : "lib/Mail/MtPolicyd/Client/Response.pm", "version" : "2.05" }, "Mail::MtPolicyd::Connection" : { "file" : "lib/Mail/MtPolicyd/Connection.pm", "version" : "2.05" }, "Mail::MtPolicyd::Connection::Ldap" : { "file" : "lib/Mail/MtPolicyd/Connection/Ldap.pm", "version" : "2.05" }, "Mail::MtPolicyd::Connection::Memcached" : { "file" : "lib/Mail/MtPolicyd/Connection/Memcached.pm", "version" : "2.05" }, "Mail::MtPolicyd::Connection::Redis" : { "file" : "lib/Mail/MtPolicyd/Connection/Redis.pm", "version" : "2.05" }, "Mail::MtPolicyd::Connection::Sql" : { "file" : "lib/Mail/MtPolicyd/Connection/Sql.pm", "version" : "2.05" }, "Mail::MtPolicyd::ConnectionPool" : { "file" : "lib/Mail/MtPolicyd/ConnectionPool.pm", "version" : "2.05" }, "Mail::MtPolicyd::Plugin" : { "file" : "lib/Mail/MtPolicyd/Plugin.pm", "version" : "2.05" }, "Mail::MtPolicyd::Plugin::Accounting" : { "file" : "lib/Mail/MtPolicyd/Plugin/Accounting.pm", "version" : "2.05" }, "Mail::MtPolicyd::Plugin::Action" : { "file" : "lib/Mail/MtPolicyd/Plugin/Action.pm", "version" : "2.05" }, "Mail::MtPolicyd::Plugin::AddScoreHeader" : { "file" : "lib/Mail/MtPolicyd/Plugin/AddScoreHeader.pm", "version" : "2.05" }, "Mail::MtPolicyd::Plugin::ClearFields" : { "file" : "lib/Mail/MtPolicyd/Plugin/ClearFields.pm", "version" : "2.05" }, "Mail::MtPolicyd::Plugin::Condition" : { "file" : "lib/Mail/MtPolicyd/Plugin/Condition.pm", "version" : "2.05" }, "Mail::MtPolicyd::Plugin::CtIpRep" : { "file" : "lib/Mail/MtPolicyd/Plugin/CtIpRep.pm", "version" : "2.05" }, "Mail::MtPolicyd::Plugin::DBL" : { "file" : "lib/Mail/MtPolicyd/Plugin/DBL.pm", "version" : "2.05" }, "Mail::MtPolicyd::Plugin::Eval" : { "file" : "lib/Mail/MtPolicyd/Plugin/Eval.pm", "version" : "2.05" }, "Mail::MtPolicyd::Plugin::Fail2Ban" : { "file" : "lib/Mail/MtPolicyd/Plugin/Fail2Ban.pm", "version" : "2.05" }, "Mail::MtPolicyd::Plugin::GeoIPAction" : { "file" : "lib/Mail/MtPolicyd/Plugin/GeoIPAction.pm", "version" : "2.05" }, "Mail::MtPolicyd::Plugin::GeoIPLookup" : { "file" : "lib/Mail/MtPolicyd/Plugin/GeoIPLookup.pm", "version" : "2.05" }, "Mail::MtPolicyd::Plugin::Greylist" : { "file" : "lib/Mail/MtPolicyd/Plugin/Greylist.pm", "version" : "2.05" }, "Mail::MtPolicyd::Plugin::Greylist::AWL::Base" : { "file" : "lib/Mail/MtPolicyd/Plugin/Greylist/AWL/Base.pm", "version" : "2.05" }, "Mail::MtPolicyd::Plugin::Greylist::AWL::Redis" : { "file" : "lib/Mail/MtPolicyd/Plugin/Greylist/AWL/Redis.pm", "version" : "2.05" }, "Mail::MtPolicyd::Plugin::Greylist::AWL::Sql" : { "file" : "lib/Mail/MtPolicyd/Plugin/Greylist/AWL/Sql.pm", "version" : "2.05" }, "Mail::MtPolicyd::Plugin::Greylist::Ticket::Base" : { "file" : "lib/Mail/MtPolicyd/Plugin/Greylist/Ticket/Base.pm", "version" : "2.05" }, "Mail::MtPolicyd::Plugin::Greylist::Ticket::Memcached" : { "file" : "lib/Mail/MtPolicyd/Plugin/Greylist/Ticket/Memcached.pm", "version" : "2.05" }, "Mail::MtPolicyd::Plugin::Greylist::Ticket::Redis" : { "file" : "lib/Mail/MtPolicyd/Plugin/Greylist/Ticket/Redis.pm", "version" : "2.05" }, "Mail::MtPolicyd::Plugin::Honeypot" : { "file" : "lib/Mail/MtPolicyd/Plugin/Honeypot.pm", "version" : "2.05" }, "Mail::MtPolicyd::Plugin::LdapUserConfig" : { "file" : "lib/Mail/MtPolicyd/Plugin/LdapUserConfig.pm", "version" : "2.05" }, "Mail::MtPolicyd::Plugin::PostfixMap" : { "file" : "lib/Mail/MtPolicyd/Plugin/PostfixMap.pm", "version" : "2.05" }, "Mail::MtPolicyd::Plugin::Proxy" : { "file" : "lib/Mail/MtPolicyd/Plugin/Proxy.pm", "version" : "2.05" }, "Mail::MtPolicyd::Plugin::Quota" : { "file" : "lib/Mail/MtPolicyd/Plugin/Quota.pm", "version" : "2.05" }, "Mail::MtPolicyd::Plugin::RBL" : { "file" : "lib/Mail/MtPolicyd/Plugin/RBL.pm", "version" : "2.05" }, "Mail::MtPolicyd::Plugin::RBLAction" : { "file" : "lib/Mail/MtPolicyd/Plugin/RBLAction.pm", "version" : "2.05" }, "Mail::MtPolicyd::Plugin::RegexList" : { "file" : "lib/Mail/MtPolicyd/Plugin/RegexList.pm", "version" : "2.05" }, "Mail::MtPolicyd::Plugin::Result" : { "file" : "lib/Mail/MtPolicyd/Plugin/Result.pm", "version" : "2.05" }, "Mail::MtPolicyd::Plugin::Role::ConfigurableFields" : { "file" : "lib/Mail/MtPolicyd/Plugin/Role/ConfigurableFields.pm", "version" : "2.05" }, "Mail::MtPolicyd::Plugin::Role::PluginChain" : { "file" : "lib/Mail/MtPolicyd/Plugin/Role/PluginChain.pm", "version" : "2.05" }, "Mail::MtPolicyd::Plugin::Role::Scoring" : { "file" : "lib/Mail/MtPolicyd/Plugin/Role/Scoring.pm", "version" : "2.05" }, "Mail::MtPolicyd::Plugin::Role::SqlUtils" : { "file" : "lib/Mail/MtPolicyd/Plugin/Role/SqlUtils.pm", "version" : "2.05" }, "Mail::MtPolicyd::Plugin::Role::UserConfig" : { "file" : "lib/Mail/MtPolicyd/Plugin/Role/UserConfig.pm", "version" : "2.05" }, "Mail::MtPolicyd::Plugin::SMTPVerify" : { "file" : "lib/Mail/MtPolicyd/Plugin/SMTPVerify.pm", "version" : "2.05" }, "Mail::MtPolicyd::Plugin::SPF" : { "file" : "lib/Mail/MtPolicyd/Plugin/SPF.pm", "version" : "2.05" }, "Mail::MtPolicyd::Plugin::SaAwlAction" : { "file" : "lib/Mail/MtPolicyd/Plugin/SaAwlAction.pm", "version" : "2.05" }, "Mail::MtPolicyd::Plugin::SaAwlLookup" : { "file" : "lib/Mail/MtPolicyd/Plugin/SaAwlLookup.pm", "version" : "2.05" }, "Mail::MtPolicyd::Plugin::ScoreAction" : { "file" : "lib/Mail/MtPolicyd/Plugin/ScoreAction.pm", "version" : "2.05" }, "Mail::MtPolicyd::Plugin::SetField" : { "file" : "lib/Mail/MtPolicyd/Plugin/SetField.pm", "version" : "2.05" }, "Mail::MtPolicyd::Plugin::SqlList" : { "file" : "lib/Mail/MtPolicyd/Plugin/SqlList.pm", "version" : "2.05" }, "Mail::MtPolicyd::Plugin::SqlUserConfig" : { "file" : "lib/Mail/MtPolicyd/Plugin/SqlUserConfig.pm", "version" : "2.05" }, "Mail::MtPolicyd::Plugin::Stress" : { "file" : "lib/Mail/MtPolicyd/Plugin/Stress.pm", "version" : "2.05" }, "Mail::MtPolicyd::PluginChain" : { "file" : "lib/Mail/MtPolicyd/PluginChain.pm", "version" : "2.05" }, "Mail::MtPolicyd::Profiler" : { "file" : "lib/Mail/MtPolicyd/Profiler.pm", "version" : "2.05" }, "Mail::MtPolicyd::Profiler::Timer" : { "file" : "lib/Mail/MtPolicyd/Profiler/Timer.pm", "version" : "2.05" }, "Mail::MtPolicyd::Request" : { "file" : "lib/Mail/MtPolicyd/Request.pm", "version" : "2.05" }, "Mail::MtPolicyd::Result" : { "file" : "lib/Mail/MtPolicyd/Result.pm", "version" : "2.05" }, "Mail::MtPolicyd::Role::Connection" : { "file" : "lib/Mail/MtPolicyd/Role/Connection.pm", "version" : "2.05" }, "Mail::MtPolicyd::SessionCache" : { "file" : "lib/Mail/MtPolicyd/SessionCache.pm", "version" : "2.05" }, "Mail::MtPolicyd::SessionCache::Base" : { "file" : "lib/Mail/MtPolicyd/SessionCache/Base.pm", "version" : "2.05" }, "Mail::MtPolicyd::SessionCache::Memcached" : { "file" : "lib/Mail/MtPolicyd/SessionCache/Memcached.pm", "version" : "2.05" }, "Mail::MtPolicyd::SessionCache::None" : { "file" : "lib/Mail/MtPolicyd/SessionCache/None.pm", "version" : "2.05" }, "Mail::MtPolicyd::SessionCache::Redis" : { "file" : "lib/Mail/MtPolicyd/SessionCache/Redis.pm", "version" : "2.05" }, "Mail::MtPolicyd::VirtualHost" : { "file" : "lib/Mail/MtPolicyd/VirtualHost.pm", "version" : "2.05" } }, "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.05", "x_generated_by_perl" : "v5.24.0", "x_serialization_backend" : "Cpanel::JSON::XS version 4.19", "x_spdx_expression" : "GPL-2.0-only" } Dockerfile100644000000000000 121613720747620 15406 0ustar00rootroot000000000000Mail-MtPolicyd-2.05FROM 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 cpanm --notest DBD::mysql \ && 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", "-c", "/etc/mtpolicyd/mtpolicyd.conf" ] request.t100755000000000000 332013720747620 15535 0ustar00rootroot000000000000Mail-MtPolicyd-2.05/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 536013720747620 15517 0ustar00rootroot000000000000Mail-MtPolicyd-2.05/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 736213720747620 15376 0ustar00rootroot000000000000Mail-MtPolicyd-2.05# This file was automatically generated by Dist::Zilla::Plugin::MakeMaker v6.015. 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.05", "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 151113720747620 15664 0ustar00rootroot000000000000Mail-MtPolicyd-2.05/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 013720747620 14024 5ustar00rootroot000000000000Mail-MtPolicyd-2.05mtpolicyd100755000000000000 2343713720747620 16147 0ustar00rootroot000000000000Mail-MtPolicyd-2.05/bin#!/usr/bin/perl use strict; use warnings; our $VERSION = '2.05'; # 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.05 =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) Specify 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 registered 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 registered 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 501313720747620 16103 0ustar00rootroot000000000000Mail-MtPolicyd-2.05/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-spf.t100755000000000000 667013720747620 16144 0ustar00rootroot000000000000Mail-MtPolicyd-2.05/t#!perl use strict; use warnings; use Test::More tests => 77; use Test::Exception; use Test::MockObject; use Mail::MtPolicyd::Request; use Mail::MtPolicyd::Plugin::SPF; my $p; # 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_request { my ($ip, $addr, $action, $score) = @_; my $session = { '_instance' => 'abcd1234', }; my $r = Mail::MtPolicyd::Request->new( attributes => { 'instance' => 'abcd1234', 'helo_name' => 'affenschaukel.bofh-noc.de', 'client_address' => $ip, 'sender' => $addr, }, session => $session, server => $server, use_caching => 0, ); isa_ok( $r, 'Mail::MtPolicyd::Request'); my $result; lives_ok { $result = $p->run($r); } 'execute request'; if(defined $action) { isa_ok( $result, 'Mail::MtPolicyd::Plugin::Result' ); like( $result->action, $action, 'check action' ); } else { is( $result, undef, 'should not match' ); } is($session->{'score'}, $score, "test score"); return; } $p = Mail::MtPolicyd::Plugin::SPF->new( name => 'spf', enabled => 'on', pass_score => -10, pass_mode => 'passive', fail_score => 5, fail_mode => 'reject', ); isa_ok($p, 'Mail::MtPolicyd::Plugin::SPF'); test_request('78.47.220.83', 'spf@markusbenning.de', undef, -10); test_request('192.168.1.1', 'spf@markusbenning.de', qr/reject SPF validation failed/, 5); test_request('192.168.1.1', 'spf@spf-fail.bofh-noc.de', qr/reject SPF validation failed/, 5); test_request('192.168.1.1', 'spf@spf-pass.bofh-noc.de', undef, -10); test_request('192.168.1.1', 'spf@spf-softfail.bofh-noc.de', undef, undef); test_request('192.168.1.1', 'spf@spf-permerror-syntax.bofh-noc.de', qr/reject spf mfrom check failed/, undef); $p = Mail::MtPolicyd::Plugin::SPF->new( name => 'spf', enabled => 'on', softfail_mode => 'reject', softfail_score => 5, ); isa_ok($p, 'Mail::MtPolicyd::Plugin::SPF'); test_request('192.168.1.1', 'spf@spf-softfail.bofh-noc.de', qr/reject SPF validation failed/, 5); $p = Mail::MtPolicyd::Plugin::SPF->new( name => 'spf', enabled => 'on', permerror_mode => 'passive', permerror_score => 15, ); isa_ok($p, 'Mail::MtPolicyd::Plugin::SPF'); test_request('192.168.1.1', 'spf@spf-permerror-syntax.bofh-noc.de', undef, 15); $p = Mail::MtPolicyd::Plugin::SPF->new( name => 'spf', enabled => 'on', pass_mode => 'passive', softfail_mode => 'passive', fail_mode => 'passive', permerror_mode => 'passive', ); isa_ok($p, 'Mail::MtPolicyd::Plugin::SPF'); test_request('192.168.1.1', 'spf@spf-pass.bofh-noc.de', undef, undef); test_request('192.168.1.1', 'spf@spf-softfail.bofh-noc.de', undef, undef); test_request('192.168.1.1', 'spf@spf-fail.bofh-noc.de', undef, undef); test_request('192.168.1.1', 'spf@spf-permerror-syntax.bofh-noc.de', undef, undef); $p = Mail::MtPolicyd::Plugin::SPF->new( name => 'spf', enabled => 'on', pass_mode => 'dunno', softfail_mode => 'reject', fail_mode => 'reject', permerror_mode => 'reject', ); isa_ok($p, 'Mail::MtPolicyd::Plugin::SPF'); test_request('192.168.1.1', 'spf@spf-pass.bofh-noc.de', qr/^dunno/, undef); test_request('192.168.1.1', 'spf@spf-softfail.bofh-noc.de', qr/^reject/, undef); test_request('192.168.1.1', 'spf@spf-fail.bofh-noc.de', qr/^reject/, undef); test_request('192.168.1.1', 'spf@spf-permerror-syntax.bofh-noc.de', qr/^reject/, undef); plugin-rbl.t100755000000000000 565213720747620 16132 0ustar00rootroot000000000000Mail-MtPolicyd-2.05/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'); addresslist.t100755000000000000 217513720747620 16375 0ustar00rootroot000000000000Mail-MtPolicyd-2.05/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 312013720747620 16427 0ustar00rootroot000000000000Mail-MtPolicyd-2.05/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' ); etc000755000000000000 013720747620 14027 5ustar00rootroot000000000000Mail-MtPolicyd-2.05docker.conf100644000000000000 1177413720747620 16337 0ustar00rootroot000000000000Mail-MtPolicyd-2.05/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=4 host=0.0.0.0 port="12345" vhost_by_policy_context=1 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 = "Sql" dsn = "dbi:mysql:database=mtpolicyd;host=mariadb;port=3306" user = "mtpolicyd" password = "secret" 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 name="accounting" module = "Accounting" db = mariadb # per ip and user fields = "client_address,sasl_username" time_pattern = "%Y-%m-%d" table_prefix = "acct_" session-cache.t100644000000000000 635213720747620 16576 0ustar00rootroot000000000000Mail-MtPolicyd-2.05/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 40313720747620 16576 0ustar00rootroot000000000000Mail-MtPolicyd-2.05/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 152613720747620 17055 0ustar00rootroot000000000000Mail-MtPolicyd-2.05version: '2' services: mtpolicyd: build: context: . ports: - "12345:12345" volumes: - ".:/mtpolicyd" links: - memcached - openldap - mariadb memcached: image: memcached openldap: image: osixia/openldap:1.3.0 container_name: openldap environment: LDAP_ORGANISATION: "Example Company" LDAP_DOMAIN: "example.org" LDAP_ADMIN_PASSWORD: "admin" LDAP_CONFIG_PASSWORD: "config" volumes: - "ldap_config:/etc/ldap/slapd.d" - "ldap_data:/var/lib/ldap" mariadb: image: mariadb restart: always environment: MYSQL_ROOT_PASSWORD: secret MYSQL_USER: mtpolicyd MYSQL_PASSWORD: secret MYSQL_DATABASE: mtpolicyd volumes: - "mariadb_data:/var/lib/mysql" volumes: ldap_config: ldap_data: mariadb_data: policyd-client100755000000000000 301213720747620 17025 0ustar00rootroot000000000000Mail-MtPolicyd-2.05/bin#!/usr/bin/env perl use strict; use warnings; our $VERSION = '2.05'; # 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.05 =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 plugin-ctiprep.t100755000000000000 537313720747620 17021 0ustar00rootroot000000000000Mail-MtPolicyd-2.05/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 476013720747620 17045 0ustar00rootroot000000000000Mail-MtPolicyd-2.05/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 227513720747620 17012 0ustar00rootroot000000000000Mail-MtPolicyd-2.05/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' ); mtpolicyd.conf100644000000000000 1113213720747620 17060 0ustar00rootroot000000000000Mail-MtPolicyd-2.05/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 rpm000755000000000000 013720747620 14052 5ustar00rootroot000000000000Mail-MtPolicyd-2.05mtpolicyd.spec100644000000000000 551613720747620 17101 0ustar00rootroot000000000000Mail-MtPolicyd-2.05/rpm%define module_name Mail-MtPolicyd Name: mtpolicyd Version: 2.05 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.05 - generate spec file from upstream release plugin-greylist.t100755000000000000 671613720747620 17217 0ustar00rootroot000000000000Mail-MtPolicyd-2.05/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 253213720747620 17123 0ustar00rootroot000000000000Mail-MtPolicyd-2.05/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"; t-data000755000000000000 013720747620 14426 5ustar00rootroot000000000000Mail-MtPolicyd-2.05minimal.conf100755000000000000 112613720747620 17066 0ustar00rootroot000000000000Mail-MtPolicyd-2.05/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-condition.t100755000000000000 422613720747620 17335 0ustar00rootroot000000000000Mail-MtPolicyd-2.05/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' ); Mail000755000000000000 013720747620 14704 5ustar00rootroot000000000000Mail-MtPolicyd-2.05/libMtPolicyd.pm100644000000000000 2700013720747620 17325 0ustar00rootroot000000000000Mail-MtPolicyd-2.05/lib/Mailpackage Mail::MtPolicyd; use strict; use warnings; use base qw(Net::Server::PreFork); our $VERSION = '2.05'; # 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.05 =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-regex-list.t100755000000000000 322613720747620 17431 0ustar00rootroot000000000000Mail-MtPolicyd-2.05/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'; plugin-postfixmap.t100755000000000000 525313720747620 17542 0ustar00rootroot000000000000Mail-MtPolicyd-2.05/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 324613720747620 17560 0ustar00rootroot000000000000Mail-MtPolicyd-2.05/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; mtpolicyd.crontab100644000000000000 45513720747620 17531 0ustar00rootroot000000000000Mail-MtPolicyd-2.05/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 author-pod-syntax.t100644000000000000 45413720747620 17435 0ustar00rootroot000000000000Mail-MtPolicyd-2.05/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 276313720747620 17630 0ustar00rootroot000000000000Mail-MtPolicyd-2.05/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' ); ldap000755000000000000 013720747620 16012 5ustar00rootroot000000000000Mail-MtPolicyd-2.05/examplesREADME.md100644000000000000 1650413720747620 17457 0ustar00rootroot000000000000Mail-MtPolicyd-2.05/examples/ldap# A case study over LDAP, Postfix and MtPolicyd ## Abstract With MtPolicyd you can use LDAP to profile your accounts with policies. For instance, for each **account** you can set a number of maximum message rate (for single message, or message x recipient), or a size rate too. We see how to implement these policies per account with a working example. Suitable for a large environment. ## Requisite Many email service implementations adopt LDAP as a DB to profile user preferences, SMTP routing information and authentication. You should have an LDAP server (ldap.example.com) with email account like this: ``` dn: uid=account@example.com,[base dn] objectClass: top objectClass: person objectClass: organizationalPerson objectClass: inetOrgPerson objectClass: mailRecipient objectClass: inetMailUser mailAlternateAddress: alias@example.com mail: account@example.com mailDeliveryOption: mailbox uid: account@example.com userPassword: mypassword cn: Account name mailUserStatus: active sn: Account mailHost: imapserver.example.com ``` In this example the uid is the `sasl_username` used by Postfix to authenticate and authorize the account to send mail. You can build this authentication process using saslauthd over LDAP mechanism, for instance. Here we don't explain how to implement authentication, other SMTP routing mechanism or email aliases over LDAP. Anyway, let suppose the above entry is a working LDAP account used for SMTP authentication. You can imagine other policies for _client_address_ or other keys too, using different Postfix _context_. This is not the scope of this document. Postfix, Mtpolicyd and the LDAP server could stay on different hosts. All of them can interface each other through TCP sockets. For instance you can install * MtPolicyd on mtpolicyd.example.com * Postfix on postfix.example.com * Directory Server on ldap.example.com ## Configure As you can see in [Plugin Accounting](http://search.cpan.org/~benning/Mail-MtPolicyd-1.16/lib/Mail/MtPolicyd/Plugin/Accounting.pm), we have four counters for each key. Our key will be `sasl_username`, because we want policies per account. So we first have to declare a schema for the LDAP server. Mtpolicyd doesn't provide an official schema. Here you can find a schema useful for the result we want achieve in this case. The schema works with Red Hat/Fedora Directory Server, but with little adjustment probably can work with OpenLDAP or other Directory Servers which support custom, **unofficial OIDs**. This unofficial schema provides the attributes for the four counters: * mtpolicydMailMessageLimit * mtpolicydMailRecipientLimit * mtpolicydMailSizeLimit * mtpolicydMailSizeRecipientLimit These attributes comes with the objectClass * mtpolicyd which extend the objectclass "mailRecipient". This choice is not mandatory, you can change it if you don't like it. Once you have extended the schema, our LDAP entry can be profiled for MtPolicyd. For instance we can choose to limit the account "account@example.com" to send a maximum of 100 mails per time unit. To achieve this the entry is: ``` dn: uid=account@example.com,[base dn] mtpolicydMailMessageLimit: 100 objectClass: top objectClass: person objectClass: organizationalPerson objectClass: inetOrgPerson objectClass: mailRecipient objectClass: inetMailUser objectClass: mtpolicyd mailAlternateAddress: alias@example.com mail: account@example.com mailDeliveryOption: mailbox uid: account@example.com userPassword: mypassword cn: Account name mailUserStatus: active sn: Account mailHost: imapserver.example.com ``` We could also set the `mtpolicydMailRecipientLimit` attribute and configure MtPolicyd to refuse the mails if at least one counter triggers the threshold defined in the LDAP attribute. So, here is the complete MtPolicyd virtual host: ``` vhost_by_policy_context=1 name="accounting" module="LdapUserConfig" basedn="[base dn]" # sasl_username attribute is uid. filter_field="sasl_username" filter="(&(uid=%s)(objectClass=mailRecipient)(objectclass=mtpolicyd)(mailUserStatus=active))" # copy these fields to current mtpolicyd session config_fields="mtpolicydMailMessageLimit,mtpolicydMailRecipientLimit" module = "Quota" time_pattern = "%Y-%m-%d" field = "sasl_username" metric = "count" threshold = 500 # if this field is set it will overwrite the default threshold uc_threshold = "mtpolicydMailMessageLimit" # for MSA you may reject, for MTAs you may defer action = "reject you exceeded your daily message limit" module = "Quota" time_pattern = "%Y-%m-%d" field = "sasl_username" metric = "count_rcpt" threshold = 5000 # if this field is set it will overwrite the default threshold uc_threshold = "mtpolicydMailRecipientLimit" # for MSA you may reject, for MTAs you may defer action = "reject you exceeded your daily mail recipient limit" module = "Accounting" fields = "sasl_username" # Perform day based limit time_pattern = "%Y-%m-%d" ``` To understand how it works, we strongly suggest to read the [How to Accounting Quota CookBook](https://metacpan.org/pod/release/BENNING/Mail-MtPolicyd-2.03/lib/Mail/MtPolicyd/Cookbook/HowtoAccountingQuota.pod). In this example the rate time unit is _day_, but you can configure hours or other just setting the proper `time_pattern`. ### Postfix interface This is very simple. The main.cf of the Postfix server can be configured with ``` smtpd_end_of_data_restrictions = check_policy_service { inet:mtpolicyd.example.com:12345, policy_context=accounting } ``` ### LDAP connection This is an example for the LDAP connection: ``` module = "Ldap" host = "ldap.example.com" port = 389 timeout = 20 binddn = "uid=mtpolicyd,ou=admins,[base dn]" password = "mtpolicyd" starttls = 0 ``` Don't worry if connections between MtPolicyd and LDAP server die. MtPolicyd checks if the connection is alive. If the connection dies, MtPolicyd tries to renegotiate it. This behavior has tested with load balancer and LDAP server which expires idle sessions. The user _mtpolicyd_ can be: ``` dn: uid=mtpolicyd,ou=admins,[base dn] uid: mtpolicyd givenName: Mail Team objectClass: top objectClass: person objectClass: organizationalPerson objectClass: inetorgperson sn: Policyd cn: Mail Team Policyd userPassword: mtpolicyd ``` Remember to set a Password Policy which doesn't expire the password of the user mtpolicyd. On [base dn], or where mail accounts stay, you can set an aci: ``` aci: (targetattr = "objectClass || mtpolicydMailSizeLimit || uid || mtpolicydM ailSizeRecipientLimit || mtpolicydMailMessageLimit || mailUserStatus || mtpol icydMailRecipientLimit") (target = "ldap:///[base dn]") (targetfilter = objectclass=mtpolicyd) (version 3.0;acl "Allow MtPolicyd access ";allow (read,compare,search)(userdn = "ldap:///uid=mtpolicyd,ou=admins,[base dn]");) ``` This aci limits what user mtpolicyd can perform over LDAP data. But you can imagine more complex situations, where an aci time-defined can enforce a policy only during a specific time interval, such as night hours or weekend. ## The complete example * [LDAP schema](97mtpolicyd.ldif) * [a complete mtpolicyd.conf example](mtpolicyd.conf) plugin-sqluserconfig.t100755000000000000 323713720747620 20234 0ustar00rootroot000000000000Mail-MtPolicyd-2.05/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 73213720747620 20150 0ustar00rootroot000000000000Mail-MtPolicyd-2.05/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-sa-awl-action.t100755000000000000 421513720747620 20004 0ustar00rootroot000000000000Mail-MtPolicyd-2.05/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 374413720747620 20046 0ustar00rootroot000000000000Mail-MtPolicyd-2.05/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-role-sqlutils.t100755000000000000 775013720747620 20173 0ustar00rootroot000000000000Mail-MtPolicyd-2.05/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 336213720747620 20357 0ustar00rootroot000000000000Mail-MtPolicyd-2.05/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 $? plugin-ldapuserconfig.t100755000000000000 331213720747620 20347 0ustar00rootroot000000000000Mail-MtPolicyd-2.05/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'); spamhaus-rbls.conf100755000000000000 360513720747620 20225 0ustar00rootroot000000000000Mail-MtPolicyd-2.05/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%" execute-cucumber-tests.t100644000000000000 70613720747620 20434 0ustar00rootroot000000000000Mail-MtPolicyd-2.05/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 1266313720747620 20654 0ustar00rootroot000000000000Mail-MtPolicyd-2.05/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 013720747620 16610 5ustar00rootroot000000000000Mail-MtPolicyd-2.05/lib/MailPlugin.pm100644000000000000 315713720747620 20552 0ustar00rootroot000000000000Mail-MtPolicyd-2.05/lib/Mail/MtPolicydpackage Mail::MtPolicyd::Plugin; use Moose; use namespace::autoclean; our $VERSION = '2.05'; # 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.05 =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 Client.pm100644000000000000 537213720747620 20533 0ustar00rootroot000000000000Mail-MtPolicyd-2.05/lib/Mail/MtPolicydpackage Mail::MtPolicyd::Client; use Moose; our $VERSION = '2.05'; # 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.05 =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 Result.pm100644000000000000 243513720747620 20570 0ustar00rootroot000000000000Mail-MtPolicyd-2.05/lib/Mail/MtPolicydpackage Mail::MtPolicyd::Result; use Moose; use namespace::autoclean; our $VERSION = '2.05'; # 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.05 =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 542513720747620 21033 0ustar00rootroot000000000000Mail-MtPolicyd-2.05/examples/ldap# Configuration for the mailteam policy daemon user=mtpolicyd group=mtpolicyd # 0=>'err', 1=>'warning', 2=>'notice', 3=>'info', 4=>'debug' (default: 2) log_level=2 host=10.10.10.10 port="10.10.10.10: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 vhost_by_policy_context=1 module = "Memcached" servers = "127.0.0.1:11211" # namespace = "mt-" # mysql for storing accounting tables module = "Sql" # see perldoc DBI for syntax of dsn connection string dsn = "dbi:mysql:database=mailpolicy;host=localhost;port=3306" user = "mtpolicyd" password = "mysqlpassword" # ldap with user configuration module = "Ldap" host = "ldap.example.com" port = 389 timeout = 20 binddn = "uid=mtpolicyd,o=admins,c=en" password = "ldappassword" starttls = 0 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="accounting" module="LdapUserConfig" basedn="c=en" # sasl_username attribute is uid. filter_field="sasl_username" filter="(&(uid=%s)(objectClass=mailRecipient)(objectclass=mtpolicyd)(mailUserStatus=active))" # copy these fields to current mtpolicyd session config_fields="mtpolicydMailMessageLimit,mtpolicydMailRecipientLimit" module = "Quota" time_pattern = "%Y-%m-%d" field = "sasl_username" metric = "count" threshold = 500 # if this field is set it will overwrite the default threshold uc_threshold = "mtpolicydMailMessageLimit" # for MSA you may reject, for MTAs you may defer action = "reject you exceeded your daily message limit" module = "Quota" time_pattern = "%Y-%m-%d" field = "sasl_username" metric = "count_rcpt" threshold = 5000 # if this field is set it will overwrite the default threshold uc_threshold = "mtpolicydMailRecipientLimit" # for MSA you may reject, for MTAs you may defer action = "reject you exceeded your daily mail recipient limit" module = "Accounting" fields = "sasl_username" # Perform day based limit time_pattern = "%Y-%m-%d" Request.pm100644000000000000 1402613720747620 20761 0ustar00rootroot000000000000Mail-MtPolicyd-2.05/lib/Mail/MtPolicydpackage Mail::MtPolicyd::Request; use Moose; use namespace::autoclean; use Mail::MtPolicyd::Plugin::Result; our $VERSION = '2.05'; # 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.05 =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 330713720747620 21073 0ustar00rootroot000000000000Mail-MtPolicyd-2.05/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.05'; # 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.05 =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 362513720747620 21327 0ustar00rootroot000000000000Mail-MtPolicyd-2.05/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 97mtpolicyd.ldif100644000000000000 273013720747620 21200 0ustar00rootroot000000000000Mail-MtPolicyd-2.05/examples/ldapdn: cn=schema #Attributes # attributeTypes: ( mtpolicydMailMessageLimit-oid NAME ( 'mtpolicydMailMessageLimit' ) DESC 'MtPolicyd user defined attribute for enable accounting over count messages' EQUALITY integerOrderingMatch SYNTAX 1.3.6.1.4.1.1466.115.121.1.27 SINGLE-VALUE X-ORIGIN 'MtPolicyd' ) attributeTypes: ( mtpolicydMailRecipientLimit-oid NAME ( 'mtpolicydMailRecipientLimit' ) DESC 'MtPolicyd user defined attribute for enable accounting over recipient count messages' EQUALITY integerOrderingMatch SYNTAX 1.3.6.1.4.1.1466.115.121.1.27 SINGLE-VALUE X-ORIGIN 'MtPolicyd' ) attributeTypes: ( mtpolicydMailSizeLimit-oid NAME ( 'mtpolicydMailSizeLimit' ) DESC 'MtPolicyd user defined attribute for enable accounting over size limit' EQUALITY integerOrderingMatch SYNTAX 1.3.6.1.4.1.1466.115.121.1.27 SINGLE-VALUE X-ORIGIN 'MtPolicyd' ) attributeTypes: ( mtpolicydMailSizeRecipientLimit-oid NAME ( 'mtpolicydMailSizeRecipientLimit' ) DESC 'MtPolicyd user defined attribute for enable accounting over size x recipient limit' EQUALITY integerOrderingMatch SYNTAX 1.3.6.1.4.1.1466.115.121.1.27 SINGLE-VALUE X-ORIGIN 'MtPolicyd' ) # # #Objectclasses objectclasses: ( mtpolicyd-oid NAME 'mtpolicyd' DESC 'mtPolicyd class for user level configuration' SUP mailRecipient AUXILIARY MUST ( ) MAY ( mtpolicydMailMessageLimit $ mtpolicydMailRecipientLimit $ mtpolicydMailSizeLimit $ mtpolicydMailSizeRecipientLimit ) X-ORIGIN 'MtPolicyd' ) Cookbook.pod100644000000000000 214113720747620 21220 0ustar00rootroot000000000000Mail-MtPolicyd-2.05/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.05 =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 136713720747620 21414 0ustar00rootroot000000000000Mail-MtPolicyd-2.05/lib/Mail/MtPolicydpackage Mail::MtPolicyd::Connection; use Moose; our $VERSION = '2.05'; # 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.05 =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 013720747620 20026 5ustar00rootroot000000000000Mail-MtPolicyd-2.05/lib/Mail/MtPolicydApp.pm100644000000000000 412213720747620 21243 0ustar00rootroot000000000000Mail-MtPolicyd-2.05/lib/Mail/MtPolicyd/Clientpackage Mail::MtPolicyd::Client::App; use Moose; our $VERSION = '2.05'; # 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.05 =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 013720747620 20046 5ustar00rootroot000000000000Mail-MtPolicyd-2.05/lib/Mail/MtPolicydDBL.pm100644000000000000 1214113720747620 21164 0ustar00rootroot000000000000Mail-MtPolicyd-2.05/lib/Mail/MtPolicyd/Pluginpackage Mail::MtPolicyd::Plugin::DBL; use Moose; use namespace::autoclean; our $VERSION = '2.05'; # 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.05 =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 SPF.pm100644000000000000 2772613720747620 21232 0ustar00rootroot000000000000Mail-MtPolicyd-2.05/lib/Mail/MtPolicyd/Pluginpackage Mail::MtPolicyd::Plugin::SPF; use Moose; use namespace::autoclean; our $VERSION = '2.05'; # 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 'max_dns_interactive_terms' => (is => 'rw', isa => 'Maybe[Num]', default => 10); has 'max_name_lookups_per_term' => (is => 'rw', isa => 'Maybe[Num]', default => 10); has 'max_void_dns_lookups' => (is => 'rw', isa => 'Maybe[Num]', default => 2); has 'temperror_score' => ( is => 'rw', isa => 'Maybe[Num]' ); has 'temperror_mode' => ( is => 'rw', isa => 'Str', default => 'defer'); has 'permerror_score' => ( is => 'rw', isa => 'Maybe[Num]' ); has 'permerror_mode' => ( is => 'rw', isa => 'Str', default => 'reject'); 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, max_dns_interactive_terms => $self->max_dns_interactive_terms, max_name_lookups_per_term => $self->max_name_lookups_per_term, max_void_dns_lookups => $self->max_void_dns_lookups, ); }, ); 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; } elsif($result->code eq 'temperror') { return $self->_handle_spf_error( $r, $result, $self->temperror_mode, $self->temperror_score, 'defer' ); } elsif($result->code eq 'permerror') { return $self->_handle_spf_error( $r, $result, $self->permerror_mode, $self->permerror_score, 'reject' ); } $self->log( $r, 'spf '.$scope.' check failed: '.$result->local_explanation ); return; } sub _handle_spf_error { my ($self, $r, $result, $mode, $score, $action) = @_; my $scope = $result->request->scope; $self->log($r, 'SPF '.$scope.' failed with '.$result->code.' '.$result->local_explanation); if( defined $score && ! $r->is_already_done($self->name.'-score') ) { $self->add_score( $r, $self->name => $score ); } if($mode eq 'passive') { return; } if ( $self->temperror_mode eq 'dunno') { return Mail::MtPolicyd::Plugin::Result->new_dunno; } return Mail::MtPolicyd::Plugin::Result->new( action => $action.' spf '.${scope}.' check failed: '.$result->local_explanation, abort => 1, ); } 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.05 =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) =item temperror (temperror_mode, default: defer) =item permerror (permerror_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 temperror_mode (default: defer) Action to apply on a temperror SPF result. Possible values: passive, dunno, defer, reject =item temperror_score (default: empty) Score to apply on a temperror SPF result. By default no score is applied. =item permerror_mode (default: reject) Action to apply on a permerror SPF result. Possible values: passive, dunno, defer, reject =item permerror_score (default: empty) Score to apply on a permerror SPF result. By default no score is applied. =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. =item max_dns_interactive_terms (default: 10) Maximum number of terms using DNS lookup in a SPF record to evaluate. Exceeding this limit will cause a permanent error as specified by RFC7208. The default of 10 is also specified in by RFC7208. =item max_name_lookups_per_term (default: 10) Maximum number of DNS lookups per SPF term. =item max_void_dns_lookups (default: 2) Maximum number of void DNS lookups. =back =head1 EXAMPLE module = "SPF" pass_mode = passive pass_score = -10 fail_mode = reject #fail_score = 10 =head1 SEE ALSO L, OpenSPF L, RFC 7208 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 RBL.pm100644000000000000 675313720747620 21176 0ustar00rootroot000000000000Mail-MtPolicyd-2.05/lib/Mail/MtPolicyd/Pluginpackage Mail::MtPolicyd::Plugin::RBL; use Moose; use namespace::autoclean; our $VERSION = '2.05'; # 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.05 =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 plugin-postfixmap-postmap100755000000000000 26413720747620 21645 0ustar00rootroot000000000000Mail-MtPolicyd-2.05/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 VirtualHost.pm100644000000000000 244513720747620 21577 0ustar00rootroot000000000000Mail-MtPolicyd-2.05/lib/Mail/MtPolicydpackage Mail::MtPolicyd::VirtualHost; use Moose; use namespace::autoclean; our $VERSION = '2.05'; # 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.05 =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 AddressList.pm100644000000000000 506213720747620 21532 0ustar00rootroot000000000000Mail-MtPolicyd-2.05/lib/Mail/MtPolicydpackage Mail::MtPolicyd::AddressList; use Moose; use namespace::autoclean; our $VERSION = '2.05'; # 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.05 =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 650513720747620 21515 0ustar00rootroot000000000000Mail-MtPolicyd-2.05/lib/Mail/MtPolicydpackage Mail::MtPolicyd::PluginChain; use Moose; use namespace::autoclean; our $VERSION = '2.05'; # 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.05 =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 322413720747620 21434 0ustar00rootroot000000000000Mail-MtPolicyd-2.05/lib/Mail/MtPolicyd/Pluginpackage Mail::MtPolicyd::Plugin::Eval; use Moose; use namespace::autoclean; our $VERSION = '2.05'; # 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.05 =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 310513720747620 21654 0ustar00rootroot000000000000Mail-MtPolicyd-2.05/lib/Mail/MtPolicydpackage Mail::MtPolicyd::SessionCache; use Moose; our $VERSION = '2.05'; # 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.05 =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 414313720747620 21667 0ustar00rootroot000000000000Mail-MtPolicyd-2.05/lib/Mail/MtPolicyd/Pluginpackage Mail::MtPolicyd::Plugin::Proxy; use Moose; use namespace::autoclean; our $VERSION = '2.05'; # 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.05 =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 1161213720747620 21656 0ustar00rootroot000000000000Mail-MtPolicyd-2.05/lib/Mail/MtPolicyd/Pluginpackage Mail::MtPolicyd::Plugin::Quota; use Moose; use namespace::autoclean; our $VERSION = '2.05'; # 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.05 =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 345413720747620 22137 0ustar00rootroot000000000000Mail-MtPolicyd-2.05/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 013720747620 17065 5ustar00rootroot000000000000Mail-MtPolicyd-2.05/tclient_steps.pl100644000000000000 222013720747620 22252 0ustar00rootroot000000000000Mail-MtPolicyd-2.05/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 226513720747620 21766 0ustar00rootroot000000000000Mail-MtPolicyd-2.05/lib/Mail/MtPolicyd/Pluginpackage Mail::MtPolicyd::Plugin::Action; use Moose; use namespace::autoclean; our $VERSION = '2.05'; # 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.05 =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 221013720747620 22015 0ustar00rootroot000000000000Mail-MtPolicyd-2.05/lib/Mail/MtPolicyd/Pluginpackage Mail::MtPolicyd::Plugin::Result; use Moose; use namespace::autoclean; our $VERSION = '2.05'; # 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.05 =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 402013720747620 22023 0ustar00rootroot000000000000Mail-MtPolicyd-2.05/lib/Mail/MtPolicyd/Pluginpackage Mail::MtPolicyd::Plugin::Stress; use Moose; use namespace::autoclean; our $VERSION = '2.05'; # 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.05 =head1 DESCRIPTION Will return an action or execute further 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 further tests. You may want to do some white listing 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 3000013720747620 22260 0ustar00rootroot000000000000Mail-MtPolicyd-2.05/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 175113720747620 22176 0ustar00rootroot000000000000Mail-MtPolicyd-2.05/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 412413720747620 22240 0ustar00rootroot000000000000Mail-MtPolicyd-2.05/lib/Mail/MtPolicydpackage Mail::MtPolicyd::ConnectionPool; use strict; use warnings; use MooseX::Singleton; our $VERSION = '2.05'; # 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.05 =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 515313720747620 22160 0ustar00rootroot000000000000Mail-MtPolicyd-2.05/lib/Mail/MtPolicyd/Clientpackage Mail::MtPolicyd::Client::Request; use Moose; our $VERSION = '2.05'; # 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.05 =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 013720747620 20707 5ustar00rootroot000000000000Mail-MtPolicyd-2.05/lib/Mail/MtPolicydSql.pm100644000000000000 361213720747620 22146 0ustar00rootroot000000000000Mail-MtPolicyd-2.05/lib/Mail/MtPolicyd/Connectionpackage Mail::MtPolicyd::Connection::Sql; use Moose; extends 'Mail::MtPolicyd::Connection'; # ABSTRACT: Connection pool sql connection object our $VERSION = '2.05'; # 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.05 =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 SqlList.pm100644000000000000 1131113720747620 22154 0ustar00rootroot000000000000Mail-MtPolicyd-2.05/lib/Mail/MtPolicyd/Pluginpackage Mail::MtPolicyd::Plugin::SqlList; use Moose; use namespace::autoclean; our $VERSION = '2.05'; # 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]' ); has 'field' => (is => 'rw', isa => 'Str', default => 'client_address'); with 'Mail::MtPolicyd::Role::Connection' => { name => 'db', type => 'Sql', }; with 'Mail::MtPolicyd::Plugin::Role::SqlUtils'; sub _query_db { my ( $self, $value ) = @_; return $self->execute_sql($self->sql_query, $value)->fetchrow_array; } sub run { my ( $self, $r ) = @_; my $value = $r->attr($self->field); my $session = $r->session; my $config; if( $self->get_uc( $session, 'enabled') eq 'off' ) { return; } if( ! defined $value) { $self->log($r, 'no attribute \''.$self->field.'\' in request'); return; } my $result = $r->do_cached( $self->name.'-result', sub { $self->_query_db($value) } ); if( $result ) { $self->log($r, $self->field.' '.$value.' 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, $self->field.' '.$value.' 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.05 =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 a field against a SQL table/query. Depending on whether 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. =item field (default: client_address) The field the query parameter will be taken from. =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 CtIpRep.pm100644000000000000 1270213720747620 22074 0ustar00rootroot000000000000Mail-MtPolicyd-2.05/lib/Mail/MtPolicyd/Pluginpackage Mail::MtPolicyd::Plugin::CtIpRep; use Moose; use namespace::autoclean; our $VERSION = '2.05'; # 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.05 =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 specify 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 specify a custom message is a message is to be deferred. =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 Profiler000755000000000000 013720747620 20372 5ustar00rootroot000000000000Mail-MtPolicyd-2.05/lib/Mail/MtPolicydTimer.pm100644000000000000 407713720747620 22160 0ustar00rootroot000000000000Mail-MtPolicyd-2.05/lib/Mail/MtPolicyd/Profilerpackage Mail::MtPolicyd::Profiler::Timer; use Moose; use namespace::autoclean; our $VERSION = '2.05'; # 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.05 =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 451013720747620 22322 0ustar00rootroot000000000000Mail-MtPolicyd-2.05/lib/Mail/MtPolicyd/Clientpackage Mail::MtPolicyd::Client::Response; use Moose; our $VERSION = '2.05'; # 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.05 =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 response. =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 665313720747620 22277 0ustar00rootroot000000000000Mail-MtPolicyd-2.05/lib/Mail/MtPolicyd/Connectionpackage Mail::MtPolicyd::Connection::Ldap; use Moose; extends 'Mail::MtPolicyd::Connection'; # ABSTRACT: a LDAP connection plugin for mtpolicyd our $VERSION = '2.05'; # 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.05 =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 Role000755000000000000 013720747620 17511 5ustar00rootroot000000000000Mail-MtPolicyd-2.05/lib/Mail/MtPolicydConnection.pm100644000000000000 317713720747620 22316 0ustar00rootroot000000000000Mail-MtPolicyd-2.05/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.05'; # 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.05 =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 1177313720747620 22402 0ustar00rootroot000000000000Mail-MtPolicyd-2.05/lib/Mail/MtPolicyd/Pluginpackage Mail::MtPolicyd::Plugin::Honeypot; use Moose; use namespace::autoclean; our $VERSION = '2.05'; # 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.05 =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 217213720747620 22245 0ustar00rootroot000000000000Mail-MtPolicyd-2.05/lib/Mail/MtPolicyd/Pluginpackage Mail::MtPolicyd::Plugin::SetField; use Moose; use namespace::autoclean; our $VERSION = '2.05'; # 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.05 =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 Fail2Ban.pm100644000000000000 704413720747620 22127 0ustar00rootroot000000000000Mail-MtPolicyd-2.05/lib/Mail/MtPolicyd/Pluginpackage Mail::MtPolicyd::Plugin::Fail2Ban; use Moose; use namespace::autoclean; our $VERSION = '2.05'; # 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.05 =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 Greylist.pm100644000000000000 2305213720747620 22370 0ustar00rootroot000000000000Mail-MtPolicyd-2.05/lib/Mail/MtPolicyd/Pluginpackage Mail::MtPolicyd::Plugin::Greylist; use Moose; use namespace::autoclean; our $VERSION = '2.05'; # 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.05 =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 deferred 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 time stamp 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 deferred. 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 Redis.pm100644000000000000 566213720747620 22464 0ustar00rootroot000000000000Mail-MtPolicyd-2.05/lib/Mail/MtPolicyd/Connectionpackage Mail::MtPolicyd::Connection::Redis; use Moose; our $VERSION = '2.05'; # 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.05 =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 1215413720747620 22515 0ustar00rootroot000000000000Mail-MtPolicyd-2.05/lib/Mail/MtPolicyd/Pluginpackage Mail::MtPolicyd::Plugin::Condition; use Moose; use namespace::autoclean; our $VERSION = '2.05'; # 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.05 =head1 DESCRIPTION Will return an action, score or execute further 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 then 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 RegexList.pm100644000000000000 1145413720747620 22477 0ustar00rootroot000000000000Mail-MtPolicyd-2.05/lib/Mail/MtPolicyd/Pluginpackage Mail::MtPolicyd::Plugin::RegexList; use Moose; use namespace::autoclean; our $VERSION = '2.05'; # 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.05 =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 RBLAction.pm100644000000000000 1042513720747620 22343 0ustar00rootroot000000000000Mail-MtPolicyd-2.05/lib/Mail/MtPolicyd/Pluginpackage Mail::MtPolicyd::Plugin::RBLAction; use Moose; use namespace::autoclean; our $VERSION = '2.05'; # 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.05 =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 SessionCache000755000000000000 013720747620 21157 5ustar00rootroot000000000000Mail-MtPolicyd-2.05/lib/Mail/MtPolicydBase.pm100644000000000000 142213720747620 22526 0ustar00rootroot000000000000Mail-MtPolicyd-2.05/lib/Mail/MtPolicyd/SessionCachepackage Mail::MtPolicyd::SessionCache::Base; use Moose; our $VERSION = '2.05'; # 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.05 =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 112213720747620 22550 0ustar00rootroot000000000000Mail-MtPolicyd-2.05/lib/Mail/MtPolicyd/SessionCachepackage Mail::MtPolicyd::SessionCache::None; use Moose; our $VERSION = '2.05'; # 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.05 =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 1163713720747620 22666 0ustar00rootroot000000000000Mail-MtPolicyd-2.05/lib/Mail/MtPolicyd/Pluginpackage Mail::MtPolicyd::Plugin::PostfixMap; use Moose; use namespace::autoclean; our $VERSION = '2.05'; # 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.05 =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 2136713720747620 22545 0ustar00rootroot000000000000Mail-MtPolicyd-2.05/lib/Mail/MtPolicyd/Pluginpackage Mail::MtPolicyd::Plugin::SMTPVerify; use Moose; use namespace::autoclean; our $VERSION = '2.05'; # 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.05 =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 receive 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 returns 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 recipient 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 1724013720747620 22662 0ustar00rootroot000000000000Mail-MtPolicyd-2.05/lib/Mail/MtPolicyd/Pluginpackage Mail::MtPolicyd::Plugin::Accounting; use Moose; use namespace::autoclean; our $VERSION = '2.05'; # 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.05 =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 Redis.pm100644000000000000 623213720747620 22726 0ustar00rootroot000000000000Mail-MtPolicyd-2.05/lib/Mail/MtPolicyd/SessionCachepackage Mail::MtPolicyd::SessionCache::Redis; use Moose; our $VERSION = '2.05'; # 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.05 =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 ClearFields.pm100644000000000000 435013720747620 22723 0ustar00rootroot000000000000Mail-MtPolicyd-2.05/lib/Mail/MtPolicyd/Pluginpackage Mail::MtPolicyd::Plugin::ClearFields; use Moose; use namespace::autoclean; our $VERSION = '2.05'; # 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.05 =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 ScoreAction.pm100644000000000000 642413720747620 22763 0ustar00rootroot000000000000Mail-MtPolicyd-2.05/lib/Mail/MtPolicyd/Pluginpackage Mail::MtPolicyd::Plugin::ScoreAction; use Moose; use namespace::autoclean; our $VERSION = '2.05'; # 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.05 =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 SaAwlAction.pm100644000000000000 1564613720747620 22745 0ustar00rootroot000000000000Mail-MtPolicyd-2.05/lib/Mail/MtPolicyd/Pluginpackage Mail::MtPolicyd::Plugin::SaAwlAction; use Moose; use namespace::autoclean; our $VERSION = '2.05'; # 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.05 =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 GeoIPLookup.pm100644000000000000 364513720747620 22711 0ustar00rootroot000000000000Mail-MtPolicyd-2.05/lib/Mail/MtPolicyd/Pluginpackage Mail::MtPolicyd::Plugin::GeoIPLookup; use Moose; use namespace::autoclean; our $VERSION = '2.05'; # 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.05 =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 SaAwlLookup.pm100644000000000000 655313720747620 22756 0ustar00rootroot000000000000Mail-MtPolicyd-2.05/lib/Mail/MtPolicyd/Pluginpackage Mail::MtPolicyd::Plugin::SaAwlLookup; use Moose; use namespace::autoclean; our $VERSION = '2.05'; # 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.05 =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 GeoIPAction.pm100644000000000000 715313720747620 22653 0ustar00rootroot000000000000Mail-MtPolicyd-2.05/lib/Mail/MtPolicyd/Pluginpackage Mail::MtPolicyd::Plugin::GeoIPAction; use Moose; use namespace::autoclean; our $VERSION = '2.05'; # 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.05 =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 server-vhost-by-policy-context.feature100644000000000000 247213720747620 23277 0ustar00rootroot000000000000Mail-MtPolicyd-2.05/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 013720747620 20747 5ustar00rootroot000000000000Mail-MtPolicyd-2.05/lib/Mail/MtPolicyd/PluginScoring.pm100644000000000000 300713720747620 23051 0ustar00rootroot000000000000Mail-MtPolicyd-2.05/lib/Mail/MtPolicyd/Plugin/Rolepackage Mail::MtPolicyd::Plugin::Role::Scoring; use Moose::Role; our $VERSION = '2.05'; # 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.05 =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 110613720747620 23666 0ustar00rootroot000000000000Mail-MtPolicyd-2.05/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 361713720747620 23262 0ustar00rootroot000000000000Mail-MtPolicyd-2.05/lib/Mail/MtPolicyd/Connectionpackage Mail::MtPolicyd::Connection::Memcached; use Moose; our $VERSION = '2.05'; # 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.05 =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 627713720747620 23304 0ustar00rootroot000000000000Mail-MtPolicyd-2.05/lib/Mail/MtPolicyd/Pluginpackage Mail::MtPolicyd::Plugin::SqlUserConfig; use Moose; use namespace::autoclean; our $VERSION = '2.05'; # 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.05 =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 421513720747620 23227 0ustar00rootroot000000000000Mail-MtPolicyd-2.05/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.05'; # 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.05 =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 013720747620 20356 5ustar00rootroot000000000000Mail-MtPolicyd-2.05/lib/Mail/MtPolicydBasicPlugin.pod100644000000000000 633113720747620 23425 0ustar00rootroot000000000000Mail-MtPolicyd-2.05/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.05 =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 basically 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() every time 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 configuration: 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 LdapUserConfig.pm100644000000000000 760213720747620 23416 0ustar00rootroot000000000000Mail-MtPolicyd-2.05/lib/Mail/MtPolicyd/Pluginpackage Mail::MtPolicyd::Plugin::LdapUserConfig; use Moose; use namespace::autoclean; our $VERSION = '2.05'; # 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.05 =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 AddScoreHeader.pm100644000000000000 440013720747620 23337 0ustar00rootroot000000000000Mail-MtPolicyd-2.05/lib/Mail/MtPolicyd/Pluginpackage Mail::MtPolicyd::Plugin::AddScoreHeader; use Moose; use namespace::autoclean; our $VERSION = '2.05'; # 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.05 =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 Memcached.pm100644000000000000 600613720747620 23525 0ustar00rootroot000000000000Mail-MtPolicyd-2.05/lib/Mail/MtPolicyd/SessionCachepackage Mail::MtPolicyd::SessionCache::Memcached; use Moose; our $VERSION = '2.05'; # 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.05 =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 Installation.pod100644000000000000 655713720747620 23700 0ustar00rootroot000000000000Mail-MtPolicyd-2.05/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.05 =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 236713720747620 23521 0ustar00rootroot000000000000Mail-MtPolicyd-2.05/lib/Mail/MtPolicyd/Plugin/Rolepackage Mail::MtPolicyd::Plugin::Role::UserConfig; use strict; # make critic happy use MooseX::Role::Parameterized; our $VERSION = '2.05'; # 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.05 =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 214313720747620 23646 0ustar00rootroot000000000000Mail-MtPolicyd-2.05/lib/Mail/MtPolicyd/Plugin/Rolepackage Mail::MtPolicyd::Plugin::Role::PluginChain; use Moose::Role; our $VERSION = '2.05'; # 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.05 =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 013720747620 22273 5ustar00rootroot000000000000Mail-MtPolicyd-2.05/lib/Mail/MtPolicyd/Plugin/GreylistSql.pm100644000000000000 641613720747620 23537 0ustar00rootroot000000000000Mail-MtPolicyd-2.05/lib/Mail/MtPolicyd/Plugin/Greylist/AWLpackage Mail::MtPolicyd::Plugin::Greylist::AWL::Sql; use Moose; # ABSTRACT: backend for SQL greylisting awl storage our $VERSION = '2.05'; # 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.05 =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 1145613720747620 24236 0ustar00rootroot000000000000Mail-MtPolicyd-2.05/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 1364713720747620 24174 0ustar00rootroot000000000000Mail-MtPolicyd-2.05/lib/Mail/MtPolicyd/Cookbook# PODNAME: Mail::MtPolicyd::Cookbook::ExtendedModule # ABSTRACT: how to achieve certain tasks within a plugin __END__ =pod =encoding UTF-8 =head1 NAME Mail::MtPolicyd::Cookbook::ExtendedModule - how to achieve certain tasks within a plugin =head1 VERSION version 2.05 =head1 Extending your mtpolicyd plugin How to achieve 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 achieve 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 there's 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 achieve 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 command line 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 207713720747620 23651 0ustar00rootroot000000000000Mail-MtPolicyd-2.05/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.05'; # 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.05 =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 343413720747620 24043 0ustar00rootroot000000000000Mail-MtPolicyd-2.05/lib/Mail/MtPolicyd/Plugin/Greylist/AWLpackage Mail::MtPolicyd::Plugin::Greylist::AWL::Redis; use Moose; # ABSTRACT: backend for redis greylisting awl storage our $VERSION = '2.05'; # 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.05 =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 013720747620 23073 5ustar00rootroot000000000000Mail-MtPolicyd-2.05/lib/Mail/MtPolicyd/Plugin/GreylistBase.pm100644000000000000 243713720747620 24451 0ustar00rootroot000000000000Mail-MtPolicyd-2.05/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.05'; # 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.05 =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 263313720747620 24643 0ustar00rootroot000000000000Mail-MtPolicyd-2.05/lib/Mail/MtPolicyd/Plugin/Greylist/Ticketpackage Mail::MtPolicyd::Plugin::Greylist::Ticket::Redis; use Moose; # ABSTRACT: greylisting ticket storage backend for redis our $VERSION = '2.05'; # 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.05 =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 1352613720747620 25376 0ustar00rootroot000000000000Mail-MtPolicyd-2.05/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.05 =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 373313720747620 25202 0ustar00rootroot000000000000Mail-MtPolicyd-2.05/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.05'; # 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.05 =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 267413720747620 25450 0ustar00rootroot000000000000Mail-MtPolicyd-2.05/lib/Mail/MtPolicyd/Plugin/Greylist/Ticketpackage Mail::MtPolicyd::Plugin::Greylist::Ticket::Memcached; use Moose; # ABSTRACT: greylisting ticket storage backend for memcached our $VERSION = '2.05'; # 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.05 =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