pax_global_header00006660000000000000000000000064117171301540014512gustar00rootroot0000000000000052 comment=8e942a476a2a9e0f19384601c020f59d691070dd sqlgrey-1.8.0/000077500000000000000000000000001171713015400132065ustar00rootroot00000000000000sqlgrey-1.8.0/CONTRIB000066400000000000000000000024071171713015400142340ustar00rootroot00000000000000Several people helped during SQLgrey development: Dan Faerch: - Database clustering (1.7.4) - Regex based Discrimination (1.7.4) - Customizable reject_code (1.7.4) - sqlgrey maintainer for release 1.7.4 (Is now a regular developer of sqlgrey. No need to list more contributions here) Othmar Truniger: - corrected sqlgrey-logstats.pl weekly stats (1.7.4) Corey Sklenicka: - non standard DBMS listening port support (1.7.4) Jeff Rice: - deVERP tuning (especially for bounce/notify messages) (1.7.2), Michael Storz: - deVERP tuning replace recipients in sender address (1.7.2 and 1.7.3) Michel Bouissou: - source IP throttling (tarpitting) (1.7.0), - better connect cleanup when moving entries in AWL (1.7.0), - new 'smart' greylisting algorithm, replacing previous one (1.5.1), - portability fixes in update_sqlgrey_config (1.4.5) - configurable return code (1.4.5) - deVERP and SRS tuning (1.4.5) Rene Joergensen: - better cleanup logging (1.4.2) Øystein Viggen: - fix for startup warning messages (1.4.1) - found an SQL injection vulnerability (fixed in 1.4.0) Derek Battams: - ideas for different greylisting algorithms (implemented in 1.3.6) Klaus Alexander Seistrup: - idea for SQLite support (implemented in 1.1.0) Numerous others helped with great ideas or bug reports. sqlgrey-1.8.0/COPYING000066400000000000000000000431311171713015400142430ustar00rootroot00000000000000 GNU GENERAL PUBLIC LICENSE Version 2, June 1991 Copyright (C) 1989, 1991 Free Software Foundation, Inc. 59 Temple Place, Suite 330, Boston, MA 02111-1307 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 Library 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., 59 Temple Place, Suite 330, Boston, MA 02111-1307 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 Library General Public License instead of this License. sqlgrey-1.8.0/Changelog000066400000000000000000000204241171713015400150220ustar00rootroot00000000000000* Mon Feb 13 2012 Martin Matuska - 1.8.0 release - Allow to specify complete DSN in configuration file - Support listening on UNIX sockets - Support pidfile command line argument * Mon Feb 01 2010 Michal Ludvig - Upgraded VERSION to 1.8.0-rc2 - Reverted GNU sed syntax in Makefile * Sat Jan 23 2010 Michal Ludvig - Upgraded VERSION to 1.8.0-rc1 - 'make dist' now creates sqlgrey-$VERSION.tar.gz with the help of 'git archive' * Mon Aug 17 2009 Michal Ludvig - 1.7.7 release getting ready - Reworked "smart"/"class-c" IPv6 address handling. - Added IPv6 address support for clients_ip_whitelist(.local) file - client_ip_whitelist(.local) now supports address/prefix notation both for IPv4 and IPv6 addresses. * Sun Aug 05 2007 Lionel Bouton - 1.7.6 release - Database handling fix (deactivated InactiveDestroy unless needed) - Reopen database connection on SIGUSR1 * Thu Feb 15 2007 Dan Faerch - 1.7.5 release - Changed db_cleanup. clean time stored in db for better handling, especially in clustered environments - Fix for harmless warnings about "possible typo" - Fix for sqlgrey dying if syslog is offline - Filled feature req from Riaan Kok. Support "postfix attributes on both sides".. Ie: "client_name !~ helo_name" * Sun Aug 03 2006 Dan Faerch - 1.7.4 release - Added feature Discrimination - Added feature DBCluster - Added config option reject_code (eg. answer 451 instead of 450) * Wed Nov 16 2005 Lionel Bouton - 1.7.3 release - fixes for a crash with '*' in email adresses * Tue Oct 25 2005 Lionel Bouton - 1.7.2 release - fixes for several errors in logging - clean_method ported from 1.6.x * Thu Sep 15 2005 Lionel Bouton - 1.7.1 release - fix for a race condition in multiple instances configurations - fix for weekly stats * Tue Jun 21 2005 Lionel Bouton - 1.7.0 release - now continue if the DB isn't available at startup time - based on 1.6.0 with Michel Bouissou's work: . better connect cleanup when creating AWL entries . source IP throttling * Thu Jun 16 2005 Lionel Bouton - 1.6.0 release - fix for alternate conf_dir - fix for timestamp handling in log parser - log parser cleanup - added README.PERF and documentation cleanup * Tue Jun 07 2005 Lionel Bouton - 1.5.9 release - fix for MySQL's mishandling of timestamps - better log parser * Thu Jun 02 2005 Lionel Bouton - 1.5.8 release - fix for Makefile: rpmbuild didn't work * Wed Jun 01 2005 Lionel Bouton - 1.5.7 release - fix for a memory leak - config directory now user-configurable - preliminary log analyser * Mon May 02 2005 Lionel Bouton - 1.5.6 release - fix for MySQL disconnection crash - IPv6 support - Optin/optout support * Tue Apr 25 2005 Lionel Bouton - 1.5.5 release - small fix for SRS (again!) - small fix for deverp code - log types * Tue Mar 15 2005 Lionel Bouton - 1.5.4 release - fix for regexp compilation (regexp in fqdn_whitelists didn't work) * Sat Mar 05 2005 Lionel Bouton - 1.5.3 release - the cleanup is now done in a separate process to avoid stalling the service * Thu Mar 03 2005 Lionel Bouton - 1.5.2 release - optimize SQL queries by avoiding some now() function calls * Wed Mar 02 2005 Lionel Bouton - 1.5.1 release - replaced smart algorithm with Michel Bouissou's one * Wed Feb 23 2005 Lionel Bouton - 1.5.0 release - drop support for obsolete command-line parameters - migrate databases to a new layout : . first_seen added to the AWLs . optimize AWL Primary Keys . add indexes * Mon Feb 21 2005 Lionel Bouton - 1.4.8 release - AWL performance bugfix - bad handling of database init errors fixed * Fri Feb 18 2005 Lionel Bouton - 1.4.7 release - MAIL FROM: <> bugfix * Fri Feb 18 2005 Lionel Bouton - 1.4.6 release - update_sqlgrey_whitelists bugfix - removed superfluous regexp in deVERP code * Thu Feb 17 2005 Lionel Bouton - 1.4.5 release - update_sqlgrey_whitelists temporary directory fixes from Michel Bouissou - return code configurable patch from Michel Bouissou - VERP and SRS tuning, with input from Michel Bouissou - VERP and SRS normalisation is used only in the AWLs * Mon Feb 14 2005 Lionel Bouton - 1.4.4 release - Autowhitelists understand SRS - more VERP support for autowhitelists - SQLgrey can warn by mail when the database is unavailable - update_sqlgrey_whitelists doesn't rely on mktemp's '-t' parameter anymore. * Sun Feb 06 2005 Lionel Bouton - 1.4.3 release - log to stdout when not in daemon mode - added update_sqlgrey_whitelists script whitelists can now be fetched from repositories * Thu Jan 13 2005 Lionel Bouton - 1.4.2 release - Better cleanup logging from Rene Joergensen - Fix for Syslog.pm error messages at init time - Fix doc packaging in RPM * Tue Jan 11 2005 Lionel Bouton - 1.4.1 release - fix for invalid group id messages from Øystein Viggen - allow reloading whitelists with SIGUSR1 - db_maintdelay user-configurable - don't log pid anymore * Fri Dec 10 2004 Lionel Bouton - 1.4.0 release - windows for SQL injection fix (reported by Øystein Viggen) - spec file tuning inspired by Derek Battams * Tue Nov 30 2004 Lionel Bouton - 1.3.6 release - whitelist for FQDN as well as IP - 3 different greylisting algorithms (RFE from Derek Battams) * Mon Nov 22 2004 Lionel Bouton - 1.3.4 release - ip whitelisting * Mon Nov 22 2004 Lionel Bouton - 1.3.3 release - preliminary whitelist support * Wed Nov 17 2004 Lionel Bouton - 1.3.2 release - RPM packaging fixed - DB connection pbs don't crash SQLgrey anymore * Thu Nov 11 2004 Lionel Bouton - 1.3.0 release - Database schema slightly changed, - Automatic database schema upgrade framework * Sun Nov 07 2004 Lionel Bouton - 1.2.0 release - SQL code injection protection - better DBI error reporting - better VERP support - small log related typo fix - code cleanups * Mon Oct 11 2004 Lionel Bouton - 1.1.2 release - pidfile handling code bugfix * Mon Sep 27 2004 Lionel Bouton - 1.1.1 release - MySQL-related SQL syntax bugfix * Tue Sep 21 2004 Lionel Bouton - 1.1.0 release - SQLite support (RFE from Klaus Alexander Seistrup) * Tue Sep 14 2004 Lionel Bouton - 1.0.1 release - man page cleanup * Tue Sep 07 2004 Lionel Bouton - pushed default max-age from 12 to 24 hours * Sat Aug 07 2004 Lionel Bouton - bug fix for space trimming values from database * Tue Aug 03 2004 Lionel Bouton - trim spaces before logging possible spams - v1.0 added license reference at the top at savannah request * Fri Jul 30 2004 Lionel Bouton - Bugfix: couldn't match on undefined sender - debug code added * Fri Jul 30 2004 Lionel Bouton - Removed NetAddr::IP dependency at savannah request * Sat Jul 17 2004 Lionel Bouton - Default max-age pushed to 12 hours instead of 5 (witnessed more than 6 hours for a mailing-list subscription system) * Fri Jul 02 2004 Lionel Bouton - Documentation * Thu Jul 01 2004 Lionel Bouton - PostgreSQL support added * Tue Jun 29 2004 Lionel Bouton - various cleanups and bug hunting * Mon Jun 28 2004 Lionel Bouton - 2-level AWL support * Sun Jun 27 2004 Lionel Bouton - Initial Version, replaced BDB by mysql in postgrey sqlgrey-1.8.0/FAQ000066400000000000000000000042001171713015400135340ustar00rootroot00000000000000##################### ## Database schema ## ##################### * After some time I've noticed entries like this one in my from_awl; -undef- | -undef- | aaa.bbb.ccc.ddd | xxxx-xx-xx xx:xx:xx.xxxxxx This is expected. Mail servers send you e-mail notices when they can't deliver your messages. When doing so, the Return-Path is empty. As at least MySQL doesn't support NULL in PRIMARY KEYs, SQLgrey creates these '-undef- | -undef-' entries to recognise these cases. * Why isn't there any PRIMARY KEY on the connect table ? * Why isn't there an INDEX on the column ? I usually add a PRIMARY KEY to each table where there's a (KEY, VALUE) structure. It's rarely bad for performance and help detect bugs in the way the application layer handles the data. Unfortunately MySQL doesn't support PRIMARY KEYs on columns whose aggregate size is more than 500 bytes : ERROR 1071: Specified key was too long. Max key length is 500 When adding support to PostgreSQL I could have added a PostgreSQL specific PRIMARY KEY. I chose not to because I was not convinced it was a good idea to introduce different database schema depending on the actual database system. There are two indexes on the connect table to speed up the queries: - one on first_seen - one on (src, sender_domain, sender_name) * Postfix starts refusing messages some time after installing SQLgrey, what's going on? That was a common problem with 1.4.x and large installs. The connect table didn't have any index and needed full table scans for most connections. The database was overloaded and SQLgrey couldn't answer in time. If it happens with 1.5.x, you have an unordinary setup (insane trafic and a 386 for the database for example). Look for heavy disk usage, try to tune your database server to allow it to load indexes in RAM and the table itself if needed. In any case, report your problem to sqlgrey-users@lists.sourceforge.net ########## ## Misc ## ########## * Is /var/sqlgrey really necessary ? Wouldn't it be enough to start sqlgrey in /tmp ? /var/sqlgrey is needed for SQLite users. MySQL and PostgreSQL don't need it. Unfortunately there's no way to guess which database will be used. sqlgrey-1.8.0/HOWTO000066400000000000000000000221761171713015400140410ustar00rootroot00000000000000To begin with you need a sqlgrey user : - groupadd sqlgrey - adduser -g sqlgrey sqlgrey ##################### ## Database choice ## ##################### SQLite: quick and dirty way. The database is integrated with sqlgrey. MySQL: lightweight RDBMS, quite fast but not as stable and standard compliant as PostgreSQL. PostgreSQL: full-fledge, very mature RDBMS. ########### ## SQLite # Dependancies: you need the DBD::SQLite perl module (and libsqlite of course). # Howto: Setup /etc/sqlgrey/sqlgrey.conf with db_type = SQLite db_name = # Note: sqlgrey will create the file storing database data in the working directory: launch sqlgrey in its home directory. ########## ## MySQL # Dependancies: you need the DBD::MySQL perl module and a working MySQL server. # Howto: Launch the 'mysql' command-line utility with admin rights. Create a sqlgrey database: - For MySQL < 5.0 > CREATE DATABASE sqlgrey; - For MYSQL >= 5.0 > CREATE DATABASE sqlgrey CHARACTER SET latin1; Then set up access rights: > GRANT ALL ON sqlgrey.* TO sqlgrey@localhost; Setup /etc/sqlgrey/sqlgrey.conf with db_type = mysql db_name = sqlgrey # Note: MySQL is really fast. I'd recommend it if you don't want to host critical databases with high access concurrency. ############### ## PostgreSQL # Dependancies: you need the DBD::Pg perl module and a working PostgreSQL server. # Howto: 1/ Create a sqlgrey database and a PostgreSQL sqlgrey user: as postgres user (su - postgres): -bash-2.05b$ createuser sqlgrey Shall the new user be allowed to create databases? (y/n) y Shall the new user be allowed to create more new users? (y/n) n CREATE USER -bash-2.05b$ You'll have to check your pg_hba.conf file if you're not sure about the access control configuration. For the next step, you need to be able to connect as sqlgrey. -bash-2.05b$ createdb -U sqlgrey sqlgrey CREATE DATABASE -bash-2.05b$ Pay attention to the access controls: as Unix user sqlgrey, you must be able to connect to the sqlgrey database as sqlgrey PostgreSQL user... Look into pg_hba.conf and if needed set a password for the PostgreSQL sqlgrey user. sqlgrey will use the TCP/IP socket to connect, please make sure that "tcpip_socket = true" is in your 'postgresql.conf' file. This is my personnal recommendation, really robust, can scale up and down when properly configured. ########################### ## Postfix configuration ## ########################### Start by adding check_policy_service after reject_unauth_destination in /etc/postfix/main.cf: smtpd_recipient_restrictions = ... reject_unauth_destination check_policy_service inet:127.0.0.1:2501 This assumes sqlgrey will listen on the TCP 2501 port (default) and is on the same host. ## Example: A complete example for a site that uses SASL authentication and various anti-SPAM rules, all in smtpd_recipient_restrictions: smtpd_recipient_restrictions = # ----------------- # -- Our clients -- # ----------------- # our networks are welcomed permit_mynetworks # SASL clients (SMTP auth) are ok too permit_sasl_authenticated # ------------ # -- Others -- ##------------ # 3 quick checks on senders/recipients reject_unknown_sender_domain reject_non_fqdn_sender reject_non_fqdn_recipient # helo/ehlo syntax check reject_invalid_hostname # Seen false positives, but really efficient on UCE # forbid helos and enforces helos # reject_non_fqdn_hostname # at this stage we must be the destination reject_unauth_destination # check for obvious helo fakes check_helo_access hash:/etc/postfix/smtp_helo_blacklist # RCPT TO not in our maps (reject early instead of bouncing messages) reject_unlisted_recipient # SQLgrey is called here check_policy_service inet:127.0.0.1:2501 # RBL checks reject_rbl_client sbl-xbl.spamhaus.org reject_rbl_client list.dsbl.org Note: smtp_helo_blacklist looks like that: [xxx.xxx.xxx.xxx] 554 Liar: This is one of our IPs [yyy.yyy.yyy.yyy] 554 Liar: This is one of our IPs my.hostname.tld 554 Liar: That's my hostname mydomain.tld 554 Liar: That's my domain .mydomain.tld 554 Liar: You aren't part of my domain mydomain2.tld 554 Liar: That's my domain .mydomain2.tld 554 Liar: You aren't part of my domain *Important* note about RBLs: As using a rbl imply handing the decision to reject mail to outsiders, you are strongly advised to review and understand one RBL's listing policy *before* adding it to your configuration. ################## ## Whitelisting ## ################## Some MTAs don't play well with greylisting (often because they don't respect the RFCs). To work around this problem (that your users won't fail to report to you when it will happen): - don't disable sqlgrey logs (by default it will log what you need). - ask your user for the e-mail of the person that unsuccesfully tried to send mail to her/him and when the unsuccessfull attempt occured. - in the meantime, if the transmission failure occured recently (less than max_connect_age in sqlgrey.conf, by default 24 hours) advise your user to contact the sender and politely ask her to re-send the message, there are good chances that the second attempt will get through (SQLgrey will probably find a match: the first attempt). - grep your mail logs for the address, you'll find a line like this sqlgrey: grey: new: (www.xxx.yyy.zzz): -> by default, one day later you'll find this line: sqlgrey: spam: : -> at What matters to you is the IP address (or the class C network) and the domain name it is associated with. If Postfix could find a reliable domain name (the reverse lookup must itself point to the IP address), you'll find it in one of the lines in your log before the first sqlgrey log line. If you can get a reliable domain name, put it in /etc/sqlgrey/clients_fqdn_whitelist.local do *not* touch the /etc/sqlgrey/clients_fqdn_whitelist file as it will be overwritten by a future sqlgrey installation or update_sqlgrey_config The top of /etc/sqlgrey/clients_fqdn_whitelist explains the expected formats. You don't need to restart sqlgrey as it monitors the ".local" files and reload them as soon as they change or when they are created for the first time. If you can't get a reliable domain name, just put the IP address in the /etc/sqlgrey/clients_ip_whitelist.local file. If you need to, you can add a whole class C network by putting a line with only the three first bytes of the IP addresses. IPv6 addresses are also supported in this file. As it's quite important I repeat: only look for the installed clients_*_whitelist files for reference and put your own entries in the corresponding *.local files. You are advised to subscribe to the sqlgrey-users mailing-list (see http://lists.sourceforge.net/lists/listinfo/sqlgrey-users) and submit the IP addresses and domain names you have to add to your .local files to make your users happy and the reason why you did so (see comments on why the existing systems are added). As of 1.4.3, SQLgrey's whitelists can be updated from a central repository with the update_sqlgrey_config script. update_sqlgrey_config outputs modified entries on STDOUT. Running it from cron once a day (updates are scarcely needed and the average interval between updates is roughly one month) is a great way to be warned of new whitelist entries or old entries being cleaned up. ##################### # Warnings by email # ##################### SQLgrey can send emails when it detects anomalies. You need to: - make sure the user SQLgrey runs as (should be sqlgrey) can send emails with the 'mail' command. use echo "test" | mail -s "SQLgrey test" and check that the message made it through. - put the following line (replace with your email address): admin_mail = in /etc/sqlgrey/sqlgrey.conf That's all. SQLgrey will make sure it doesn't flood your mailbox by rate-limiting the emails it sends. ################## # OPTIN / OPTOUT # ################## See README.OPTINOUT ################# # RPM Packaging # ################# Some of the steps required to install SQLgrey are covered by a RPM package built with the included spec file: - creates a sqlgrey user, - installs a /etc/init.d/sqlgrey SysV init file, - installs a /etc/sqlgrey/sqlgrey.conf config file - installs /etc/sqlgrey/clients_*_whitelist files What's left to you is the Postfix and Database setup. ################# # Gentoo ebuild # ################# The sourceforge site (http://sqlgrey.sourceforge.net/) points to the latest ebuild available. See http://linuxreviews.org/gentoo/ebuilds/ for how to use it. If you use the ebuild and haven't done so yet, please fill a comment on http://bugs.gentoo.org/show_bug.cgi?id=71535 ##################### # Reloading SQLgrey # ##################### If you change the sqlgrey.conf file you must restart SQLgrey to re-read it. If you change distributed whitelists (not local ones, they are automatically reloaded) or want to force a database reconnection you can force a reload by sending SIGUSR1 to the sqlgrey process. sqlgrey-1.8.0/INSTALL000066400000000000000000000007371171713015400142460ustar00rootroot00000000000000Installing sqlgrey: ------------------- No need to run initial 'make'. Just run: make install To install with init-script, prepend your distro to 'install' like this: ----------------------------------- make rh-install (redhat) make gentoo-install make debian-install With DBCluster support: ----------------------- make use_dbcluster make install Revert back to DBI (from dbcluster): ------------------------------------ make use_dbi make install Now go read HOWTO.. sqlgrey-1.8.0/Makefile000066400000000000000000000055371171713015400146600ustar00rootroot00000000000000INSTALL = install ETCDIR = $(ROOTDIR)/etc CONFDIR = $(ETCDIR)/sqlgrey SBINDIR = $(ROOTDIR)/usr/sbin BINDIR = $(ROOTDIR)/usr/bin INITDIR = $(ETCDIR)/init.d MANDIR = $(ROOTDIR)/usr/share/man/man1 VERSION := $(shell cat VERSION) default: @echo "See INSTALL textfile"; all: manpage update-version update-version: cat sqlgrey | sed 's/^my $$VERSION = .*;/my $$VERSION = "$(VERSION)";/' > sqlgrey.new mv sqlgrey.new sqlgrey chmod a+x sqlgrey cat sqlgrey.spec | sed 's/^%define ver .*/%define ver $(VERSION)/' > sqlgrey.spec.new mv sqlgrey.spec.new sqlgrey.spec cat sqlgrey-logstats.pl | sed 's/^my $$VERSION = .*;/my $$VERSION = "$(VERSION)";/' > sqlgrey-logstats.pl.new mv sqlgrey-logstats.pl.new sqlgrey-logstats.pl chmod a+x sqlgrey-logstats.pl use_dbcluster: cat sqlgrey | sed 's/^use DBI;/use DBIx::DBCluster;/' > sqlgrey.new mv sqlgrey.new sqlgrey chmod a+x sqlgrey cd lib/DBIx-DBCluster-0.01/;perl Makefile.PL;make;make install use_dbi: cat sqlgrey | sed 's/^use DBIx::DBCluster;/use DBI;/' > sqlgrey.new mv sqlgrey.new sqlgrey chmod a+x sqlgrey manpage: perldoc -u sqlgrey | pod2man -n sqlgrey > sqlgrey.1 clean: rm -f sqlgrey.1 rm -f *~ .#* init/*~ etc/*~ install: all $(INSTALL) -d -m 755 $(SBINDIR) $(INSTALL) -d -m 755 $(ETCDIR) $(INSTALL) -d -m 755 $(CONFDIR) $(INSTALL) -d -m 755 $(INITDIR) $(INSTALL) -d -m 755 $(MANDIR) $(INSTALL) -d -m 755 $(BINDIR) $(INSTALL) -m 755 sqlgrey $(SBINDIR) $(INSTALL) -m 755 update_sqlgrey_config $(SBINDIR) $(INSTALL) -m 755 sqlgrey-logstats.pl $(BINDIR) $(INSTALL) -m 644 etc/sqlgrey.conf $(CONFDIR) $(INSTALL) -m 644 etc/clients_ip_whitelist $(CONFDIR) $(INSTALL) -m 644 etc/clients_fqdn_whitelist $(CONFDIR) $(INSTALL) -m 644 etc/discrimination.regexp $(CONFDIR) $(INSTALL) -m 644 etc/dyn_fqdn.regexp $(CONFDIR) $(INSTALL) -m 644 etc/smtp_server.regexp $(CONFDIR) $(INSTALL) -m 644 etc/README $(CONFDIR) $(INSTALL) -m 644 sqlgrey.1 $(MANDIR) rh-install: install $(INSTALL) init/sqlgrey $(INITDIR) gentoo-install: install $(INSTALL) init/sqlgrey.gentoo $(INITDIR)/sqlgrey debian-install: install $(INSTALL) init/sqlgrey.debian $(INITDIR)/sqlgrey ln -s ../init.d/sqlgrey /etc/rc0.d/K20sqlgrey ln -s ../init.d/sqlgrey /etc/rc1.d/K20sqlgrey ln -s ../init.d/sqlgrey /etc/rc2.d/S20sqlgrey ln -s ../init.d/sqlgrey /etc/rc3.d/S20sqlgrey ln -s ../init.d/sqlgrey /etc/rc4.d/S20sqlgrey ln -s ../init.d/sqlgrey /etc/rc5.d/S20sqlgrey ln -s ../init.d/sqlgrey /etc/rc5.d/K20sqlgrey dist: update-version clean ## ## TAG the revision first with: ## git tag sqlgrey_$(VERSION) ## ## NOTE: this will create an archive from the ## state of repository, ignoring your ## uncommited changes!!! @-mkdir -p dist git archive sqlgrey_$(VERSION) --prefix=sqlgrey-$(VERSION)/ -o dist/sqlgrey-$(VERSION).tar gzip -v dist/sqlgrey-$(VERSION).tar rpm: dist rpmbuild -ta dist/sqlgrey-$(VERSION).tar.gz sqlgrey-1.8.0/README000066400000000000000000000006651171713015400140750ustar00rootroot00000000000000 ################################################# # SQLgrey - a postfix greylisting policy server # ################################################# Requires : - Perl - Net::Server (Perl Module) - IO::Multiplex (Perl Module) - perl-DBI (Perl Module) - Postfix 2.1 Documentation : - POD documentation. Execute: perldoc sqlgrey (or man sqlgrey once installed) - the HOWTO - the README.* files - the default sqlgrey.conf file sqlgrey-1.8.0/README.DBCLUSTER000066400000000000000000000111541171713015400154160ustar00rootroot00000000000000 ################################### ## SQLgrey support for DBCluster ## ################################### Database clustering behaviour is enabled by the 'db_cluster' configuration variable in /etc/sqlgrey/sqlgrey.conf ## Default By default db_cluster is set to 'off'. ## DBClustering Theese functions allow you to work with a cluster of databases (and mailservers). This is very usefull for places where the mailservers are already being clustered through eg. lvs. It is also usefull if you simply want all your mailservers to use the same tables (eg. the Auto-whitelists). And lastly, it is usefull for distributing high db load. NOTE: THIS HAS BEEN TESTED WITH MySQL ONLY. ## DBCluster - what does it do Basically, dbclustering uses normal DBI through an override module that allows it to have connections to several database servers instead of just one. (Module used, is DBIx::DBCluster is made by Alex Rak, slightly modified) What this means to you, is easy access to distributing sqlgrey's queries among several database servers. This is probably best explained with an example: [internet] | [Load balancer] / | \ [mail1] [mail2] [mail3] [ect.] In this case, you have 3 mailserver that semi random gets connections from internet. Let each mailserver have its own SQL-server on localhost, since using 1 common for all servers can be to heavy for some setups. If [mail1] gets a new request, it'll greylist, respond "450" and stick client into the "connect" table. Now heres the problem. Client backs off, and comes back later to try again, but there is no garantee it'll get [mail1] again. Infact, if it doesnt, the greylisting will happen all over. The solution is to use DBClustering. Each mailserver STILL has its own SQL-server, but we add a master-sql and let the local sql-servers be replication slaves: [internet] | [Load balancer] / | \ [mail1] [mail2] [mail3] [ect.] \ | / [DB-Master] We enable DBCluster in sqlgrey, set [DB-Master] as "db_host" and set read_hosts=localhost Now, all write operations will be directed to [DB-Master]. Using normal SQL-replication, the local DB's will get all new changes and thus, be an excact copy of the master. All read operations are done to localhost, removing load from the master, and speeding up the read time, since the request doesnt have to travel over the network. Sounds complicated? It isnt.. Read on.. ## Setting up DBClustering Step 1. Set up a replication db-cluster. This is not covered here. Check your manual for whatever DB your using. MySQL's replication howto can be found here: http://dev.mysql.com/doc/refman/5.0/en/replication-howto.html Step 2. in sqlgrey.conf, set db_cluster = on Step 3. Change db_host to point to your MASTER-SQL. db_host becomes your "write host" Step 4. Add one or more sqlservers to read_hosts. (eg. read_hosts=localhost) Step 5. Choose one sqlgrey server to do db-cleanup (read more below). At a prompt on that host type "hostname". Add the resulting hostname to db_cleanup_hostname. (eg. db_cleanup_hostname=mail1) And youre done. ## Configuration directive: db_cleanup_hostname Its probably not desirable to have every sqlgrey in the cluster issuing db-cleanup every 30 minutes to the master-sql. To get around this problem, you can choose one server that does the cleanup. Every sqlgrey will query its own hostname upon startup and the hostname that matches the db_cleanup_hostname will do the cleanup. Since it usually isnt desirable to have differing configuration files on every host in a cluster, using hostname seems the best solution. This way, sqlgrey.conf can be identical on every node in the cluster. The hostname corrosponds to the output of the "hostname" command on linux. $ hostname mailhost-1 In sqlgrey.conf set: db_cleanup_hostname=mailhost-1 ## Configuration directive: read_hosts read_hosts must be set to the hostnames/IP's of the "read_only" database hosts. It can contain 1 or more hosts, seperated by comma. Read requests will be distributed equally among "read_hosts". Remember that "db_host" becomes your "write-only" host upon enabling clustering. Should you wish to read from the "db_host" as well as say, localhost, simply add it to read_hosts. Examples: --------- Write to master, read from localhost: db_host=my-master.example.com read_hosts=localhost Write to master, read from localhost and master: db_host=my-master.example.com read_hosts=localhost,my-master.example.com Write to master, read from 3 slaves: db_host=my-master.example.com read_hosts=slave-1.example.com,slave-2.example.com,slave-3.example.com sqlgrey-1.8.0/README.DISCRIMINATION000066400000000000000000000105551171713015400162070ustar00rootroot00000000000000 ############################ ## SQLgrey Discrimination ## ############################ Discrimination behaviour is enabled by the 'discrimination' configuration variable in /etc/sqlgrey/sqlgrey.conf ## Default By default discrimination is set to 'off'. SQLgrey will apply greylisting (with the default whitelisting and auto-whitelisting described in the HOWTO) to every message. By default 'discrimination_add_rulenr' is 'off'. If set to on, the greylist reply to the client will have the rule number added to the end of the rejection text. (eg. 'Greylisted for 5 minutes (2)'). ## Discrimination Discrimination based greylisting is only usefull if you DO NOT want to greylist everybody. There may be several reasons for this. For example it can be used as a soft transistion to start greylisting, slowly over time making it more and more restrictive. Or it can help you convince management to allow you to do greylisting by explaining that you'd only greylist "anything suspicous" and thus, not your own customers. ## Discrimination - what is it This feature was pretty hard to find a name for, but discrimination describes pretty well what it does. It discriminates ;). I think of it as "the airport principle". Everybody is let onto the plane UNLESS they find you suspicous. You might have long hair, wear a turban, have dark skin or simply wearing a t-shirt saying "explosive" or "GNU rocks". Then you will, by discrimination, be held back for further analysis. (im not saying it fair, its just a very good example) The same principle applies here. Everyone is whitelisted UNLESS they look suspicous. If so, they have to go through greylisting. What is suspicous is defined in the /etc/sqlgrey/discrimination.regexp file. In here one defines regular expression that will be used to check different attributes. Example: sender =~ @microsoft.com$ This line simply defines, that if the senders address ends on microsoft.com, its suspicous and thus will be greylisted. Another example: sender !~ ^(god|allah|jesus)@heaven.com$ Note the !~ which means "anything that does NOT match, is suspicous". In this particular example we say: "We trust god, allah or jesus sending from heaven.com, but EVERYONE else will be greylisted." ## Rule Details The rules in /etc/sqlgrey/discrimination.regexp are defines by the following triplet: attribute comparison-operator regex Valid comparison operators are: =~ Equal to !~ Not Equal to Valid attributes are anyhing sendt from postfix to the policy deamon, but the ill explain the most common (and usefull) here: sender = the From address (from MAIL FROM:) recipient = the recipients mail address (from RCPT TO:) client_address = IP address of the client client_name = Reverse-dns name of the client helo_name = The text entered as "helo " Valid regular expression are simply perl compatable regular expressions. (without the "/" in beginning and end). ## Configuration directive: discrimination_add_rulenr 'discrimination_add_rulenr=yes' adds the rule number of the rule that caused the greylisting to the end of the rejection text, like this: Greylisted for 5 minutes (2) In this case, 2 means the second (valid) regular expression in the file, caused the greylisting. This feature is to allow the support department to help customers figure out why, if their mail gets greylisted. ## Rule tips Its hard to define what is worthy of another look, and its definently not a 100% solution. If you have the guts and/or oppotunity, you should go with normal greylisting. I look often at our maillog and by doing so, start to see patterns to what spam looks like. You should do the same to find out whats good for greylisting, but some general tips are: - missing reverse-dns - mails from microsoft, fbi, paypal, ebay and the likes - NULL senders. (blank sender address) - mailaddresses with special chars (eg. $ or *) The first one takes alot of the trash. So does NULL senders, but be advised that NULL senders are also legaly used in bounce mails. ## Performance guidelines It doesnt take much to do this check if you keep your list of expressions within reasonable limits. Actually this feature should be a performance saver, as it takes away a bunch of sql load, depending on how much you discriminate. This function is being used in a real-life scenario with ~100.000 accounts being checked by 10 regular expressions. There is no measurable perfomance loss. sqlgrey-1.8.0/README.OPTINOUT000066400000000000000000000052521171713015400153520ustar00rootroot00000000000000 ###################################### ## SQLgrey support for Optin/optout ## ###################################### SQLgrey behaviour depends on the 'optmethod' configuration variable in /etc/sqlgrey/sqlgrey.conf ## Default By default optmethod is set to 'none'. SQLgrey will apply greylisting (with the default whitelisting and auto-whitelisting described in the HOWTO) to every message. ## Optin/Optout If optmethod is set to either 'optin' or 'optout' (don't use the quotes in sqlgrey.conf), SQLgrey will check four tables to decide if the greylisting must be used. These four tables are: . optin_domain . optin_email . optout_domain . optout_email They each have only one column with either a domain name or a full email address (stored as a VARCHAR(255)). ** Important Note ** the content of each of these table *MUST* be *lowercased*. SQLgrey always use lowercased address internally and for performance reasons won't ask the database to check for different cases. ******************** If 'optin' is used, SQLgrey will only greylist in two cases: - the domain is in optin_domain AND the address isn't in optout_email, - the address is in optin_email. If 'optout' is used, SQLgrey won't greylist in two cases: - the domain is in optout_domain AND the address isn't in optin_email, - the address is in optout_email. ** Note ** SQLgrey doesn't check if the 4 tables' content is consistent. For example you should make sure that an address isn't both in optin_email and optout_email which doesn't make sense (SQLgrey won't crash but its behaviour can change between versions). ********** ## Performance guidelines For maximum performance, you should use the method which will use the least table entries. If nearly all your users want greylisting, you'll have better performance with 'optout'. If all of them want it without exception, use 'none'. If the needs of your users change between domains, use one of the optin/out_domain tables to set defaults (depending on the optmethod) by domain and add exceptions in the optin/out_email tables. This will lower the number of entries in the database and help with performance. ## Long email addresses For portability, addresses are limited to 255 characters. If you have users with addresses of more than 255 characters, you'll have to trim the addresses the same way SQLgrey does: simply take the 255 first characters of the address leaving the rest out. If you have several users with the same 255 first characters, then it won't work properly (obviously the last user modified will set the behaviour for the group beginning with the same characters). As addresses of this size are pretty uncommon, the risk of collisions is probably only theoric though.sqlgrey-1.8.0/README.PERF000066400000000000000000000035141171713015400146240ustar00rootroot00000000000000On large sites, database performance can suffer. Here are some tips. # One SQLgrey on DB vs one SQLgrey on each MTA Usually, for robustness reasons you should run one SQLgrey on each MTA and configure Postfix to ask the local SQLgrey instance. The problem is that when you use a separate database, SQLgrey queries have to be done accross the network and there usually are several sequential queries for only one message. You can minimise latency issues by having only one SQLgrey instance sitting on the database host. The huge flaw in this architecture is that if the database host breaks your whole email infrastructure breaks too (SQLgrey is designed to work around database unavailabilities). The fact that queries are serialised at the SQLgrey level might also help performance by avoiding too much parallel queries. # Use DBClustering Allows you to distribute load between several database servers. See README.DBCLUSTER # Use Discrimination Alternative approach to greylisting where you make selective rules to allow some hosts to bypass greylisting entirely, based on how they "look" and "talk". See README.DISCRIMINATION # Optin/optout related performance See README.OPTINOUT, ## Performance guidelines # Put most common hosts in whitelists If your logs show that much of your traffic is coming from a handfull of servers, put them in the whitelists: SQLgrey won't have to query the database. You can use sqlgrey-logstats.pl to point out the most common sources in your AWLs. All whitelists types don't share the same speed. The quickest are the IP based whitelists and the full fqdn entries in the fqdn whitelists. regexps and domain (*.domain.name) in fqdn whitelists are noticeably slower. # Add RAM to the database host If you want to put money somewhere, unless you have an uncommon setup, RAM on the DB should be the best place to invest. sqlgrey-1.8.0/TODO000066400000000000000000000020161171713015400136750ustar00rootroot00000000000000- experiment with throttling - make config parser aware of supported options and complain about unsupported ones - modularize the whole process - make SQLgrey manageable by Postfix's master daemon - dsn_awl (for MAIL FROM: <>), connect_awl (first stage before from_awl), rcpt_awl (match forwards) - make header content user configurable with some predefined macros. _DELAY_ for example. - add automatic blacklisting support (ideas: spamtraps, no reconnect and more than x rejects, ...). - use time units everywhere to make configuration easier - experiment with an adaptive cleanup algorithm - create a stress-testing suite (for performance/reliability tests) - check if permission related SQL errors are catchable - try to exit with a proper error code when database is unavailable or the user doesn't have enough rights to access the pid-file - add sender e-mail based white-list with huge warnings - experiment with SPF support - support migrating from another grey-lister by calling it to learn its auto-white-lists sqlgrey-1.8.0/VERSION000066400000000000000000000000061171713015400142520ustar00rootroot000000000000001.8.0 sqlgrey-1.8.0/etc/000077500000000000000000000000001171713015400137615ustar00rootroot00000000000000sqlgrey-1.8.0/etc/README000066400000000000000000000007351171713015400146460ustar00rootroot00000000000000README file for sqlgrey updated content Don't touch these files, they are automatically updated when you run update_sqlgrey_config: - clients_fqdn_whitelist: don't greylist these DNS names [*] - clients_ip_whitelist : don't greylist these IP addresses [*] - dyn_fqdn.regexp : used by new 'smart' algorithm [x] - smtp_server.regexp : used by new 'smart' algortihm [x] [*]: in use starting with 1.4.0 [x]: in use since 1.5.1, regexps looking for known fqdns patterns sqlgrey-1.8.0/etc/clients_fqdn_whitelist000066400000000000000000000046561171713015400204640ustar00rootroot00000000000000## # SQLgrey expects the following expressions: # # hostname.domain.com # whole system name (least CPU intensive) # *.domain.com # whitelist any fqdn in the domain 'domain.com' # /regexp/ # whitelist any fqdn matching the regexp (by far most CPU intensive) # Note you need the following two lines to allow both # .example.com and example.com # *.example.com # example.com # Do not add anything here (this file can be overwritten by SQLgrey updates and # update_sqlgrey_config), create a "clients_fqdn_whitelist.local" file # and add your own entries in there ################### # greylisting.org # ################### # No retry *.southwest.com *.scd.yahoo.com *.ameritradeinfo.com *.amazon.com # wierd retry pattern isp.belgacom.be ############ # postgrey # ############ # No retry *.karger.ch gw.bas.roche.com mail.hhlaw.com prd051.appliedbiosystems.com *.swissre.com /^ms-smtp.*\.rr\.com$/ /^lake.*mta.*\.cox\.net$/ *.mot.com *.cs.columbia.edu cs.columbia.edu p01m1689.mxlogic.net p02m169.mxlogic.net # Address verification *.nic.fr /^sc\d+pub\.verizon\.net$/ *.freshmeat.net # Slow retry (4 hours or more) server-x001.hostpoint.ch accor-hotels.com /^mail\d+\.telekom\.de$/ /^smtp\d+\.tiscali\.dk$/ # Unique sender with letters returns.dowjones.com *.zd-swx.com lockergnome.wc09.net # Pool on different subnets /^fmr\d+\.intel\.com$/ ############################# # Reported by SQLgrey users # ############################# # No retry unitymail.alapage.com # Alapage newsletter smtp.mandrake.org # mandrake newsletter smtp.mandriva.org # mandriva (previously MandrakeSoft) newsletter *.emailebay.com # eBay mailservers public.wavexservices.com # Wavex Services Mail Server mail.optimumreturn.com # E-commerce ASP solution (W Hotels use them) ########################### # Requested by MTA admins # ########################### # Ciphired (they need low-latency for their challenge-response system) mx.00.zh.cs.ciphire.net mx.01.zh.cs.ciphire.net mx.00.mc.cs.ciphire.net mx.01.mc.cs.ciphire.net mx.00.by.cs.ciphire.net mx.01.by.cs.ciphire.net # Bigfish.com: reported to only try once from one IP then only once # on another mail-par.bigfish.com mail-haw.bigfish.com # CAcert: no retry *.cacert.org # GL-group: no retry mail.gl-group.com # Do not add anything here (this file can be overwritten by SQLgrey updates and # update_sqlgrey_config), create a "clients_fqdn_whitelist.local" file # and add your own entries in there sqlgrey-1.8.0/etc/clients_ip_whitelist000066400000000000000000000063561171713015400201430ustar00rootroot00000000000000# Do not add anything here (this file can be overwritten by SQlgrey updates or # update_sqlgrey_config), create a "clients_ip_whitelist.local" file # and add your own entries in there # Reference : http://www.greylisting.org 12.5.136.141 # Southwest Airlines (unique sender, no retry) 12.5.136.142 # Southwest Airlines (unique sender, no retry) # kernel.org isn't hosted by RedHat anymore #12.107.209.244 # kernel.org mailing lists (high traffic, unique sender per mail) 12.107.209.250 # sourceware.org mailing lists (high traffic, unique sender per mail) 63.82.37.110 # SLmail 64.7.153.18 # sentex.ca (common pool) 64.12.137 # AOL (common pool) - http://postmaster.aol.com/servers/imo.html 64.12.138 # AOL (common pool) 64.124.204.39 # moveon.org (unique sender per attempt) 64.125.132.254 # collab.net (unique sender per attempt) #64.233.170 # gmail (common server pool) #65.82.241.160 # Groupwise? #66.94.237 # Yahoo Groups? 66.100.210.82 # Groupwise? 66.135.209 # Ebay (for time critical alerts) 66.135.197 # Ebay (common pool) 66.162.216.166 # Groupwise? 66.206.22.82 # PLEXOR 66.206.22.83 # PLEXOR 66.206.22.84 # PLEXOR 66.206.22.85 # PLEXOR 66.218.66 # Yahoo Groups servers (common pool, no retry) 66.218.67 # Yahoo Groups servers (common pool, no retry) 66.218.69 # Yahoo Groups servers (common pool, no retry) 66.27.51.218 # ljbtc.com (Groupwise) #66.89.73.101 # Groupwise? #68.15.115.88 # Groupwise? 152.163.225 # AOL (common pool) 194.245.101.88 # Joker.com (email forwarding server) 195.235.39.19 # Tid InfoMail Exchanger v2.20 195.238.2.105 # skynet.be (wierd retry pattern) 195.238.2.124 # skynet.be (common pool) 195.238.3.12 # skynet.be (common pool) 195.238.3.13 # skynet.be (common pool) #204.60.8.162 # Groupwise? 204.107.120.10 # Ameritrade (no retry) 205.188.139.136 # AOL (common pool) 205.188.139.137 # AOL (common pool) 205.188.144.207 # AOL (common pool) 205.188.144.208 # AOL (common pool) 205.188.156.66 # AOL (common pool) 205.188.157 # AOL (common pool) 205.188.159.7 # AOL (common pool) 205.206.231 # SecurityFocus.com (unique sender per attempt) 205.211.164.50 # sentex.ca (common pool) 207.115.63 # Prodigy (broken software that retries continually with no delay) 207.171.168 # Amazon.com (common pool) 207.171.180 # Amazon.com (common pool) 207.171.187 # Amazon.com (common pool) 207.171.188 # Amazon.com (common pool) 207.171.190 # Amazon.com (common pool) 211.29.132 # optusnet.com.au (wierd retry pattern and more than 48hrs) 213.136.52.31 # Mysql.com (unique sender) #216.136.226.0 # Yahoo Mail? #216.157.204.5 # Groupwise? 217.158.50.178 # AXKit mailing list (unique sender per attempt) ############################# # Reported by SQLgrey users # ############################# # Reminder: the following entry is supposed to solve the problem by 2006 # discovery.acnatsci.org (use groupwise 5.5, 450 is a 554 for them) 192.204.19.13 # Free.fr uses a separate pool for retries # the "first try" servers are smtp?-g19.free.fr, all servers are in the same # class C network which is used for free/proxad servers 212.27.42 # Do not add anything here (this file can be overwritten by SQlgrey updates or # update_sqlgrey_config), create a "clients_ip_whitelist.local" file # and add your own entries in there sqlgrey-1.8.0/etc/discrimination.regexp000066400000000000000000000027731171713015400202220ustar00rootroot00000000000000# Discrimination regular expressions. # # Format: # # # Format Explained: # regular_expression = any valid perl regular expression # comparison_operator = either =~ for equal to, or !~ for NOT equal to. # postfix_attributes = Any valid attribute delivered from postfix. # Common values: client_address, client_name, helo_name, sender, recipient # # A few usefull examples and defaults. # Only greylist if one of the following expressions are true # client_name =~ (yahoo|hotmail|dhcp|proxy)\. # An example on discimination simply based on parts # of the reverse-dns client_name =~ \.(cn|br|tw|jp|th|nz)$ # if reverse-dns of client is one of theese TLD's # # Or the other way around: # client_name !~ \.(dk|uk|fi|no|se)$ # if reverse dont is NOT one of theese sender =~ \.(com|net|org)@ # If sender address is like eg. "free-stuff.com@hotmail.com" helo_name !~ \w\.[a-zA-Z]{2,4}$ # If helo doesnt contain a fqdn client_name =~ ^unknown$ # No reverse DNS client_name =~ \d+-\d+-\d+-\d+ # Looks like DSL line client_name =~ ^.{0,3}0?x[0-9a-f]{8} # Looks like DSL line client_name =~ (gmail|hotma\w+|yahoo)\.\w+$ # if reverse-dns of client is one of theese TLD's #Accounts names that typically recieve tons of spam recipient =~ ^(admin(istrator)?|info|advertising|contact|guest|uucp|test|service|promo|(host|web)master|account(ing|s))@ # sender =~ (microsoft|paypal|ebay|FREE) # if any part of the sender is one of theese sqlgrey-1.8.0/etc/dyn_fqdn.regexp000066400000000000000000000005471171713015400170050ustar00rootroot00000000000000(^|[0-9.x_-])(abo|br(e|oa)dband|cabel|(hk)?cablep?|catv|cbl|cidr|d?client2?|cust(omer)?s?|dhcp|dial?(in|up)?|d[iu]p|[asx]?dsld?|dyn(a(dsl|mic)?)?|home|in-addr|modem(cable)?|(di)?pool|ppp|ptr|rev|static|user|YahooBB[0-9]{12}|c[[:alnum:]]{6,}(\.[a-z]{3})?\.virtua|[1-9]Cust[0-9]+|AC[A-Z][0-9A-F]{5}\.ipt|pcp[0-9]{6,}pcs|S0106[[:alnum:]]{12,}\.[a-z]{2})[0-9.x_-]sqlgrey-1.8.0/etc/smtp_server.regexp000066400000000000000000000004751171713015400175540ustar00rootroot00000000000000^(.+[._-])*(apache|bounce|bulk|delay|d?ns|external|extranet|filter|firewall|forward|gateway|gw|m?liste?s?|(bulk|dead|mass|send|[eqw])?mail(er)?|e?mail(agent|host|hub|scan(ner)?)|messagerie|mta|v?mx|out(bound)?|pop|postfix|w?proxy|rela(is|y)|serveu?r|smarthost|v?smtp|web|www)(gate|mail|mx|pool|out|server)?[0-9]*[._-]sqlgrey-1.8.0/etc/sqlgrey.conf000066400000000000000000000203641171713015400163230ustar00rootroot00000000000000######################### ## SQLgrey config file ## ######################### # Notes: # - Unless specified otherwise commented settings are SQLgrey's defaults # - SQLgrey uses a specific config file when called with -f ## Configuration files # conf_dir = /etc/sqlgrey ## Log level # Uncomment to change the log level (default is normal: 2) # nothing: O, errors only: 0, warnings: 1, normal: 2, verbose: 3, debug: 4 # loglevel = 2 ## log categories can be fine-tuned, # here are the log messages sorted by types and levels, # (anything over the loglevel is discarded): # # grey : (0) internal errors, # (2) initial connections, early reconnections, # awl matches, successful reconnections, AWL additions, # (3) smart decision process debug, # whitelist: (2) whitelisted connections, # (3) actual whitelist hit, # (4) whitelists reloads, # optin: (3) optin/optout global result # (4) optin/optout SQL query results # spam : (2) attempts never retried, # mail : (1) error sending mails, # (4) rate-limiter debug, # dbaccess : (0) DB errors, # (1) DB upgrade, # (2) DB upgrade details, # martians : (2) invalid e-mail addresses, # perf : (2) cleanup time, # system : (0) error forking, # (3) forked children PIDs, children exits, # conf : (0) errors in config files, missing required file, # (1) warnings in config files, # missing optional configuration files, # (2) reloading configuration files, # other : (4) Startup cleanup # you can set a level to O (capital o) to disable logs completely, # but be aware that then SQLgrey can come back to haunt you... # Provide a coma-separated "logtype:loglevel" string # For example if you set the loglevel to 3 (verbose) but want SQLgrey to be: # . quiet for whitelists # . normal for greylisting # uncomment the following line. # log_override = whitelist:1,grey:2 # By default, log_override is empty ## Log identification # by default this is the process name. If you define the following variable # SQLgrey will use whatever you set it to # log_ident = ## username and groupname the daemon runs as # user = sqlgrey # group = sqlgrey ## Socket # On which socket do SQLgrey wait for queries # use the following if you need to bind on a public IP address # inet = :2501 # to bind on a UNIX socket, use the following: # unix = /path/to/socket # default : # inet = 2501 # bind to localhost:2501 ## PID # where to store the process PID # pidfile = /var/run/sqlgrey.pid ## Greylisting delays # If you want to be really strict (RFC-wise) use these # This is *not* recommended, you'll have false positives # reconnect_delay = 15 # don't allow a reconnection before 15 minutes # max_connect_age = 2 # don't allow a reconnection after 2 hours # default: (based on real-life experience) # reconnect_delay = 5 # max_connect_age = 24 ## Throttling too many new entries from new host # Setting this optional parameter will refuse an excessive number of # new entries in the connect table from the same host, in the following # manner: # - If there are already "connect_src_throttle" entries in the connect # table from the same host (e-mails which have not been retried yet) # - And there is NO entry for this host in domain_awl # - And there are LESS than "connect_src_throttle" entries in the # from_awl table for this host # THEN further incoming connections from this host will be (temporarily) # refused without new entries being created in the connect table (until # some already waiting entries have been successfully retried). # This feature may prevent the connect table from growing too big and # being polluted by spambots, viruses, zombie machines and the like. # If set to "0" (default), this feature won't be used. # connect_src_throttle = 5 ## Auto whitelists settings # default is tailored for small sites # awl_age = 60 # group_domain_level = 2 # For bigger sites you may want # a smaller awl_age and a bigger group_domain_level # awl_age = 32 # (monthly newsletter will get through) # group_domain_level = 10 # wait for 10 validated adresses to add a whole # domain in AWL ## Database settings # instead of Pg below use "mysql" for MySQL, "SQLite" for SQLite # any DBD driver is allowed, but only the previous 3 have been tested # db_type = Pg # db_name = sqlgrey # Note: the following are not used with SQLite # db_host = localhost # db_port = default # db_user = sqlgrey # db_pass = spaces_are_not_supported # # For custom options (e.g. SSL), the whole dsn string may be specified # (overrides db_type, db_name, db_host, db_port) # db_dsn = DBI:SQLite:dbname=/path/to/database.db # db_dsn = DBI:mysql:database=sqlgrey;host=localhost;port=3306 # # db_prepare_cache = 0 # use prepared statements cache # BEWARE: memory leaks have been reported # when it is active # db_cleandelay = 1800 # in seconds, how much time between database cleanups # clean_method = sync # sync : cleanup is done in the main process, # delaying other operations # async: cleanup is done in a forked process, # it won't delay mail processing # BEWARE: lockups have been reported # and are still investigated ## Database clustering (for advanced setups) # # See README.DBCLUSTER # # Writes will be done to db_host specified above, and reads will be done # from read_hosts specified below # # Valid options: on/off. If set to 'on', clustering will be enabled. # db_cluster = on # # Comma seperated list of read-only db-servers. # read_hosts= slave-db-1.test.com, slave-db-2.test.com ,slave-db-3.test.com # read_hosts=localhost ## X-Greylist header added? # This adds delay, whitelist and autowhitelist information in the headers # prepend = 1 ## Greylisting method: # - full : greylist by IP address # - classc : greylist by class C network. eg: # 2.3.4.6 connection accepted if 2.3.4.145 did connect earlier. # - smart : greylist by class C network unless there is no reverse lookup # or it looks like a home-user address. # NOTE: IPv6 addresses are treated the same way in 'classc' and 'smart': # First the algorithm decides whether the address is in a EUI-64 form # or not. If it is then the whole /64 subnet is regarded as "class C" # and all the hosts from that subnet are greylisted with the same # rule. For non-EUI-64 addresses the full address is processed. # Default is smart # greymethod = smart ## Optin/Optout (see README.OPTINOUT for details) # - none : everyone is greylisted (default) # - optin : one must optin to have its (incoming) messages being greylisted # - optout : one must optout to not have its messages being greylisted # optmethod = none ## Discriminating Greylisting (see README.DISCRIMINATION) # - off : normal greylisting # - on : Only apply greylisting to senders that do not pass the regexp test. # # discrimination = off # Display the number of the regular expression causing the greylisting # at the end of the reject message. # Values: on/off # discrimination_add_rulenr = off ## SQLgrey return value. # SQLgrey can tell Postfix to: # - immediately reject a message with a temporary reject code # - only do so if following rules would allow the message to pass # The first choice will prevent Postfix from spending time evaluating # potentially expensive rules. # In some cases you may want following rules to be aware of the connection # this. # # We can specify a different rejection strategy for the first connection # attempt, and for early reconnections. 'immed' chooses immediate rejection # 'delay' choose delayed rejection # # By default we use delay on first attempt # reject_first_attempt = delay # Default for early reconnection is the value affected to reject_first_attempt # reject_early_reconnect = delay # Use specific reject code - Only used if reject_first_attempt/reject_early_reconnect = immed # (Some "odd" mailservers actually bounce on 450 but not 451) # reject_code = 451 # reject_code = dunno ## Update server # where to get updates for whitelists # whitelists_host = sqlgrey.bouton.name ## Postmaster address # who gets urgent notifications (DB is down for example) # empty: don't send mail notifications # default: # admin_mail = postmaster sqlgrey-1.8.0/init/000077500000000000000000000000001171713015400141515ustar00rootroot00000000000000sqlgrey-1.8.0/init/sqlgrey000077500000000000000000000012761171713015400155730ustar00rootroot00000000000000#!/bin/sh # # sqlgrey: Init script for sqlgrey postfix policy service # # chkconfig: 345 90 10 # description: SQLgrey is a postfix grey-listing policy service. # pidfile: /var/run/sqlgrey.pid # Source function library. . /etc/init.d/functions # See how we were called. case "$1" in start) echo -n "Starting SQLgrey: " # SQLite put files in the working directory cd ~sqlgrey sqlgrey -d echo_success echo ;; stop) echo -n "Shutting down SQLgrey: " sqlgrey -k echo_success echo ;; status) status sqlgrey ;; restart) $0 stop sleep 1 # hack: missing REUSEADDR from Net::Server? $0 start ;; *) echo "Usage: sqlgrey {start|stop|status|restart}" exit 1 esac exit 0 sqlgrey-1.8.0/init/sqlgrey.debian000077500000000000000000000020741171713015400170110ustar00rootroot00000000000000#!/bin/sh # # sqlgrey: Init script for sqlgrey postfix policy service # # chkconfig: 345 90 10 # description: SQLgrey is a postfix grey-listing policy service. # pidfile: /var/run/sqlgrey.pid # # Hacked from the RH version Karl O. Pinc # Source function library. #. /etc/init.d/functions SQLGREY=/usr/sbin/sqlgrey # See how we were called. case "$1" in start) echo -n "Starting sqlgrey: " # SQLite put files in the working directory ERRMSG=$(/sbin/start-stop-daemon --chdir ~sqlgrey --pidfile /var/run/sqlgrey.pid --oknodo --startas $SQLGREY --start -- -d 2>&1) if [ $? != 0 ]; then echo "(FAILED)" [ "$ERRMSG" ] && echo "ERROR: $ERRMSG" >&2 || true exit 1 fi [ "$ERRMSG" ] && echo -n " ($ERRMSG)" >&2 || true echo "done." ;; stop) echo -n "Stopping sqlgrey:" sqlgrey -k echo " done." start-stop-daemon --start --exec $SQLGREY -- -k ;; restart) $0 stop sleep 1 # hack: missing REUSEADDR from Net::Server? $0 start ;; *) echo "Usage: sqlgrey {start|stop|restart}" exit 1 esac exit 0 sqlgrey-1.8.0/init/sqlgrey.gentoo000077500000000000000000000010401171713015400170520ustar00rootroot00000000000000#!/sbin/runscript # Copyright 1999-2004 Lionel Bouton # Distributed under the terms of the GNU General Public License v2 depend() { use logger before mta # pg_autovacuum waits for a fully started PostgreSQL after pg_autovacuum postgresql mysql } start() { ebegin "Starting SQLgrey" # SQLite puts files in the working directory cd ~sqlgrey sqlgrey -d eend $? } stop() { ebegin "Shutting down SQLgrey" sqlgrey -k eend $? } # hack: seems Net::Server doesn't set REUSEADDR on socket? svc_restart() { svc_stop sleep 1 svc_start } sqlgrey-1.8.0/lib/000077500000000000000000000000001171713015400137545ustar00rootroot00000000000000sqlgrey-1.8.0/lib/DBIx-DBCluster-0.01/000077500000000000000000000000001171713015400167435ustar00rootroot00000000000000sqlgrey-1.8.0/lib/DBIx-DBCluster-0.01/Changes000066400000000000000000000003031171713015400202320ustar00rootroot00000000000000Revision history for Perl extension DBIx::DBCluster. 0.01 Tue Jun 17 13:54:47 2003 - original version; framework created by h2xs 1.21 2006 - Modified for use in sqlgrey by Dan Faerch sqlgrey-1.8.0/lib/DBIx-DBCluster-0.01/DBCluster.pm000066400000000000000000000437411171713015400211410ustar00rootroot00000000000000###################################################################### # Description: Wrapper around DBI's database handler that allows # # connecting to multiple mirrored DB servers in order # # to distribute load # # Author: Alex Rak (arak@cpan.org) # # Version: 0.01 (17-June-2003) # # Copyright: See COPYRIGHT section in POD text below for usage and # # distribution rights # ###################################################################### package DBIx::DBCluster; use 5.006; use strict; use warnings; use Carp; use Data::Dumper; use DBI; DBI->require_version(1.37); our $VERSION = "0.01"; our $AUTOLOAD; our $CLUSTERS; our $DEBUG; our @WRITE_COMMANDS; our $WRITE_HOSTS_NEVER_READ; my %PRIVATE; eval "require DBIx::DBCluster::Config"; sub connect { my $class = shift; my ($dsn, $user, $pass, $attr, $old_driver) = my @orig_args = @_; my ($write_dbh,$read_dbh); my $hostname = _get_hostname($dsn); _debug("Analyzing this hostname/label: $hostname"); _debug("No such label found in cluster definitions - will try this as a hostname") unless defined $CLUSTERS->{$hostname}; return DBI->connect(@orig_args) unless defined $CLUSTERS->{$hostname}; my $cluster = $CLUSTERS->{$hostname}; croak "WRITE_HOSTS are not declared in $hostname cluster configuration" unless (defined $cluster->{'WRITE_HOSTS'} && $#{$cluster->{'WRITE_HOSTS'}} != -1); croak "READ_HOSTS are not declared in $hostname cluster configuration" unless (defined $cluster->{'READ_HOSTS'} && $#{$cluster->{'READ_HOSTS'}} != -1); ## Set up WRITE host _debug("Loading WRITE_HOSTS for $hostname: '" . join("','",@{$cluster->{'WRITE_HOSTS'}}), "'"); my $start_point = int(rand($#{$cluster->{'WRITE_HOSTS'}} + 1)); my $write_host; for (0 .. $#{$cluster->{'WRITE_HOSTS'}}){ $write_host = @{$cluster->{'WRITE_HOSTS'}}[$start_point]; _debug("Trying $write_host..."); my $new_dsn = _rebuild_dsn($dsn,$hostname,$write_host); $write_dbh = DBI->connect($new_dsn, $user, $pass, $attr, $old_driver); if ($write_dbh){ _debug("Looks good - will use this one for writing"); last; } _debug("$write_host is no good"); $start_point++; $start_point = 0 if $start_point > $#{$cluster->{'WRITE_HOSTS'}}; } unless ($write_dbh){ carp "Could not connect to any server in WRITE_HOSTS"; return; } ## Set up READ host _debug("Loading READ_HOSTS for $hostname: '" . join("','",@{$cluster->{'READ_HOSTS'}}), "'"); $start_point = int(rand($#{$cluster->{'READ_HOSTS'}} + 1)); for (0 .. $#{$cluster->{'READ_HOSTS'}}){ my $read_host = @{$cluster->{'READ_HOSTS'}}[$start_point]; _debug("Trying $read_host..."); if ($read_host eq $write_host){ $read_dbh = $write_dbh; _debug("This one is good and is used for writing - will use for reading too"); last; } my $new_dsn = _rebuild_dsn($dsn,$hostname,$read_host); $read_dbh = DBI->connect($new_dsn, $user, $pass, $attr, $old_driver); if ($read_dbh){ _debug("Looks good - will use this one for reading"); last; } _debug("$read_host is no good"); $start_point++; $start_point = 0 if $start_point > $#{$cluster->{'READ_HOSTS'}}; } unless ($read_dbh){ carp "Could not connect to any server in READ_HOSTS"; return; } my $read_value = $#{$cluster->{'READ_HOSTS'}} + 1; my $write_value = $#{$cluster->{'WRITE_HOSTS'}} + 1; _debug("Effective RW_RATIO set to ${read_value}:${write_value}"); _debug("Database handler created"); if ($write_dbh->{AutoCommit} != $read_dbh->{AutoCommit}){ carp "READ and WRITE databases have different default AutoCommit value - set AutoCommit explicitly diring connect statement"; } my @tables; foreach ($write_dbh->tables(undef,undef,undef,undef)){ $_ =~ s/\.//g; push @tables, $_ if $_; } my $self = bless ( {}, __PACKAGE__ . "::db" ); $PRIVATE{$self} = { ALL_TABLES => \@tables, LAST_ACTIVE => 'WRITE_DBH', MOD_TABLES => {}, ORIG_ARGS => \@orig_args, QUERY_STATE => 'NORMAL', READ_COUNT => 0, READ_DBH => $read_dbh, RW_RATIO => ($read_value / $write_value), WRITE_COUNT => 0, WRITE_DBH => $write_dbh, }; return $self; } sub _debug { my $message = shift; print STDERR __PACKAGE__ . " $message\n" if $DBIx::DBCluster::DEBUG; } sub _get_hostname { my $driver_args = (split(':', shift))[2]; return '' unless $driver_args; $driver_args =~ /^.+\@((.+))$/; return $2 if $2; # $driver_args =~ /^.+\@(.+)$/; # if ($1){ return $1 } ; # For some strange resaon $1 ALWAYS contains programname (like $0) under some scripts # Coulndt figure out why, so came up with the above ugly little hack. # $driver_args =~ /^.+\@(.+)$/; # return $1 if $1; $driver_args =~ /host=([^;]+)/; return $1 if $1; croak "Could not extract hostname from DSN; non-ODBC compliant DSN format?"; } sub _rebuild_dsn { my ($dsn,$cluster_name,$hostname) = @_; my ($dbi,$driver,$driver_args) = split(':',$dsn); if ($driver_args =~ m/^.+\@$cluster_name$/){ $driver_args =~ s/\@$cluster_name$/\@$hostname/; return "$dbi:$driver:$driver_args"; } elsif ($driver_args =~ m/host=$cluster_name/){ $driver_args =~ s/host=$cluster_name/host=$hostname/; return "$dbi:$driver:$driver_args"; } croak "Could not rebuild DSN with modified hostname; non-ODBC compliant DSN format?"; } sub AUTOLOAD { my $self = shift; my $type = ref($self) || return; my $name = $AUTOLOAD; $name =~ s/.*://; if (@_){ return DBI->$name(@_); } else { return DBI->$name; } } sub DESTROY {} ###################################################################### package DBIx::DBCluster::db; use Carp; our $AUTOLOAD; sub begin_work { my $self = shift; return $self->_transaction_method('begin_work','TRANSACTION_SELECT'); } sub commit { my $self = shift; return $self->_transaction_method('commit','NORMAL'); } sub clone { my ($old_dbh, $attr) = @_; _debug("Trying to create a clone"); my @new_args = @{$PRIVATE{$old_dbh}->{ORIG_ARGS}}; push @new_args, $attr if $attr; return DBIx::DBCluster->connect(@new_args); } sub do { my $self = shift; my $sql = shift; return $self->_query_method('do', $sql, @_); } sub prepare { my $self = shift; my $sql = shift; return $self->_query_method('prepare', $sql, @_); } sub prepare_cached { my $self = shift; my $sql = shift; return $self->_query_method('prepare_cached', $sql, @_); } sub rollback { my $self = shift; return $self->_transaction_method('rollback','NORMAL'); } sub selectall_arrayref { my $self = shift; my $sql = shift; return $self->_query_method('selectall_arrayref', $sql, @_); } sub selectcol_arrayref { my $self = shift; my $sql = shift; return $self->_query_method('selectcol_arrayref', $sql, @_); } sub selectrow_array { my $self = shift; my $sql = shift; return $self->_query_method('selectrow_array', $sql, @_); } sub selectrow_arrayref { my $self = shift; my $sql = shift; return $self->_query_method('selectrow_arrayref', $sql, @_); } sub selectrow_hashref { my $self = shift; my $sql = shift; return $self->_query_method('selectrow_hashref', $sql, @_); } sub _choose_server { my $self = shift; my $param = shift || ''; my $vars = $PRIVATE{$self}; if ($param eq 'READ_DBH'){ $vars->{READ_COUNT} ++; return $vars->{LAST_ACTIVE} = 'READ_DBH'; } elsif ($param eq 'WRITE_DBH'){ $vars->{WRITE_COUNT} ++; return $vars->{LAST_ACTIVE} = 'WRITE_DBH'; } unless ($vars->{READ_COUNT}){ $vars->{READ_COUNT} = 1; return $vars->{LAST_ACTIVE} = 'READ_DBH'; } unless ($vars->{WRITE_COUNT}){ $vars->{WRITE_COUNT} = 1; return $vars->{LAST_ACTIVE} = 'WRITE_DBH'; } if ( ($vars->{READ_COUNT} / $vars->{WRITE_COUNT}) < $vars->{RW_RATIO} ){ $vars->{READ_COUNT} ++; return $vars->{LAST_ACTIVE} = 'READ_DBH'; } else { $vars->{WRITE_COUNT} ++; return $vars->{LAST_ACTIVE} = 'WRITE_DBH'; } } sub _compare_tables_used { my $self = shift; my $sql = shift; foreach ($self->_get_tables_used($sql)){ return 1 if $PRIVATE{$self}->{MOD_TABLES}->{$_}; } return 0; } sub _debug { my $message = shift; print STDERR __PACKAGE__ . " $message\n" if $DBIx::DBCluster::DEBUG; } sub _dumper { my $self = shift; return $PRIVATE{$self}; } sub _get_tables_used { my $self = shift; my $sql = shift; my %tables; for (@{$PRIVATE{$self}->{ALL_TABLES}}){ $tables{$_} = 1 if $sql =~ m/\b$_\b/ig; } return keys %tables; } sub _is_write_statement { my $sql = shift; for (@WRITE_COMMANDS){ return 1 if $sql =~ m/\b$_\b/ig; } return; } sub _query_method { my $self = shift; my $command = shift; my $sql = shift; _debug("Issuing '$command' on the following sql: $sql"); if ($PRIVATE{$self}->{WRITE_DBH}->{AutoCommit} == 0 && $PRIVATE{$self}->{QUERY_STATE} eq 'NORMAL'){ $PRIVATE{$self}->{QUERY_STATE} = 'TRANSACTION_SELECT'; } my $result; if (_is_write_statement($sql)){ foreach ($self->_get_tables_used($sql)){ $PRIVATE{$self}->{MOD_TABLES}->{$_} = 1; } my $server = $self->_choose_server('WRITE_DBH'); _debug("Statement directed to $server"); $PRIVATE{$self}->{QUERY_STATE} = 'TRANSACTION_WRITE' if $PRIVATE{$self}->{QUERY_STATE} eq 'TRANSACTION_SELECT'; $result = $PRIVATE{$self}->{$server}->$command($sql, @_); } else { my $selection; if ($PRIVATE{$self}->{QUERY_STATE} eq 'TRANSACTION_WRITE' || $self->_compare_tables_used($sql)){ $selection = 'WRITE_DBH'; } else { $selection = ($WRITE_HOSTS_NEVER_READ)?'READ_DBH':'AUTO'; } my $server = $self->_choose_server($selection); _debug("Read Statement directed to $server"); $result = $PRIVATE{$self}->{$server}->$command($sql, @_); } if ($sql =~ m/\b(create|alter|drop)\b/ig){ my @tables; foreach ($PRIVATE{$self}->{WRITE_DBH}->tables(undef,undef,undef,undef)){ $_ =~ s/\.//g; push @tables, $_ if $_; } $PRIVATE{$self}->{ALL_TABLES} = \@tables; foreach ($self->_get_tables_used($sql)){ $PRIVATE{$self}->{MOD_TABLES}->{$_} = 1; } } return $result; } sub _transaction_method { my $self = shift; my ($command, $state) = @_; my $vars = $PRIVATE{$self}; $vars->{MOD_TABLES} = {}; $vars->{WRITE_DBH}->$command; $vars->{READ_DBH}->$command unless $vars->{WRITE_DBH} == $vars->{READ_DBH}; if ($vars->{WRITE_DBH}->err){ $vars->{LAST_ACTIVE} = 'WRITE_DBH'; carp $vars->{WRITE_DBH}->err; } if ($vars->{READ_DBH}->err){ $vars->{LAST_ACTIVE} = 'READ_DBH'; carp $vars->{READ_DBH}->err; } $vars->{QUERY_STATE} = $state; return 1; } sub AUTOLOAD { my $self = shift; my $type = ref($self) || return; my $name = $AUTOLOAD; $name =~ s/.*://; my $vars = $PRIVATE{$self}; if (exists $vars->{$vars->{LAST_ACTIVE}}->{$name} && @_){ my $r_1 = $vars->{READ_DBH}->{$name} = @_; my $r_2 = $vars->{WRITE_DBH}->{$name} = @_; return (defined $r_1 && defined $r_2 ? $r_1 : undef); } elsif (exists $vars->{$vars->{LAST_ACTIVE}}->{$name}){ return $vars->{$vars->{LAST_ACTIVE}}->{$name}; } elsif (@_){ my $r_1 = $vars->{READ_DBH}->$name(@_); my $r_2 = $vars->{WRITE_DBH}->$name(@_); return (defined $r_1 && defined $r_2 ? $r_1 : undef); } else { return $vars->{$vars->{LAST_ACTIVE}}->$name; } } sub DESTROY { my $self = shift; delete $PRIVATE{$self}; } ###################################################################### 1; __END__ =head1 NAME DBIx::DBCluster - Distribute load among mirrored database servers =head1 VERSION This document describes version 0.01 of DBIx::DBCluster, released June 17, 2003. =head1 STATUS This module is currently being tested in development environment and should be considered beta code. =head1 SYNOPSIS use DBIx::DBCluster; my $dbh = DBIx::DBCluster->connect($data_source, $username, $auth, \%attr); =head1 BACKGROUND =head2 The problem The idea of having multiple database servers that mirror the same database seems fairly simple. Most modern databases provide built-in tools and mechanisms for seamless, virtually instant automatic replication. If you're not trying to just back up your primary database, but actually use all your mirrors in production trying to achieve load balancing -- you will face the challenge of maintaining data integrity. Somewhere, you will need a mechanism that could filter your requests to the database and decide whether it is safe to direct specific request to any available server, or to a specific one. =head2 The solution Since most perl-based applications use DBI module for interacting with databases, a wrapper around DBI's database handler seemed to be the right place to implement the logic. It also requires bare minimum of changes to your existing code. =head1 DESCRIPTION C creates a database handler object that acts like, and has exactly the same properties and methods as DBI's database handler. In the background it creates multiple database connections to mirrored database servers. Acts as an application level load balancer. It is assumed that you have a cluster of database servers set up with one-way or two-way replication. Load balancing in two-way replication set-up is comparatively simple since you can both read and write to any server. This module is designed primarily for one-way replication set-up. In the latter case you can write only to the master server and read from any read-only slave server. Since the number of reads usually dominates anyway, there is a real advantage to having multiple read-only servers and deligate most read requests to them. This database handler object creates two transparent database connections - one designated for modifying statements, the other one for non-modifying statements. Any statement you issue is analyzed and directed to one server or the other. Servers are randomly picked from the list you pre-define. In order to utilize multiple connection capabilities you need to define a server cluster. Each cluster has (1) a list of servers that can be used for modifying statements, i.e. WRITE_SERVERS, and (2) a list of servers that can be used for non-modifying statements, i.e. READ_SERVERS. =head1 METHODS AND ATTRIBUTES =over =item connect This method takes the same arguments as Cconnect()> method. A special note about $data_source argument or DSN. In order to utilize load balancing capabilities your DSN should (1) explicitly specify hostname and (2) be ODBC compliant, i.e be in one of the following formats: dbi:DriverName:database_name@hostname:port dbi:DriverName:database=database_name;host=hostname;port=port The hostname will be extracted from the DSN and analyzed. If you have a cluster with the same label configured - your cluster configuration will override actual hostname when establishing database connection(s). For that matter the C portion of your DSN doesn't even have to be a valid hostname - it can be just a label of your cluster. If your hostname doesn't correspond with one of the pre-defined cluster labels though, it will be treated as a real hostname and the module will try to connect to it. No load balancing will happen in the latter case. =back All other methods and attributes are inherited from DBI's database handler. See documentation for DBI package, section "DBI DATABASE HANDLE OBJECTS". =head1 CONFIGURATION VARIABLES Any of the variables below can be set explicitly in your script or placed in a configuration file and loaded via C. By default, configuration data is pulled from C module. Feel free to edit this file directly if you need to set up universal configuration. =over =item $DBIx::DBCluster::CLUSTERS This is a hashref that defines your clusters. This variable I be defined somewhere or you will not have load balancing. Here's the format: $DBIx::DBCluster::CLUSTERS = { 'cluster_label' => { 'WRITE_HOSTS' => ['db1.mydomain.com'], 'READ_HOSTS' => ['db2.mydomain.com','db3.mydomain.com','db4.mydomain.com'], }, }; =item @DBIx::DBCluster::WRITE_COMMANDS An array of SQL keywords that will denote your statement as modifying or write statement. You probably won't have to modify this, but you can if you need to. The difault is: @DBIx::DBCluster::WRITE_COMMANDS = qw( ALTER CREATE DELETE DROP INSERT LOCK RENAME REPLACE SET TRUNCATE UNLOCK UPDATE ); =item $DBIx::DBCluster::DEBUG When set to true debug infromation is printed to STDERR. =back =head1 EXAMPLES Traditionally you would use DBI in way similar to use DBI; my $dbh = DBI->connect('DBI:mysql:test@db1.mydomain.com:3306', 'testuser', 'testpassword'); my $sth = $dbh->prepare('select * from test'); $sth->execute; while (my $data = $sth->fetchrow_hashref){ ## do something with $data } In a cluster set-up you would need to replace the top two lines. Instead of use DBI; my $dbh = DBI->connect('DBI:mysql:test@db1.mydomain.com:3306', 'testuser', 'testpassword'); you will have use DBIx::DBCluster; my $dbh = DBIx::DBCluster->connect('DBI:mysql:test@db1.mydomain.com:3306', 'testuser', 'testpassword'); The rest of your code needs no modifications. It is recommended that you put all your cluster definitions in DBIx::DBCluster::Config module so that you don't have to define clusters in every script. Alternatively, you can put your definitions in a central file, say Config.pl and load it up with C: use DBIx::DBCluster; require "/path/to/config_file/Config.pl"; my $dbh = DBIx::DBCluster->connect('DBI:mysql:test@db1.mydomain.com:3306', 'testuser', 'testpassword'); Yet another way to define your clusters is to do so explicitly in your script use DBIx::DBCluster; $DBIx::DBCluster::CLUSTERS = { 'db1.mydomain.com' => { 'WRITE_HOSTS' => ['db1.mydomain.com'], 'READ_HOSTS' => ['db2.mydomain.com','db3.mydomain.com','db4.mydomain.com'], }, }; my $dbh = DBIx::DBCluster->connect('DBI:mysql:test@db1.mydomain.com:3306', 'testuser', 'testpassword'); =head1 AUTHOR Alex Rak B =head1 COPYRIGHT Copyright (c) 2003 Alex Rak. All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =head1 SEE ALSO The DBI module =cut sqlgrey-1.8.0/lib/DBIx-DBCluster-0.01/MANIFEST000066400000000000000000000001261171713015400200730ustar00rootroot00000000000000Changes DBCluster.pm Makefile.PL MANIFEST README lib/DBIx/DBCluster/Config.pm test.pl sqlgrey-1.8.0/lib/DBIx-DBCluster-0.01/Makefile.PL000066400000000000000000000004211171713015400207120ustar00rootroot00000000000000use ExtUtils::MakeMaker; WriteMakefile( 'NAME' => 'DBIx::DBCluster', 'VERSION_FROM' => 'DBCluster.pm', 'PREREQ_PM' => { DBI => 1.37 }, ($] >= 5.005 ? (ABSTRACT_FROM => 'DBCluster.pm', AUTHOR => 'Alex Rak ') : ()), ); sqlgrey-1.8.0/lib/DBIx-DBCluster-0.01/README000066400000000000000000000013551171713015400176270ustar00rootroot00000000000000DBIx/DBCluster version 0.01 =========================== This module creates a database handler object that acts like, and has exactly the same properties and methods as DBI's database handler. In the background it creates multiple database connections to mirrored database servers. Acts as an application level load balancer. INSTALLATION To install this module type the following: perl Makefile.PL make make test make install DEPENDENCIES This module requires these other modules and libraries: DBI version 1.37 or higher COPYRIGHT AND LICENCE Copyright (c) 2003 Alex Rak (arak@cpan.org). All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. sqlgrey-1.8.0/lib/DBIx-DBCluster-0.01/lib/000077500000000000000000000000001171713015400175115ustar00rootroot00000000000000sqlgrey-1.8.0/lib/DBIx-DBCluster-0.01/lib/DBIx/000077500000000000000000000000001171713015400202775ustar00rootroot00000000000000sqlgrey-1.8.0/lib/DBIx-DBCluster-0.01/lib/DBIx/DBCluster/000077500000000000000000000000001171713015400221265ustar00rootroot00000000000000sqlgrey-1.8.0/lib/DBIx-DBCluster-0.01/lib/DBIx/DBCluster/Config.pm000066400000000000000000000005161171713015400236730ustar00rootroot00000000000000package DBIx::DBCluster::Config; our $VERSION = "0.01"; $DBIx::DBCluster::CLUSTERS = { 'ExampleP' => { 'WRITE_HOSTS' => ['host1','host2'], 'READ_HOSTS' => ['host3','host4','host5','host6','host7'], }, }; @DBIx::DBCluster::WRITE_COMMANDS = qw( ALTER CREATE DELETE DROP INSERT LOCK RENAME REPLACE SET TRUNCATE UNLOCK UPDATE ); sqlgrey-1.8.0/lib/DBIx-DBCluster-0.01/test.pl000066400000000000000000000040221171713015400202550ustar00rootroot00000000000000use Test::Simple tests => 7; use DBIx::DBCluster; use Data::Dumper; $DBIx::DBCluster::DEBUG = 0; my $dbh = DBIx::DBCluster->connect('dbi:ExampleP:test@ExampleP', '', '', { PrintError => 0 }); ok( $dbh, 'Cluster initiated'); my $vars = $dbh->_dumper; my $read_dbh = $vars->{READ_DBH}; ok( $read_dbh && ref($read_dbh) eq 'DBI::db' && $read_dbh->ping, 'Read handler is good' ); my $write_dbh = $vars->{WRITE_DBH}; ok( $write_dbh && ref($write_dbh) eq 'DBI::db' && $write_dbh->ping, 'Write handler is good' ); ## Issue 14 statements $dbh->do("select whatever"); $dbh->do("select whatever"); $dbh->do("select whatever"); $dbh->do("select whatever"); $dbh->do("select whatever"); $dbh->do("select whatever"); $dbh->do("insert whatever"); $dbh->do("insert whatever"); $dbh->do("select whatever"); $dbh->do("select whatever"); $dbh->do("select whatever"); $dbh->do("select whatever"); $dbh->do("select whatever"); $dbh->do("select whatever"); $vars = $dbh->_dumper; ok( $vars->{READ_COUNT} == 10 && $vars->{WRITE_COUNT} == 4, 'Simple statements are good' ); $dbh->begin_work; $dbh->do("select whatever"); $dbh->do("select whatever"); $dbh->do("select whatever"); $dbh->do("select whatever"); $dbh->do("select whatever"); $dbh->do("select whatever"); $dbh->do("select whatever"); $vars = $dbh->_dumper; ok( $vars->{READ_COUNT} == 15 && $vars->{WRITE_COUNT} == 6, 'Transactions phase 1 is good' ); $dbh->do("insert whatever"); $dbh->do("select whatever"); $dbh->do("select whatever"); $dbh->do("select whatever"); $dbh->do("insert whatever"); $dbh->do("select whatever"); $dbh->do("select whatever"); $vars = $dbh->_dumper; ok( $vars->{READ_COUNT} == 15 && $vars->{WRITE_COUNT} == 13, 'Transactions phase 2 is good' ); $dbh->commit; $dbh->do("insert whatever"); $dbh->do("select whatever"); $dbh->do("select whatever"); $dbh->do("select whatever"); $dbh->do("insert whatever"); $dbh->do("select whatever"); $dbh->do("select whatever"); $vars = $dbh->_dumper; ok( $vars->{READ_COUNT} == 20 && $vars->{WRITE_COUNT} == 15, 'Transactions phase 3 is good' ); sqlgrey-1.8.0/lib/README.DBIx-DBCluster-sqlgrey000066400000000000000000000025221171713015400207330ustar00rootroot00000000000000 This package is included in the sqlgrey distribution for 3 reasons. 1. I couldnt really get dynamic loading, based on the existense of the module to work. 2. Ive added/changed a few things to DBCluster.pm. 3. The module has disapeared from the official CPAN. I wrote to the maintainer of DBCluster, but got no reply. So if i want to keep my additions, ill have to include them here :) NOTE: If anyone knows of a module that can replace this one, that is still being maintained, please let me know. The most significant addition is the WRITE_HOSTS_NEVER_READ option. By default, if you add eg. 1. write_host (eg. mysql master) and 1 read_hosts (mysql slave), this module will also use the write host for reading. This is bad news in my setup.. Every mailserver has a mysql-slave running on localhost. 1 master-server takes all the writes. So the correct setup is: read_host = localhost write_host = my-master.somewhere.net Since i didnt want 20 mailservers doing reads from BOTH localhost and the master, i had to add this option that prohibits reads from write_hosts. (This can be overridden if you add the master-sql as a read_hosts as well). Other than that, im fairly sure that sqlgrey will work fine with the original DBCluster, if you should wish to do so. ------- Original author: Alex Rak - arak at cpan.org Modifications: dan at hacker.dk sqlgrey-1.8.0/sqlgrey000077500000000000000000002721761171713015400146410ustar00rootroot00000000000000#!/usr/bin/perl -w # sqlgrey: a postfix greylisting policy server using an SQL backend # based on postgrey # Copyright 2004 (c) ETH Zurich # Copyright 2004-2007 (c) Lionel Bouton # Parts copyrighted 2005-2007 Dan Faerch # Parts copyrighted 2009 Michal Ludvig # Parts copyright 2012 Martin Matuska # # 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., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA # # see the documentation with 'perldoc sqlgrey' package sqlgrey; use strict; use Pod::Usage; use Getopt::Long 2.25 qw(:config posix_default no_ignore_case); use Net::Server::Multiplex; use DBI; use Math::BigInt; use POSIX ':sys_wait_h'; use vars qw(@ISA); @ISA = qw(Net::Server::Multiplex); my $VERSION = "1.8.0"; my $software = 'SQLgrey-' . $VERSION; my $DB_VERSION = 3; # Table names my $connect = 'connect'; my $from_awl = 'from_awl'; my $domain_awl = 'domain_awl'; my $optin_domain = 'optin_domain'; my $optin_email = 'optin_email'; my $optout_domain = 'optout_domain'; my $optout_email = 'optout_email'; my $config = 'config'; # defaults my %dflt; $dflt{loglevel} = 2; # used for $dflt{log} entries in read_conffile() $dflt{user} = 'sqlgrey'; $dflt{group} = 'sqlgrey'; $dflt{pidfile} = '/var/run/sqlgrey.pid'; $dflt{conf_dir} = '/etc/sqlgrey'; $dflt{reconnect_delay} = 5; # 5 minutes $dflt{max_connect_age} = 24; # 24 hours $dflt{awl_age} = 60; # 60 days $dflt{group_domain_level} = 2; # 2 e-mail addr from same domain/IP $dflt{reject_first_attempt} = 'delay'; # Use 'delay' or 'immed' $dflt{reject_early_reconnect} = undef; # Leave undef $dflt{connect_src_throttle} = 0; # 0 = Don't throttle $dflt{db_type} = 'Pg'; $dflt{db_name} = 'sqlgrey'; $dflt{db_host} = 'localhost'; $dflt{db_port} = 'default'; $dflt{db_dsn} = ''; $dflt{db_user} = 'sqlgrey'; $dflt{db_pass} = ''; $dflt{db_prepare_cache} = 0; $dflt{db_cluster} = 'off'; $dflt{prepend} = 1; $dflt{greymethod} = 'smart'; $dflt{optmethod} = 'none'; # or 'optin' or 'optout' $dflt{db_cleandelay} = 30 * 60; $dflt{clean_method} = 'sync'; $dflt{admin_mail} = 'postmaster'; $dflt{log_ident} = undef; $dflt{reject_code} = '450'; $dflt{discrimination} = 0; $dflt{discrimination_add_rulenr} = 0; $dflt{log} = { # note values here are not used 'grey' => 2, 'whitelist' => 2, 'optin' => 2, 'spam' => 2, 'mail' => 2, 'dbaccess' => 2, 'martians' => 2, 'perf' => 2, 'system' => 2, 'conf' => 2, 'other' => 2, }; # Default configuration file my $config_file = '/etc/sqlgrey/sqlgrey.conf'; # whitelist files my $stat_ip_whitelist_file = $dflt{conf_dir} . '/clients_ip_whitelist'; my $dyn_ip_whitelist_file = $dflt{conf_dir} . '/clients_ip_whitelist.local'; my $stat_fqdn_whitelist_file = $dflt{conf_dir} . '/clients_fqdn_whitelist'; my $dyn_fqdn_whitelist_file = $dflt{conf_dir} . '/clients_fqdn_whitelist.local'; # regexp files my $smtp_server_regexp_file = $dflt{conf_dir} . '/smtp_server.regexp'; my $dyn_fqdn_regexp_file = $dflt{conf_dir} . '/dyn_fqdn.regexp'; my $discrimination_regexp_file = $dflt{conf_dir} . '/discrimination.regexp'; my $prepend = 'PREPEND X-Greylist: '; my $reload = 0; # non-zero signals a regexps/whitelists reload request my $ref_to_sqlgrey; # we need this global var to access sqlgrey functions # in signal handlers # non-configurable defaults my $proto = 'tcp'; my $port = 'localhost:2501'; sub mylog($$$$) { my ($self, $logtype, $loglevel, $message) = @_; $message =~ s/%/%%/g; # protect sprintf used by Syslog if (!defined $self->{sqlgrey}{log}{$logtype}) { # Protect against syslog going down eval { $self->log($loglevel, "Unknown logtype ($logtype): $message"); }; } if ($loglevel <= $self->{sqlgrey}{log}{$logtype}) { # workaround: we can't disable the TCP connections # logs if we use log_level 4 so log_level is capped by default $loglevel = $loglevel > $self->{server}{log_level} ? $self->{server}{log_level} : $loglevel; eval { $self->log($loglevel, "$logtype: $message"); } } } # Send mails sub sendmail($$$) { my $self = shift; my $subject = shift; my $content = shift; my $now = time; return if $self->{sqlgrey}{admin_mail} eq ''; # this code throttles the message rate # fill bucket $self->{sqlgrey}{mail_bucket} += ($now - $self->{sqlgrey}{last_mail})/ (60*$self->{sqlgrey}{mail_period}); $self->{sqlgrey}{last_mail} = $now; # but no more than its capacity $self->{sqlgrey}{mail_bucket} = $self->{sqlgrey}{mail_bucket} < $self->{sqlgrey}{mail_maxbucket} ? $self->{sqlgrey}{mail_bucket} : $self->{sqlgrey}{mail_maxbucket}; $self->mylog('mail', 4, "mail_bucket: $self->{sqlgrey}{mail_bucket}"); # is there room for a mail ? if ($self->{sqlgrey}{mail_bucket} >= 1) { if ($self->{sqlgrey}{mail_bucket} < 2) { $content .= ' (max warn message rate hit, throttling)'; } # actual mail sending my $return = system("echo '$content' | mail -s '$subject' $self->{sqlgrey}{admin_mail}"); if ($return != 0) { if ($? == -1) { $self->mylog('mail', 0, "failed to send: $!\n"); } elsif ($? & 127) { $self->mylog('mail', 0, sprintf('child died with ' . "signal %d, %s coredump\n", ($? & 127), ($? & 128) ? 'with' : 'without')); } else { $self->mylog('mail', 0, sprintf("child exited with value: %d\n", $? >> 8)); } } # empty bucket $self->{sqlgrey}{mail_bucket}--; } } sub mydie($@) { my $self = shift; my @errors = @_; $self->sendmail('SQLgrey died', join("\n", @errors)); die $errors[0]; } ########################## ## Database helper subs ## ########################## # Trigger e-mails when the DB connection's state changes sub db_unavailable($) { my $self = shift; if ($self->{sqlgrey}{db_available}) { if (! defined $self->{sqlgrey}{dbh}) { $self->{sqlgrey}{warn_db} && $self->sendmail('SQLgrey lost database', 'SQLgrey lost database connection to: ' . $self->{sqlgrey}{db_dsn}); } else { $self->disconnectdb(); $self->{sqlgrey}{warn_db} && $self->sendmail('SQLgrey database error', 'SQLgrey encountered an SQL error and triggered a reconnection to: ' . $self->{sqlgrey}{db_dsn}); } $self->{sqlgrey}{db_available} = 0; } } sub db_available($) { my $self = shift; if (! $self->{sqlgrey}{db_available}) { $self->{sqlgrey}{warn_db} && $self->sendmail('SQLgrey recovered DB', 'SQLgrey established connection to: ' . $self->{sqlgrey}{db_dsn}); $self->{sqlgrey}{db_available} = 1; } } # fault (lost connection) tolerant do # allows a RDBMs restart without crash sub do($$) { my $self = shift; my $query = shift; my $result; if (! $self->{sqlgrey}{db_available}) { $self->connectdb(); } if (defined $self->{sqlgrey}{dbh} and ($result = $self->{sqlgrey}{dbh}->do($query))) { $self->db_available(); return $result; } else { # failure $self->db_unavailable(); $self->mylog('dbaccess', 0, "warning: couldn't do query:\n" . "$query:\n" . "$DBI::errstr, reconnecting to DB"); return undef; } } # prepare_cached needs to check for a dbh sub prepare_cached($$) { my $self = shift; my $query = shift; return $self->_prepare($query, $self->{sqlgrey}{db_prepare_cache}); } # Wrapper for prepare without cache sub prepare($$) { my $self = shift; my $query = shift; return $self->_prepare($query, 0); } # prepare* need to check for a dbh # and reconnect if disconnected sub _prepare($$$) { my $self = shift; my $query = shift; my $cache = shift; if (! $self->{sqlgrey}{db_available}) { $self->connectdb(); } if (!defined $self->{sqlgrey}{dbh}) { $self->db_unavailable(); return undef; } else { my $result; if ($cache) { $result = $self->{sqlgrey}{dbh}->prepare_cached($query); } else { $result = $self->{sqlgrey}{dbh}->prepare($query); } if (! defined $result) { $self->db_unavailable(); } else { $self->db_available(); } return $result; } } # quote can't be called directly when dbh is undef # we provide a wrapper # we don't try to reconnect here sub quote($$) { my $self = shift; my $toquote = shift; if (! defined $self->{sqlgrey}{dbh}) { return 'NULL'; } else { return $self->{sqlgrey}{dbh}->quote($toquote); } } # Check if a table exists sub table_exists($$) { my $self = shift; my $tablename = shift; # if we couldn't connect, do as if the table exist defined $self->{sqlgrey}{dbh} or return 1; # Seems the most portable way to do it # but needs SQL error reporting off at connect time :-< # don't use $self->do here (no need to reconnect on error) $self->{sqlgrey}{dbh}->do("SELECT 1 from $tablename LIMIT 0") or return 0; return 1; } # Drop a table sub drop_table($$) { my $self = shift; my $table = shift; $self->do("DROP TABLE $table"); } # Database type queries sub SQLite($) { my $self = shift; return ($self->{sqlgrey}{db_type} eq 'SQLite'); } sub PostgreSQL($) { my $self = shift; return ($self->{sqlgrey}{db_type} eq 'Pg'); } sub MySQL($) { my $self = shift; return ($self->{sqlgrey}{db_type} eq 'mysql'); } # build a SQL representation of a timestamp with a given # interval from now # we use $self->{sqlgrey}{dbnow} to make sure the SQL function # now() can't make the optimizer think the value can change # and make the DB evaluate it for *each* row of the table we'll select from sub past_tstamp($$$) { my ($self, $nb, $unit) = @_; if ($self->MySQL()) { # MySQL doesn't want any ' char return 'timestamp ' . $self->{sqlgrey}{dbnow} . " - INTERVAL $nb $unit"; } elsif ($self->SQLite()) { my $delay; # SQLite doesn't recognise INTERVAL if ($unit eq 'DAY') { $delay = $nb * 24 * 60 * 60; } elsif ($unit eq 'HOUR') { $delay = $nb * 60 * 60; } elsif ($unit eq 'MINUTE') { $delay = $nb * 60; } else { # catch syntax errors $self->mydie('Interval error', 'interval(' . $nb . ', ' . $unit . ') for SQLite,' . " sqlgrey doesn't recognise $unit UNIT"); } return 'now() - ' . $delay; } else { # use PostgreSQL syntax (probably the most SQL compliant) return 'timestamp ' . $self->{sqlgrey}{dbnow} . " - INTERVAL '" . "$nb $unit" . "'"; } } sub update_dbnow($) { my $self = shift; # no dbnow needed for SQLite return if $self->SQLite(); my $result; my $sth = $self->prepare_cached('SELECT now()'); if (!defined $sth or !$sth->execute()) { $self->db_unavailable(); $self->mylog('dbaccess', 0, "error: couldn't get now() from DB: $DBI::errstr"); return if defined $self->{sqlgrey}{dbnow}; # defined: we don't update the value $self->{sqlgrey}{dbnow} = '0'; } else { $self->db_available(); $result = $sth->fetchall_arrayref(); $self->{sqlgrey}{dbnow} = $self->quote($result->[0][0]); } } # Create tables if not done already sub database_setup($) { my $self = shift; # AWL and connect tables checks if (! $self->table_exists($from_awl)) { $self->create_from_awl_table(); $self->create_from_awl_indexes(); } if (! $self->table_exists($domain_awl)) { $self->create_domain_awl_table(); $self->create_domain_awl_indexes(); } if (! $self->table_exists($connect)) { $self->create_connect_table(); $self->create_connect_indexes(); } # optin/out tables checks if (! $self->table_exists($optin_domain)) { $self->create_optin_domain_table(); } if (! $self->table_exists($optin_email)) { $self->create_optin_email_table(); } if (! $self->table_exists($optout_domain)) { $self->create_optout_domain_table(); } if (! $self->table_exists($optout_email)) { $self->create_optout_email_table(); } # config table check if (! $self->table_exists($config)) { $self->create_config_table(); $self->setconfig('version',$DB_VERSION); } # if config did exist, we have to check the DB version my $current_version = $self->currentdbversion(); # don't try an upgrade if we couldn't connect if (defined $current_version and $current_version < $DB_VERSION) { $self->mylog('dbaccess', 1, 'upgrading database from ' . $self->currentdbversion() . ' to ' . $DB_VERSION); $self->upgradedb(); } # database errors were masked until now $self->{sqlgrey}{warn_db} = 1; } # Database configuration related, only used for checking # schema version now, might be used to check compatibility # between database schema and SQLgrey startup switches in the future sub getconfig($$) { my $self = shift; my $param = shift; my $sth = $self->prepare_cached("SELECT value FROM $config " . 'WHERE parameter = ?'); if (!defined $sth or !$sth->execute($param)) { $self->mylog('dbaccess', 0, "error: couldn't access $config table: $DBI::errstr"); return undef; #$self->mydie('getconfig error', # 'Can\'t continue: config table unreadable'); } my $result = $sth->fetchall_arrayref(); if ($#$result != 0) { # Only log if there are multiple entries, # nothing is allowed $self->mylog('dbaccess', 0, 'error: unexpected SQL result (getconfig)') if ($#$result > 0); return undef; #$self->mydie('getconfig error', # 'Can\'t continue: unexpected config table read error'); } else { return $result->[0][0]; } } sub setconfig($$$) { my $self = shift; my $param = shift; my $value = shift; my $sth = $self->prepare_cached("SELECT value FROM $config " . 'WHERE parameter = ?'); if (!defined $sth or !$sth->execute($param)) { $self->mylog('dbaccess', 0, "error: couldn't access $config table: $DBI::errstr"); $self->mydie('setconfig error', 'Can\'t continue: config table unreadable'); } my $result = $sth->fetchall_arrayref(); if ($#$result != 0) { # not a single value (should mean no value, not multiple ones) $self->insertconfig($param, $value); } else { $self->updateconfig($param, $value); } } sub updateconfig($$$) { my $self = shift; my $param = shift; my $value = shift; my $old_value = shift; my $affected_rows = $self->do("UPDATE $config SET value = " . $self->quote($value) . ' WHERE parameter = ' . $self->quote($param) . ((defined $old_value) ? " AND value = ".($self->quote($old_value)) : "") # Add to where statement, if old_value is defined ); #DBI returns 0E0 if no rows were affected $affected_rows = 0 if (!defined $affected_rows or $affected_rows eq '0E0'); return $affected_rows; } sub insertconfig($$$) { my $self = shift; my $param = shift; my $value = shift; return $self->do("INSERT INTO $config (parameter, value) VALUES(" . $self->quote($param) . ',' . $self->quote($value) . ')'); } sub currentdbversion($) { my $self = shift; # No config table -> version 0 if (! $self->table_exists("$config")) { return 0; } # Common case: read from config table return $self->getconfig('version'); } sub upgradedb($) { my $self = shift; my $currentdbver = $self->currentdbversion(); while ($currentdbver < $DB_VERSION) { $self->upgrade($currentdbver); $currentdbver++; } } sub upgrade($$) { my $self = shift; my $ver = shift; if ($ver == 0) { $self->mydie('Too old SQLgrey database', 'The current layout of the SQLgrey database is too old,' . 'please launch SQLgrey 1.4 to convert it to a layout I can understand'); } elsif ($ver == 1) { $self->upgrade1(); } elsif ($ver == 2) { $self->upgrade2(); } } sub upgrade1($) { my $self = shift; $self->mylog('dbaccess', 1, 'upgrading database schema from version 1 to version 2'); ## Note: SQLite 2.x needs a temporary table (no ALTER TABLE) ## can we detect SQLite 3+ ? # connect $self->mylog('dbaccess', 2, "$connect table: renaming ip_addr to src"); if ($self->SQLite()) { $self->create_connect_table('temp'); $self->do('INSERT INTO temp (sender_name, sender_domain, ' . 'src, rcpt, first_seen) ' . 'SELECT sender_name, sender_domain, ip_addr, ' . 'rcpt, first_seen ' . "FROM $connect"); $self->drop_table($connect); } else { $self->do("ALTER TABLE $connect RENAME TO $connect" . 'old'); } $self->create_connect_table(); if ($self->SQLite()) { $self->do("INSERT INTO $connect (sender_name, sender_domain, " . 'src, rcpt, first_seen) ' . 'SELECT sender_name, sender_domain, src, ' . 'rcpt, first_seen ' . 'FROM temp'); $self->drop_table('temp'); } else { $self->do("INSERT INTO $connect (sender_name, sender_domain, " . 'src, rcpt, first_seen) ' . 'SELECT sender_name, sender_domain, ip_addr, ' . 'rcpt, first_seen ' . "FROM $connect" . 'old'); $self->drop_table("$connect" . 'old'); } $self->mylog('dbaccess', 2, "$connect table: adding indexes"); $self->create_connect_indexes(); # from_awl $self->mylog('dbaccess', 2, "$from_awl: renaming host_ip to src, adding first_seen"); if ($self->SQLite()) { $self->create_from_awl_table('temp'); $self->do('INSERT INTO temp (sender_name, sender_domain, ' . 'src, last_seen, first_seen) ' . 'SELECT sender_name, sender_domain, host_ip, last_seen, last_seen ' . "FROM $from_awl"); $self->drop_table($from_awl); } else { $self->do("ALTER TABLE $from_awl RENAME TO $from_awl" . 'old'); } if ($self->PostgreSQL()) { # we need to remove the pkey constraint $self->do("ALTER TABLE $from_awl" . 'old DROP CONSTRAINT ' . 'from_awl_pkey'); } $self->create_from_awl_table(); if ($self->SQLite()) { $self->do("INSERT INTO $from_awl (sender_name, sender_domain, " . 'src, last_seen, first_seen) ' . 'SELECT sender_name, sender_domain, src, last_seen, last_seen ' . 'FROM temp'); $self->drop_table('temp'); } else { $self->do("INSERT INTO $from_awl (sender_name, sender_domain, " . 'src, last_seen, first_seen) ' . 'SELECT sender_name, sender_domain, host_ip, last_seen, last_seen ' . "FROM $from_awl" . 'old'); $self->drop_table("$from_awl" . 'old'); } $self->mylog('dbaccess', 2, "$from_awl: adding indexes"); $self->create_from_awl_indexes(); # domain_awl $self->mylog('dbaccess', 2, "$domain_awl: renaming host_ip to src, adding first_seen"); if ($self->SQLite()) { $self->create_domain_awl_table('temp'); $self->do('INSERT INTO temp (sender_domain, ' . 'src, last_seen, first_seen) ' . 'SELECT sender_domain, host_ip, last_seen, last_seen ' . "FROM $domain_awl"); $self->drop_table($domain_awl); } else { $self->do("ALTER TABLE $domain_awl RENAME TO $domain_awl" . 'old'); } if ($self->PostgreSQL()) { # we need to remove the pkey constraint $self->do("ALTER TABLE $domain_awl" . 'old DROP CONSTRAINT ' . 'domain_awl_pkey'); } $self->create_domain_awl_table(); if ($self->SQLite()) { $self->do("INSERT INTO $domain_awl (sender_domain, " . 'src, last_seen, first_seen) ' . 'SELECT sender_domain, src, last_seen, last_seen ' . 'FROM temp'); $self->drop_table('temp'); } else { $self->do("INSERT INTO $domain_awl (sender_domain, src, " . 'last_seen, first_seen) ' . 'SELECT sender_domain, host_ip, last_seen, last_seen ' . "FROM $domain_awl" . 'old'); $self->do("DROP TABLE $domain_awl" . 'old'); } $self->mylog('dbaccess', 2, "$domain_awl: adding indexes"); $self->create_domain_awl_indexes(); # Update our schema $self->setconfig('version','2'); } sub upgrade2($) { my $self = shift; $self->mylog('dbaccess', 1, 'upgrading database schema from version 2 to version 3'); ## Note: SQLite 2.x needs a temporary table (no ALTER TABLE) ## can we detect SQLite 3+ ? # connect $self->mylog('dbaccess', 2, "$connect: making room for IPv6 in src"); if ($self->SQLite()) { $self->create_connect_table('temp'); $self->do('INSERT INTO temp (sender_name, sender_domain, ' . 'src, rcpt, first_seen) ' . 'SELECT sender_name, sender_domain, src, ' . 'rcpt, first_seen ' . "FROM $connect"); $self->drop_table($connect); } else { $self->do("ALTER TABLE $connect RENAME TO $connect" . 'old'); } $self->create_connect_table(); if ($self->SQLite()) { $self->do("INSERT INTO $connect (sender_name, sender_domain, " . 'src, rcpt, first_seen) ' . 'SELECT sender_name, sender_domain, src, ' . 'rcpt, first_seen ' . 'FROM temp'); $self->drop_table('temp'); } else { $self->do("INSERT INTO $connect (sender_name, sender_domain, " . 'src, rcpt, first_seen) ' . 'SELECT sender_name, sender_domain, src, ' . 'rcpt, first_seen ' . "FROM $connect" . 'old'); $self->drop_table("$connect" . 'old'); } $self->mylog('dbaccess', 2, "$connect: adding indexes"); $self->create_connect_indexes(); # from_awl $self->mylog('dbaccess', 2, "$from_awl: making room for IPv6 in src"); if ($self->SQLite()) { $self->create_from_awl_table('temp'); $self->do('INSERT INTO temp (sender_name, sender_domain, ' . 'src, last_seen, first_seen) ' . 'SELECT sender_name, sender_domain, src, last_seen, last_seen ' . "FROM $from_awl"); $self->drop_table($from_awl); } else { $self->do("ALTER TABLE $from_awl RENAME TO $from_awl" . 'old'); } if ($self->PostgreSQL()) { # we need to remove the pkey constraint $self->do("ALTER TABLE $from_awl" . 'old DROP CONSTRAINT ' . 'from_awl_pkey'); } $self->create_from_awl_table(); if ($self->SQLite()) { $self->do("INSERT INTO $from_awl (sender_name, sender_domain, " . 'src, last_seen, first_seen) ' . 'SELECT sender_name, sender_domain, src, last_seen, last_seen ' . 'FROM temp'); $self->drop_table('temp'); } else { $self->do("INSERT INTO $from_awl (sender_name, sender_domain, " . 'src, last_seen, first_seen) ' . 'SELECT sender_name, sender_domain, src, last_seen, last_seen ' . "FROM $from_awl" . 'old'); $self->drop_table($from_awl . 'old'); } $self->mylog('dbaccess', 2, "$from_awl: adding indexes"); $self->create_from_awl_indexes(); # domain_awl $self->mylog('dbaccess', 2, "$domain_awl: making room for IPv6 in src"); if ($self->SQLite()) { $self->create_domain_awl_table('temp'); $self->do('INSERT INTO temp (sender_domain, ' . 'src, last_seen, first_seen) ' . 'SELECT sender_domain, src, last_seen, first_seen ' . "FROM $domain_awl"); $self->drop_table($domain_awl); } else { $self->do("ALTER TABLE $domain_awl RENAME TO $domain_awl" . 'old'); } if ($self->PostgreSQL()) { # we need to remove the pkey constraint $self->do("ALTER TABLE $domain_awl" . 'old DROP CONSTRAINT ' . 'domain_awl_pkey'); } $self->create_domain_awl_table(); if ($self->SQLite()) { $self->do("INSERT INTO $domain_awl (sender_domain, " . 'src, last_seen, first_seen) ' . 'SELECT sender_domain, src, last_seen, first_seen ' . 'FROM temp'); $self->drop_table('temp'); } else { $self->do("INSERT INTO $domain_awl (sender_domain, src, " . 'last_seen, first_seen) ' . 'SELECT sender_domain, src, last_seen, first_seen ' . "FROM $domain_awl" . 'old'); $self->do("DROP TABLE $domain_awl" . 'old'); } $self->mylog('dbaccess', 2, "$domain_awl: adding indexes"); $self->create_domain_awl_indexes(); # Update our schema $self->setconfig('version','3'); } # Global DB Init code sub initdb($) { my $self = shift; $self->connectdb(); $self->update_dbnow(); $self->database_setup(); } sub connectdb($) { my $self = shift; my $options = {PrintError => 0, AutoCommit => 1}; # InactiveDestroy has been reported to cause leaks, only use it when needed $options->{InactiveDestroy} = 1 if ($self->{sqlgrey}{clean_method} ne 'sync'); # we can't use connect_cached as we create another connection # in the child responsible for cleanups no warnings 'uninitialized'; #Perl will spew warn's if running DBI only if ($dflt{db_cluster} ne 'on') { $self->{sqlgrey}{dbh} = DBI->connect($self->{sqlgrey}{db_dsn}, $self->{sqlgrey}{db_user}, $self->{sqlgrey}{db_pass}, $options) or $self->mylog('dbaccess', 0, "can't connect to DB: $DBI::errstr"); } else { $self->mylog('dbaccess', 1, "Using DBIx:DBCluster"); my @read_hosts = split(/[,\s]+/ ,$dflt{'read_hosts'}); $self->mylog('dbaccess', 3, "Read_hosts: ".join(', ', @read_hosts)); #Setting up cluster db's $DBIx::DBCluster::CLUSTERS = { "$self->{sqlgrey}{db_host}" => { 'WRITE_HOSTS' => [$self->{sqlgrey}{db_host}], 'READ_HOSTS' => [@read_hosts], }, }; #Flags tells DBCluster never to use WRITE_HOSTS for reading #(unless specified in READ_HOSTS). This only works with Dan Faerch's patch to DBIx::DBCluster $DBIx::DBCluster::WRITE_HOSTS_NEVER_READ=1; $self->{sqlgrey}{dbh} = DBIx::DBCluster->connect($self->{sqlgrey}{db_dsn}, $self->{sqlgrey}{db_user}, $self->{sqlgrey}{db_pass}, $options) or $self->mylog('dbaccess', 0, "can't connect to DB: $DBI::errstr"); } #Ugly hack to make perl shut up about about "possible typo". 1 if ($DBIx::DBCluster::WRITE_HOSTS_NEVER_READ); 1 if ($DBIx::DBCluster::CLUSTERS); ## we can't touch dbh if it isn't defined! if (! defined $self->{sqlgrey}{dbh}) { return; } # mysql drops the connection, we have some glue code # to reinit the connection, but better use mysql DBD code if ($self->MySQL()) { $self->{sqlgrey}{dbh}->{mysql_auto_reconnect} = 1; } # Create "now()" function for SQLite if ($self->SQLite()) { $self->{sqlgrey}{dbh}->func('now', 0, sub { return time }, 'create_function' ); } } sub disconnectdb($) { my $self = shift; if (defined $self->{sqlgrey}{dbh}) { $self->{sqlgrey}{dbh}->disconnect(); } } ##################### ## Table creations ## ##################### sub create_from_awl_table { my $self = shift; # allow optional table name my $tablename = shift; $tablename = ! defined $tablename ? $from_awl : $tablename; $self->do("CREATE TABLE $tablename " . '(sender_name varchar(64) NOT NULL, ' . 'sender_domain varchar(255) NOT NULL, ' . 'src varchar(39) NOT NULL, ' . 'first_seen timestamp NOT NULL, ' . 'last_seen timestamp NOT NULL, ' . 'PRIMARY KEY ' . '(src, sender_domain, sender_name))') or $self->mydie('create_from_awl_table error', 'Couldn\'t create table $tablename: $DBI::errstr'); } sub create_from_awl_indexes($) { my $self = shift; $self->do("CREATE INDEX $from_awl" . '_lseen ' . "ON $from_awl (last_seen)") or $self->mydie('create_from_awl_table error', "couldn't create index on $from_awl (last_seen)"); } sub create_domain_awl_table { my $self = shift; # allow optional table name my $tablename = shift; $tablename = ! defined $tablename ? $domain_awl : $tablename; $self->do("CREATE TABLE $tablename " . '(sender_domain varchar(255) NOT NULL, ' . 'src varchar(39) NOT NULL, ' . 'first_seen timestamp NOT NULL, ' . 'last_seen timestamp NOT NULL, ' . 'PRIMARY KEY (src, sender_domain))') or $self->mydie('create_domain_awl_table error', "Couldn't create table $tablename: $DBI::errstr"); } sub create_domain_awl_indexes($) { my $self = shift; $self->do("CREATE INDEX $domain_awl" . '_lseen ' . "ON $domain_awl (last_seen)") or $self->mydie('create_domain_awl_table error', "couldn't create index on $domain_awl (last_seen)"); } sub create_connect_table { my $self = shift; # allow optional table name my $tablename = shift; $tablename = ! defined $tablename ? $connect : $tablename; # Note: no primary key, Mysql can't handle 500+ byte primary keys # connect should not become big enough to make it a problem $self->do("CREATE TABLE $tablename " . '(sender_name varchar(64) NOT NULL, ' . 'sender_domain varchar(255) NOT NULL, ' . 'src varchar(39) NOT NULL, ' . 'rcpt varchar(255) NOT NULL, ' . 'first_seen timestamp NOT NULL)') or $self->mydie('create_connect_table', "Couldn't create table $tablename: $DBI::errstr"); } sub create_connect_indexes($) { my $self = shift; $self->do("CREATE INDEX $connect" . '_idx ' . "ON $connect (src, sender_domain, sender_name)") or $self->mydie('create_connect_table error', "couldn't create index on $connect (src, sender_domain, sender_name)"); $self->do("CREATE INDEX $connect" . '_fseen ' . "ON $connect (first_seen)") or $self->mydie('create_connect_table error', "couldn't create index on $connect (first_seen)"); } sub create_config_table($) { my $self = shift; $self->do("CREATE TABLE $config " . '(parameter varchar(255) NOT NULL, ' . 'value varchar(255), ' . 'PRIMARY KEY (parameter));') or $self->mydie('create_config_table', "Couldn't create table $config: $DBI::errstr"); # we just created the table: this is the current version $self->setconfig('version', $DB_VERSION); } sub create_optin_domain_table($) { my $self = shift; $self->do("CREATE TABLE $optin_domain " . '(domain varchar(255) NOT NULL, ' . 'PRIMARY KEY (domain));') or $self->mydie('create_optin_domain_table', "Couldn't create table $optin_domain: $DBI::errstr"); } sub create_optin_email_table($) { my $self = shift; $self->do("CREATE TABLE $optin_email " . '(email varchar(255) NOT NULL, ' . 'PRIMARY KEY (email));') or $self->mydie('create_optin_email_table', "Couldn't create table $optin_email: $DBI::errstr"); } sub create_optout_domain_table($) { my $self = shift; $self->do("CREATE TABLE $optout_domain " . '(domain varchar(255) NOT NULL, ' . 'PRIMARY KEY (domain));') or $self->mydie('create_optout_domain_table', "Couldn't create table $optout_domain: $DBI::errstr"); } sub create_optout_email_table { my $self = shift; $self->do("CREATE TABLE $optout_email " . '(email varchar(255) NOT NULL, ' . 'PRIMARY KEY (email));') or $self->mydie('create_optout_email_table', "Couldn't create table $optout_email: $DBI::errstr"); } ########## ## Misc ## ########## # don't try too hard to do exact matches here sub is_ipv4($) { my $addr = shift; return (($addr =~ /^[\d\.]*$/) ? 1 : 0); } sub is_ipv6($) { my $addr = shift; return (($addr =~ /^[0123456789abcdef:]*$/) ? 1 : 0); } sub ipv6_normalise($) { my $addr = shift; $addr =~ s/::$/:/; # let split() return only one empty field at the end my @splitted = split(/:/, $addr, -1); my @splitted_norm; foreach my $a (@splitted) { if ($a ne "") { push(@splitted_norm, sprintf("%04s", $a)); } else { my $null_parts = 8 - $#splitted; while($null_parts--) { push(@splitted_norm, "0000"); } } } return join(":", @splitted_norm); } sub ipv6_is_eui64($) { ## Expects a normalised IPv6 address my $addr = shift; return $addr =~ /:[[:xdigit:]]{2}ff:fe[[:xdigit:]]{2}:[[:xdigit:]]{4}$/; } sub ipv6_is_global_unicast($) { ## Expects a normalised IPv6 address my $addr = shift; return $addr =~ /^[23][[:xdigit:]]{3}/; } sub ipv6_smart($) { my $addr = ipv6_normalise(shift); if (ipv6_is_eui64($addr) and ipv6_is_global_unicast($addr)) { ## For EUI64 return just the prefix/64 return join(":", (split(/:/, $addr))[0..3]); } else { ## For Non-EUI64 or Non-Global-Unicast return the address return $addr; } } sub ip_apply_prefix($$) { my ($ip, $prefix) = @_; $ip = ipv6_normalise($ip) if is_ipv6($ip); return $ip if (not defined($prefix)); if (is_ipv4($ip)) { if ($prefix < 0 or $prefix > 32) { warn("Invalid IPv4 prefix length $ip/$prefix\n"); return $ip; } my $mask = 2**32 - 2**(32-$prefix); my $ipint=unpack("N", pack("C4", split(/\./, $ip))); $ipint &= $mask; return join(".", unpack("C4", pack("N", $ipint))); } elsif (is_ipv6($ip)) { if ($prefix < 0 or $prefix > 128) { warn("Invalid IPv6 prefix length $ip/$prefix\n"); return $ip; } my $mask = Math::BigInt->bpow(2, 128) - (Math::BigInt->bpow(2, 128-$prefix)); my $iphex = ipv6_normalise($ip); $iphex =~ s/://g; my $ipint = Math::BigInt->new("0x$iphex"); # Apply mask to the IP $ip = $ipint->band($mask); # Convert to string, remove leading 0x and normalise to full-length $ip = sprintf("%032s", substr($ip->as_hex(),2)); # Make it look like a normalised IPv6 address $ip = join(":", unpack("a4" x 8, $ip)); return $ip; } warn("$ip - unknown address family\n"); return $ip; } sub class_c($) { my $addr = shift; if (is_ipv4($addr)) { return join('.', (split(/\./, $addr))[0..2]); } elsif (is_ipv6($addr)) { return ipv6_smart($addr); } else { # don't know, don't touch... return $addr; } } sub get_last_addr_part($) { my $addr = shift; if (is_ipv4($addr)) { return (split(/\./, $addr))[3]; } elsif (is_ipv6($addr)) { my @splitted = split(/:/, $addr); return $splitted[$#splitted - 1]; } else { # don't know... return undef; } } ################# ## Normalizers ## ################# # generic single-use addresses # normaliser sub deverp_user($$) { my ($user, $rcpt) = @_; ## Try to match single-use addresses # SRS (first and subsequent levels of forwarding) $user =~ s/^srs0=[^=]+=[^=]+=([^=]+)=([^=]+)$/srs0=#=#=$1=$2/; $user =~ s/^srs1=[^=]+=([^=]+)(=+)[^=]+=[^=]+=([^=]+)=([^=]+)$/srs1=#=$1$2#=#=$3=$4/; # strip extension, used sometimes for mailing-list VERP $user =~ s/\+.*//; ## BATV # eliminate recipient put in originator my $dot_sep_re = '[\.\*-]+'; my $at_sep_re = '[=\?\*~\.]+'; my ($rcpt_lhs, $rcpt_rhs) = split /\@/, $rcpt, 2; # quote all pattern metacharacters and replace '.' with match of possible separators $rcpt_lhs = join $dot_sep_re, map { "\Q$_\E"} split /\./, $rcpt_lhs; $rcpt_rhs = join $dot_sep_re, map { "\Q$_\E"} split /\./, $rcpt_rhs; # build pattern with the 3 alternatives to match recipient in originator # BATV implementations use third or first alternative (first by abuse.net) my $pat = qr/$rcpt_lhs$at_sep_re$rcpt_rhs|$rcpt_rhs$at_sep_re$rcpt_lhs|$rcpt_lhs/; # replace address with capital RCPT to be safe with deletes # (MySQL matches case insensitive unfortunately) $user =~ s/(?<=[\*=\.-])$pat|$pat(?=[\*=\.-])/RCPT/; # strip frequently used bounce/return masks $user =~ s/((bo|bounce|notice-return|notice-reply)[\._-])[0-9a-z-_\.]+$/$1#/g; # Added by JR # strip hexadecimal sequences # at the beginning only if user will contain at least 4 consecutive alpha chars $user =~ s/^[0-9a-f]{2,}(?=[._\/=-].*[a-z]{4,})|(?<=[._\/=-])[0-9a-f]+(?=[._\/=-]|$)/#/g; return $user; } # returns: # 1/ sender's user # 2/ sender's domain # 3/ sender's deverped address sub normalize_sender($$$) { my $self = shift; my $from = lc shift; my $rcpt = lc shift; my $empty = '-undef-'; if ($from eq '') { # Probably MAILER-DAEMON talking to us return ($empty,$empty,$empty) } my ($user, $domain) = split(/@/, $from, 2); # undefined user or domain can jeopardize SELECTs result # replace with invalid user/domain strings if (! defined $domain) { $domain = $empty; # log : shouldn't happen $self->mylog('martians', 2, "undefined domain, from is '$from'"); } if (! defined $user) { $user = $empty; # log : shouldn't happen $self->mylog('martians', 2, "undefined user, from is '$from'"); } # per RFC, user should be < 64, domain < 255 # our database schema doesn't support more return (substr($user, 0, 64),substr($domain, 0, 255), substr(deverp_user($user, $rcpt), 0, 64)); } # make sure rcpt will be VARCHAR storable sub normalize_rcpt($$) { my $self = shift; # trim to 255 chars ( although "$user" . "@" . "$domain" # can be 64 + 1 + 255, VARCHAR is 255 max) return substr(lc shift, 0, 255); } ########################################## ## Grey listing related database access ## ########################################## ######### ## AWLs ## Match connections to AWLs ## sub is_in_from_awl($$$$) { my ($self, $sender_name, $sender_domain, $host) = @_; # last_seen less than $self->{sqlgrey}{awl_age} days ago my $sth = $self->prepare("SELECT 1 FROM $from_awl " . 'WHERE sender_name = ? ' . 'AND sender_domain = ? ' . 'AND src = ? ' . 'AND last_seen > ' . $self->past_tstamp($self->{sqlgrey}{awl_age}, 'DAY') ); if (!defined $sth or !$sth->execute($sender_name, $sender_domain, $host)) { $self->db_unavailable(); $self->mylog('dbaccess', 0, "error: couldn't access $from_awl table: $DBI::errstr"); return 1; # in doubt, accept } else { $self->db_available(); } my $result = $sth->fetchall_arrayref(); if ($#$result != 0) { return 0; # not a single entry } else { return 1; # one single entry (no multiple entries by design) } } sub is_in_domain_awl($$$) { my ($self, $sender_domain, $host) = @_; # last_seen less than $self->{sqlgrey}{awl_age} days ago my $sth = $self->prepare("SELECT 1 FROM $domain_awl " . 'WHERE sender_domain = ? ' . 'AND src = ? ' . 'AND last_seen > ' . $self->past_tstamp($self->{sqlgrey}{awl_age}, 'DAY') ); if (!defined $sth or !$sth->execute($sender_domain, $host)) { $self->db_unavailable(); $self->mylog('dbaccess', 0, "error: couldn't access $domain_awl table: $DBI::errstr"); return 1; # in doubt, accept } else { $self->db_available(); } my $result = $sth->fetchall_arrayref(); if ($#$result != 0) { return 0; # not a single entry } else { return 1; # one single entry (no multiple entries by design) } } ## Put entries in AWLs ## sub put_in_from_awl($$$$$) { my ($self, $sender_name, $sender_domain, $host, $first_seen) = @_; # delete old entries $self->do("DELETE FROM $from_awl " . 'WHERE sender_name = ' . $self->quote($sender_name) . ' AND sender_domain = ' . $self->quote($sender_domain) . ' AND src = ' . $self->quote($host)); # create new entry $self->do("INSERT INTO $from_awl (sender_name, sender_domain, " . 'src, first_seen, last_seen) VALUES(' . $self->quote($sender_name) . ',' . $self->quote($sender_domain) . ',' . $self->quote($host) . ',' . $self->quote($first_seen) . ',NOW())'); } sub put_in_domain_awl($$$$) { my ($self, $sender_domain, $host, $first_seen) = @_; # delete old entries $self->do("DELETE FROM $domain_awl " . 'WHERE sender_domain = ' . $self->quote($sender_domain) . ' AND src = ' . $self->quote($host)); # create new entry $self->do("INSERT INTO $domain_awl (sender_domain, src, " . 'first_seen, last_seen) VALUES(' . $self->quote($sender_domain) . ',' . $self->quote($host) . ',' . $self->quote($first_seen) . ',NOW())'); } ## Update AWL entries ## sub update_from_awl($$$$) { my ($self, $sender_name, $sender_domain, $host) = @_; $self->do("UPDATE $from_awl " . 'SET last_seen = NOW(), first_seen = first_seen ' . 'WHERE sender_name = ' . $self->quote($sender_name) . ' AND sender_domain = ' . $self->quote($sender_domain) . ' AND src = ' . $self->quote($host)); } sub update_domain_awl($$$) { my ($self, $sender_domain, $host) = @_; $self->do("UPDATE $domain_awl " . 'SET last_seen = NOW(), first_seen = first_seen ' . 'WHERE sender_domain = ' . $self->quote($sender_domain) . ' AND src = ' . $self->quote($host)); } # check from_awl entries for a domain/IP sub count_from_awl($$$) { my ($self, $sender_domain, $host) = @_; my $sth = $self->prepare_cached("SELECT COUNT(*) FROM $from_awl " . 'WHERE sender_domain = ? AND src = ?'); if (!defined $sth or !$sth->execute($sender_domain, $host)) { $self->db_unavailable(); $self->mylog('dbaccess', 0, "error: couldn't access $from_awl table: $DBI::errstr"); return 0; # do as if table is empty } else { $self->db_available(); } my $result = $sth->fetchall_arrayref(); if ($#$result != 0) { $self->mylog('dbaccess', 0, 'error: unexpected SQL result (count_from_awl)'); return 0; # do as if table is empty } else { return $result->[0][0]; } } # Check number of entries from a given IP in domain_awl sub count_src_domain_awl($$) { my ($self, $host) = @_; my $sth = $self->prepare_cached("SELECT COUNT(*) FROM $domain_awl " . 'WHERE src = ?'); if (!defined $sth or !$sth->execute($host)) { $self->db_unavailable(); $self->mylog('dbaccess', 0, "error: couldn't access $domain_awl table: $DBI::errstr"); return 0; # do as if table is empty } else { $self->db_available(); } my $result = $sth->fetchall_arrayref(); if ($#$result != 0) { $self->mylog('dbaccess', 0, 'error: unexpected SQL result (count_src_domain_awl)'); return 0; # do as if table is empty } else { return $result->[0][0]; } } # Check number of entries from a given IP in from_awl sub count_src_from_awl($$) { my ($self, $host) = @_; my $sth = $self->prepare_cached("SELECT COUNT(*) FROM $from_awl " . 'WHERE src = ?'); if (!defined $sth or !$sth->execute($host)) { $self->db_unavailable(); $self->mylog('dbaccess', 0, "error: couldn't access $from_awl table: $DBI::errstr"); return 0; # do as if table is empty } else { $self->db_available(); } my $result = $sth->fetchall_arrayref(); if ($#$result != 0) { $self->mylog('dbaccess', 0, 'error: unexpected SQL result (count_src_from_awl)'); return 0; # do as if table is empty } else { return $result->[0][0]; } } # Check number of entries from a given IP in connect sub count_src_connect($$) { my ($self, $host) = @_; my $sth = $self->prepare_cached("SELECT COUNT(*) FROM $connect " . 'WHERE src = ?'); if (!defined $sth or !$sth->execute($host)) { $self->db_unavailable(); $self->mylog('dbaccess', 0, "error: couldn't access $connect table: $DBI::errstr"); return 0; # do as if table is empty } else { $self->db_available(); } my $result = $sth->fetchall_arrayref(); if ($#$result != 0) { $self->mylog('dbaccess', 0, 'error: unexpected SQL result (count_src_connect)'); return 0; # do as if table is empty } else { return $result->[0][0]; } } ## Cleanup AWL entries ## sub cleanup_from_awl($) { my ($self) = @_; my $rows = $self->do("DELETE FROM $from_awl " . 'WHERE last_seen < ' . $self->past_tstamp($self->{sqlgrey}{awl_age}, 'DAY') ); $rows = 0 if (!defined $rows or $rows eq '0E0'); return $rows; } sub cleanup_domain_awl($) { my ($self) = @_; my $rows = $self->do("DELETE FROM $domain_awl " . 'WHERE last_seen < ' . $self->past_tstamp($self->{sqlgrey}{awl_age}, 'DAY') ); $rows = 0 if (!defined $rows or $rows eq '0E0'); return $rows; } sub delete_domain_from_mail_awl($$$) { my ($self, $domain, $host) = @_; $self->do("DELETE FROM $from_awl " . 'WHERE sender_domain = ' . $self->quote($domain) . ' AND src = ' . $self->quote($host)); } sub delete_domain_from_connect($$$) { my ($self, $domain, $host) = @_; $self->do("DELETE FROM $connect " . 'WHERE sender_domain = ' . $self->quote($domain) . ' AND src = ' . $self->quote($host)); } # Active domain AWL for a domain/IP sub move_domain_from_mail_to_domain_awl($$$) { my ($self, $domain, $host) = @_; my $first_seen = $self->get_first_seen_in_from_awl($domain, $host); $self->put_in_domain_awl($domain, $host, $first_seen); $self->delete_domain_from_mail_awl($domain, $host); } sub get_first_seen_in_from_awl($$$) { my ($self, $domain, $host) = @_; my $sth = $self->prepare_cached("SELECT MIN(first_seen) FROM $from_awl " . 'WHERE sender_domain = ? AND src = ?'); if (!defined $sth or !$sth->execute($domain, $host)) { $self->db_unavailable(); $self->mylog('dbaccess', 0, "error: couldn't access $from_awl table: $DBI::errstr"); return 0; # do as if table is empty } else { $self->db_available(); } my $result = $sth->fetchall_arrayref(); if ($#$result != 0) { $self->mylog('grey', 0, 'error: unexpected SQL result (get_first_seen_in_from_awl)'); return 0; # do as if table is empty } else { return $result->[0][0]; } } ############ ## Connect # check for a valid reconnection sub in_connect($$$$$) { my ($self, $sender_name, $sender_domain, $addr, $rcpt) = @_; # last_seen less than $self->{sqlgrey}{max_connect_age} hours ago # but more than $self->{sqlgrey}{reconnect_delay} minutes ago my $sth = $self->prepare("SELECT 1 FROM $connect " . 'WHERE sender_name = ? AND sender_domain = ? ' . 'AND src = ? AND rcpt = ? ' . 'AND first_seen BETWEEN ' . $self->past_tstamp($self->{sqlgrey}{max_connect_age}, 'HOUR') . ' AND ' . $self->past_tstamp($self->{sqlgrey}{reconnect_delay}, 'MINUTE') ); if (!defined $sth or !$sth->execute($sender_name, $sender_domain, $addr, $rcpt)) { $self->db_unavailable(); $self->mylog('dbaccess', 0, "error: couldn't access $connect table: $DBI::errstr"); return 1; # in doubt, accept } else { $self->db_available(); } my $result = $sth->fetchall_arrayref(); if ($#$result < 0) { return 0; # not a single entry } else { return 1; # at least one entry } } # check for early reconnection sub recently_in_connect($$$$$) { my ($self, $sender_name, $sender_domain, $addr, $rcpt) = @_; # last_seen less than $self->{sqlgrey}{reconnect_delay} minutes ago my $sth = $self->prepare("SELECT 1 FROM $connect WHERE sender_name = ? " . 'AND sender_domain = ? ' . 'AND src = ? AND rcpt = ? ' . 'AND first_seen >= ' . $self->past_tstamp($self->{sqlgrey}{reconnect_delay}, 'MINUTE') ); if (!defined $sth or !$sth->execute($sender_name, $sender_domain, $addr, $rcpt)) { $self->db_unavailable(); $self->mylog('dbaccess', 0, "error: Couldn't access $connect table: $DBI::errstr"); return 0; # in doubt, accept } else { $self->db_available(); } my $result = $sth->fetchall_arrayref(); if ($#$result < 0) { return 0; # not a single entry } else { return 1; # at least one entry } } # add a first attempt sub put_in_connect($$$$$) { my ($self, $sender_name, $sender_domain, $addr, $rcpt) = @_; # create new entry $self->do("INSERT INTO $connect (sender_name, sender_domain, " . 'src, rcpt, first_seen) ' . 'VALUES(' . $self->quote($sender_name) . ',' . $self->quote($sender_domain) . ',' . $self->quote($addr) . ',' . $self->quote($rcpt) . ', NOW())'); } # For logging purpose sub get_reconnect_delay($$$$$) { my ($self, $sender_name, $sender_domain, $addr, $rcpt) = @_; my $query; if ($self->MySQL()) { $query = 'SELECT first_seen, SEC_TO_TIME(UNIX_TIMESTAMP(NOW())-' . 'UNIX_TIMESTAMP(first_seen)) ' . "FROM $connect "; } else { $query = "SELECT first_seen, now() - first_seen FROM $connect "; } $query .= 'WHERE sender_name = ? AND sender_domain = ? ' . 'AND src = ? AND rcpt = ?'; my $sth = $self->prepare_cached($query); if (!defined $sth or !$sth->execute($sender_name, $sender_domain, $addr, $rcpt)) { $self->db_unavailable(); $self->mylog('dbaccess', 0, "error: couldn't get reconnect delay: $DBI::errstr"); return 'sql error'; } else { $self->db_available(); } my $result = $sth->fetchall_arrayref(); if ($#$result < 0) { $self->mylog('grey', 0, 'get_reconnect_delay error: no connect in database for ' . "$sender_name\@$sender_domain, $addr, $rcpt"); return 'error: nothing in connect'; } else { return $result->[0][0], $result->[0][1]; } } # Clean connect entries for a whitelisted mail/IP sub delete_mail_ip_from_connect($$$$) { my ($self, $deverp_sender_name, $sender_domain, $addr) = @_; $deverp_sender_name =~ s/#/%/g; $self->do("DELETE FROM $connect " . 'WHERE src = ' . $self->quote($addr) . ' AND sender_domain = ' . $self->quote($sender_domain) . ' AND sender_name LIKE ' . $self->quote($deverp_sender_name) ); } # clean probable SPAM attempts and log them sub cleanup_connect($) { my $self = shift; my $tstamp = $self->past_tstamp($self->{sqlgrey}{max_connect_age}, 'HOUR'); if ($self->{sqlgrey}{log}{spam} >= 2) { # Print probable SPAM: my $sth = $self->prepare('SELECT sender_name, sender_domain, src, ' . 'rcpt, first_seen ' . "FROM $connect " . 'WHERE first_seen < ' . $tstamp); if (defined $sth and $sth->execute()) { $self->db_available(); my $result = $sth->fetchall_arrayref(); for my $spam (@{$result}) { $self->mylog('spam', 2, "$$spam[2]: " . "$$spam[0]\@$$spam[1] -> " . "$$spam[3] at $$spam[4]"); } } else { $self->db_unavailable(); $self->mylog('dbaccess', 0, "error: couldn't list detected spam attempts: $DBI::errstr"); } } my $rows = $self->do("DELETE FROM $connect " . 'WHERE first_seen < ' . $tstamp ); # DBI returns 0E0 if no rows is affected. $rows = 0 if (!defined $rows or $rows eq '0E0'); return $rows; } ## Choose the actual cleanup method sub start_cleanup { my $self = shift; if ($dflt{dont_db_clean}) { $self->mylog('conf', 2, "This host has db-cleaning disabled"); return; } if ($self->{sqlgrey}{clean_method} eq 'sync') { $self->cleanup(); } else { $self->fork_cleanup(); } } ## Synchronous cleanup sub cleanup($) { my ($self) = @_; my $time = time(); my $frows = $self->cleanup_from_awl(); my $drows = $self->cleanup_domain_awl(); my $crows = $self->cleanup_connect(); $time = time() - $time; $self->mylog('perf', 2, 'spent ' . $time . "s cleaning: from_awl ($frows) domain_awl ($drows) connect ($crows)"); } ## Forked cleanup sub fork_cleanup($) { my $self = shift; my $pid = fork(); if (!defined $pid) { $self->mylog('system', 0, 'couldn\'t fork child: no cleanup!'); } elsif ($pid == 0) { # child $self->mylog('system', 3, "forked cleanup child ($$)"); # we *WANT* a new DB connection or we will delay other processings # or worse send garbage to the DB $self->connectdb(); $self->{sqlgrey}{dbh}{InactiveDestroy} = 0; $self->cleanup(); # we don't want nasty error messages saying we should have destroyed # an out-of-scope dbh $self->disconnectdb(); $self->mylog('system', 3, "cleanup child exit ($$)"); exit; } } ################## ## Whitelisting ## ################## sub init_whitelists($) { my $self = shift; $self->read_ip_whitelists(); $self->read_fqdn_whitelists(); # check dynamic files' mtime $self->{sqlgrey}{dyniptime} = get_mtime($dyn_ip_whitelist_file); $self->{sqlgrey}{dynfqdntime} = get_mtime($dyn_fqdn_whitelist_file); } sub read_ip_whitelists($) { my $self = shift; $self->read_static_ip_whitelist(); $self->read_dyn_ip_whitelist(); } sub read_fqdn_whitelists($) { my $self = shift; $self->read_static_fqdn_whitelist(); $self->read_dyn_fqdn_whitelist(); } sub read_static_ip_whitelist($) { my $self = shift; $self->{sqlgrey}{stat_ip_whitelist} = $self->read_an_ip_whitelist($stat_ip_whitelist_file); } sub read_dyn_ip_whitelist($) { my $self = shift; $self->{sqlgrey}{dyn_ip_whitelist} = $self->read_an_ip_whitelist($dyn_ip_whitelist_file); } sub lookup_ip_in_whitelist($$) { my ($whitelist, $ip) = @_; my $ip_ver = is_ipv4($ip) ? 4 : 6; #my %w = ($whitelist->{$ip_ver}); foreach my $prefix (sort(keys(%{$whitelist->{$ip_ver}}))) { my $ip_masked = ip_apply_prefix($ip, $prefix); return $prefix if (defined($whitelist->{$ip_ver}{$prefix}{$ip_masked})); } return -1; } sub add_ip_to_whitelist($$$) { my ($whitelist, $ip, $prefixlen) = @_; my $ip_masked = ip_apply_prefix($ip, $prefixlen); my $ip_ver = is_ipv4($ip) ? 4 : 6; if (not defined($whitelist->{$ip_ver}{$prefixlen})) { $whitelist->{$ip_ver}{$prefixlen} = {}; } $whitelist->{$ip_ver}{$prefixlen}{$ip_masked} = 1; } sub read_an_ip_whitelist($$) { my $self = shift; my $file = shift; # Prepare empty whitelist my $whitelist; $whitelist->{4} = undef; $whitelist->{6} = undef; my ($ip, $prefixlen); if (! open (FILE, '<' . $file)) { $self->mylog('conf', 1, "warning: $file not found or unreadable"); return $whitelist; } while () { chomp; # strip comments s/#.*//; # strip spaces s/\s+//g; # Anything left ? next unless length; $ip = undef; if (/^(.*)\/(\d+)$/) { $ip = $1; $prefixlen = $2; } elsif (/^\d+\.\d+\.\d+\.\d+$/) { $ip = $_; $prefixlen = 32; } elsif (/^\d+\.\d+\.\d+$/) { $ip = "$_.0"; $prefixlen = 24; } elsif (is_ipv6($_)) { $ip = $_; $prefixlen = 128; } if (not defined($ip) or not $prefixlen >= 0 or not ((is_ipv4($ip) and $prefixlen <= 32) or (is_ipv6($ip) and $prefixlen <= 128))) { $self->mylog('conf', 0, "unrecognised line in $file: $_"); next; } add_ip_to_whitelist($whitelist, $ip, $prefixlen); } close FILE; return $whitelist; } sub read_static_fqdn_whitelist($) { my $self = shift; $self->{sqlgrey}{stat_fqdn_whitelist} = $self->read_an_fqdn_whitelist($stat_fqdn_whitelist_file); } sub read_dyn_fqdn_whitelist($) { my $self = shift; $self->{sqlgrey}{dyn_fqdn_whitelist} = $self->read_an_fqdn_whitelist($dyn_fqdn_whitelist_file); } sub read_an_fqdn_whitelist($$) { my $self = shift; my $file = shift; # Prepare empty whitelists my $whitelist; my @re_whitelist; my @domain_whitelist; my $system_whitelist; if (! open (FILE, '<' . $file)) { $self->mylog('conf', 1, "warning: $file not found or unreadable"); $whitelist->{system} = $system_whitelist; $whitelist->{domain} = \@domain_whitelist; $whitelist->{regexp} = \@re_whitelist; return $whitelist; } while () { chomp; # strip comments and whitespaces s/#.*//; s/\s+//; # Anything left ? next unless length; if (/\/(\S+)\/$/) { # regexp, we use qr// to compile them here push @re_whitelist, qr/$1/; } elsif (/^\*\.(.*$)/) { # whole domain push @domain_whitelist, $1; } elsif (/^([\w-]+\.)+[\w-]+$/) { # looks like a system name $system_whitelist->{$_} = 1; } else { $self->mylog('conf', 0, "unrecognised line in $file: $_"); } } close FILE; $whitelist->{system} = $system_whitelist; $whitelist->{domain} = \@domain_whitelist; $whitelist->{regexp} = \@re_whitelist; return $whitelist; } sub update_dyn_whitelists($) { my $self = shift; $self->update_dyn_ip_whitelist(); $self->update_dyn_fqdn_whitelist(); } # Set the reload flag sub mark_reload_request() { $reload = 1; } # When not in the middle of a processing... # check the reload flag sub got_reload_request() { my $myreload = ($reload == 1); $reload = 0; return ($myreload); } sub update_static_whitelists($) { my $self = shift; $self->read_static_ip_whitelist(); $self->read_dyn_fqdn_whitelist(); } sub get_mtime($) { my $file = shift; # file exists ? if (stat($file)) { # return mtime return (stat(_))[9]; } else { return 0; } } sub update_dyn_ip_whitelist($) { my $self = shift; my $dyntime = get_mtime($dyn_ip_whitelist_file); if ($dyntime > $self->{sqlgrey}{dyniptime}) { $self->mylog('whitelist', 3, "reloading $dyn_ip_whitelist_file"); $self->{sqlgrey}{dyniptime} = $dyntime; $self->read_dyn_ip_whitelist(); } } sub update_dyn_fqdn_whitelist($) { my $self = shift; my $dyntime = get_mtime($dyn_fqdn_whitelist_file); if ($dyntime > $self->{sqlgrey}{dynfqdntime}) { $self->mylog('whitelist', 3, "reloading $dyn_fqdn_whitelist_file"); $self->{sqlgrey}{dynfqdntime} = $dyntime; $self->read_dyn_fqdn_whitelist(); } } sub is_in_whitelists($$$$$$) { ## expects all parameters ## for rcpt_whitelists for example my ($self, $sender_name, $sender_domain, $ip, $fqdn, $rcpt) = @_; return ($self->is_in_ip_whitelists($ip) or $self->is_in_fqdn_whitelists($fqdn)); } sub is_in_ip_whitelists($$) { my ($self, $ip) = @_; return ($self->is_in_static_ip_whitelist($ip) or $self->is_in_dyn_ip_whitelist($ip)); } sub is_in_fqdn_whitelists($$) { my ($self, $fqdn) = @_; return ($self->is_in_static_fqdn_whitelist($fqdn) or $self->is_in_dyn_fqdn_whitelist($fqdn)); } sub is_in_static_ip_whitelist($$) { my ($self, $ip) = @_; if (lookup_ip_in_whitelist($self->{sqlgrey}{stat_ip_whitelist}, $ip) >= 0) { $self->mylog('whitelist', 3, "$ip in static whitelist"); return 1; } return 0; } sub is_in_dyn_ip_whitelist($$) { my ($self, $ip) = @_; if (lookup_ip_in_whitelist($self->{sqlgrey}{dyn_ip_whitelist}, $ip) >= 0) { $self->mylog('whitelist', 3, "$ip in dynamic whitelist"); return 1; } return 0; } sub is_in_static_fqdn_whitelist($$) { my ($self, $fqdn) = @_; return $self->is_in_fqdn_whitelist($fqdn, $self->{sqlgrey}{stat_fqdn_whitelist}, 'static'); } sub is_in_dyn_fqdn_whitelist($$) { my ($self, $fqdn) = @_; return $self->is_in_fqdn_whitelist($fqdn, $self->{sqlgrey}{dyn_fqdn_whitelist}, 'dynamic'); } sub is_in_fqdn_whitelist($$$$) { my ($self, $fqdn, $whitelist, $type) = @_; # check hostnames if (defined $whitelist->{system}->{$fqdn}) { $self->mylog('whitelist', 3, "$fqdn in $type whitelist"); return 1; } # check domains foreach my $domain (@{$whitelist->{domain}}) { if ($fqdn =~ /\.$domain$/) { $self->mylog('whitelist', 3, "$fqdn: $domain domain in $type whitelist"); return 1; } } # check regexps foreach my $regexp (@{$whitelist->{regexp}}) { if ($fqdn =~ $regexp) { $self->mylog('whitelist', 3, "$fqdn: match $type whitelist regexp"); return 1; } } # Nothing matches return 0; } #################### ## Optin / Optout ## #################### sub greylisting_active($$) { my ($self, $email) = @_; my $domain = (split(/@/, $email))[1]; if ($self->{sqlgrey}{optmethod} eq 'optin') { return ( ($self->is_in_optin_domain($domain) and not $self->is_in_optout_email($email)) or $self->is_in_optin_email($email) ); } elsif ($self->{sqlgrey}{optmethod} eq 'optout') { return not ( ($self->is_in_optout_domain($domain) and not $self->is_in_optin_email($email)) or $self->is_in_optout_email($email) ); } else { return 1; } } sub is_in_optin_domain($$) { my ($self, $domain) = @_; my $sth = $self->prepare_cached("SELECT 1 FROM $optin_domain " . 'WHERE domain = ?'); if (!defined $sth or !$sth->execute($domain)) { $self->db_unavailable(); $self->mylog('dbaccess', 0, "error: couldn't access $optin_domain table: $DBI::errstr"); return 0; # in doubt, no greylisting } else { $self->db_available(); } my $result = $sth->fetchall_arrayref(); if ($#$result != 0) { $self->mylog('optin', 4, "$domain not in $optin_domain"); return 0; # not a single entry } else { $self->mylog('optin', 4, "$domain in $optin_domain"); return 1; # one single entry (no multiple entries by design) } } sub is_in_optin_email($$) { my ($self, $email) = @_; my $sth = $self->prepare_cached("SELECT 1 FROM $optin_email " . 'WHERE email = ?'); if (!defined $sth or !$sth->execute($email)) { $self->db_unavailable(); $self->mylog('dbaccess', 0, "error: couldn't access $optin_email table: $DBI::errstr"); return 0; # in doubt, no greylisting } else { $self->db_available(); } my $result = $sth->fetchall_arrayref(); if ($#$result != 0) { $self->mylog('optin', 4, "$email not in $optin_email"); return 0; # not a single entry } else { $self->mylog('optin', 4, "$email in $optin_email"); return 1; # one single entry (no multiple entries by design) } } sub is_in_optout_domain($$) { my ($self, $domain) = @_; my $sth = $self->prepare_cached("SELECT 1 FROM $optout_domain " . 'WHERE domain = ?'); if (!defined $sth or !$sth->execute($domain)) { $self->db_unavailable(); $self->mylog('dbaccess', 0, "error: couldn't access $optout_domain table: $DBI::errstr"); return 1; # in doubt, no greylisting } else { $self->db_available(); } my $result = $sth->fetchall_arrayref(); if ($#$result != 0) { $self->mylog('optin', 4, "$domain not in $optout_domain"); return 0; # not a single entry } else { $self->mylog('optin', 4, "$domain in $optout_domain"); return 1; # one single entry (no multiple entries by design) } } sub is_in_optout_email($$) { my ($self, $email) = @_; my $sth = $self->prepare_cached("SELECT 1 FROM $optout_email " . 'WHERE email = ?'); if (!defined $sth or !$sth->execute($email)) { $self->db_unavailable(); $self->mylog('dbaccess', 0, "error: couldn't access $optin_email table: $DBI::errstr"); return 1; # in doubt, no greylisting } else { $self->db_available(); } my $result = $sth->fetchall_arrayref(); if ($#$result != 0) { $self->mylog('optin', 4, "$email not in $optout_email"); return 0; # not a single entry } else { $self->mylog('optin', 4, "$email in $optout_email"); return 1; # one single entry (no multiple entries by design) } } ################################ ## Discriminating Greylisting ## ################################ sub init_discrimination($) { my $self = shift; # If discimination is enabled, load the regexps and # convert configuration value into a 1/0 (true/false) value if ($dflt{discrimination} =~ m/on/i) { $dflt{discrimination}=1; $dflt{discrimination_add_rulenr}= ($dflt{discrimination_add_rulenr}=~ m/on/i) ? 1 : 0; $self->read_discrimination_regexp(); #Read regexp file } else { $dflt{discrimination}=0; } } sub read_discimination_regexp_file($$) { my $self = shift; my $file = shift; my ($data); if (! open (REGEXP, '<' . $file)) { $self->mylog('conf', 0, "error: $file not found or unreadable"); return '.'; # fallback regexp } else { my $count = 0; while () { chomp; s/#.*//; # Remove comments if (m/(\w+)\s*(?:([=!]([~=]))?)\s*(.*?)\s*$/) { # capture attrib-name, comparison-operater (as = or !) and regex $data->{$1}->{++$count}->{oper} = $2; # Store the data in a hash (attrib-name => comparison-operator) $data->{$1}->{$count}->{regex} = qr/$4/ if ($3 eq '~'); # Store the data in a hash (attrib-name => compiled regex) $data->{$1}->{$count}->{regex} = $4 if ($3 eq '='); # Store the data in a hash (attrib-name => attrib-name) } elsif (!m/^\s*$/) { $self->mylog('conf', 1, "Skipping invalid line in discrimination file: $_\n"); } } close REGEXP; if ($count > 1) { $self->mylog('conf', 1, "Read $count discrimination regexp's from $file"); } return $data; } } sub read_discrimination_regexp($) { my $self = shift; $self->{sqlgrey}{discrimination_re} = $self->read_discimination_regexp_file($discrimination_regexp_file); } # Check the attr fields delivered by postfix against the regexps. # If nothing matches, greylisting is skipped. sub discriminate_check($$) { my ($self, $attr) = @_; my $hash = $self->{sqlgrey}{discrimination_re}; my $match = 0; keys %$hash; #This resets the hash. I have no idea why the iteration counter isnt reset upon leaving this function #Loop loaded expressions while ( my ($var,$data) = each(%$hash)) { keys %$data; # reset hash while ( my ($rulenr,$regex) = each(%$data)) { if (!defined $attr->{$var}) { $self->mylog('conf', 3 , "Discrimination attrib '$var' unsupported by postfix. Skipping."); next; } if ($regex->{oper} eq '=~') { $match=1 if ($attr->{$var} =~ $regex->{regex}); } #if var equal to regex if ($regex->{oper} eq '!~') { $match=1 if ($attr->{$var} !~ $regex->{regex}); } #if var not equal to regex if ($regex->{oper} eq '==') { $match=1 if ($attr->{$var} eq $attr->{$regex->{regex}}); } #if var equal to variable if ($regex->{oper} eq '!=') { $match=1 if ($attr->{$var} ne $attr->{$regex->{regex}}); } #if var not equal to variable if ($match) { $self->mylog('conf', 3 , "Discrimination verdict: Greylist"); $self->mylog('conf', 3 , "Discrimination check: $var $regex->{oper}~ $regex->{regex}"); return $rulenr; } } } $self->mylog('conf', 2 , "Discrimination verdict: Dont Greylist "); return 0; #default DONT greylist } ################################# ## Regexps for smart algorithm ## ################################# sub init_smart_regexps($) { my $self = shift; $self->read_smtp_server_regexp(); $self->read_dyn_fqdn_regexp(); } sub read_a_regexp($$) { my $self = shift; my $file = shift; my $regexp; if (! open (REGEXP, '<' . $file)) { $self->mylog('conf', 0, "error: $file not found or unreadable"); return '.'; # fallback regexp } else { # we expect only one line my $count = 0; while () { chomp; # compile the regexp $regexp = qr/$_/i; $count++; } close REGEXP; if ($count > 1) { $self->mylog('conf', 1, "warning: more than one line in $file," . 'took only last one'); } return $regexp; } } sub read_smtp_server_regexp($) { my $self = shift; $self->{sqlgrey}{smtp_server_re} = $self->read_a_regexp($smtp_server_regexp_file); } sub read_dyn_fqdn_regexp($) { my $self = shift; $self->{sqlgrey}{dyn_fqdn_re} = $self->read_a_regexp($dyn_fqdn_regexp_file); } ## client_identifier can be its IP-address or the class-C network ## we decide here sub client_identifier($$$) { my ($self, $addr, $fqdn) = @_; my $greymethod = $self->{sqlgrey}{greymethod}; my $classc = class_c($addr); my $is_ipv6 = is_ipv6($addr); if ($greymethod eq 'full') { return $addr; } elsif ($greymethod eq 'classc') { return $classc; } elsif ($greymethod eq 'smart') { # check $fqdn # no fqdn, treat as suspicious if ($fqdn eq 'unknown') { $self->mylog('grey', 3, "unknown RDNS: $addr"); return $addr; } if ($is_ipv6) { ## No other 'smart' checks are implemented for IPv6 return $classc; } # we need the last byte my $last_part = get_last_addr_part($addr); return $addr unless defined $last_part; # We use Michel Bouissou's Regexp Horror Museum ;-) # Regexp from hell ;-) that sorts out known SMTP servers patterns if ($fqdn =~ $self->{sqlgrey}{smtp_server_re}) { $self->mylog('grey', 3, "identified SMTP server pattern: $fqdn, $addr: Using C-class ($classc)."); return $classc; } # Regexp from hell ;-) that sorts out known end-user / dynamic # pools patterns if ($fqdn =~ /(^|[0-9.x_-])((cm?|gv|h|ip|host|m|p(a|c|u)?)?0*$last_part([._-]))/i) { $self->mylog('grey', 3, "identified dynamic pattern (last IP byte): $fqdn, $addr: Using full IP."); return $addr; } if ($fqdn =~ $self->{sqlgrey}{dyn_fqdn_re}) { $self->mylog('grey', 3, "identified dynamic pattern (name): $fqdn, $addr: Using full IP."); return $addr; } # If not specifically identified as dynamic, return C-Class address $self->mylog('grey', 3, "unknown pattern: $fqdn, $addr: using C-class ($classc)."); return $classc; } } # main routine: # based on attributes specified as argument, return policy decision sub smtpd_access_policy($$) { my ($self, $attr) = @_; my ($discrimination_rulenr) = 0; # prepare lookup my ($sender_name,$sender_domain,$deverp_sender_name) = $self->normalize_sender($attr->{sender}, $attr->{recipient}); my $recipient = $self->normalize_rcpt($attr->{recipient}); my $addr = $attr->{client_address}; my $fqdn = $attr->{client_name}; # Check for new whitelists $self->update_dyn_whitelists(); # Check if we got the reload signal. # We can't process this signal as soon as we receive it as # we may be using variables for which it will trigger an update if ($self->got_reload_request()) { $self->mylog('conf', 2, 'reloading static whitelists and smart regexps'); $self->update_static_whitelists(); $self->init_smart_regexps(); $self->init_discrimination(); $self->disconnectdb(); $self->connectdb(); } #Generate the rejection response (moved here to avoid redundancy) my ($reject_text) = $self->{sqlgrey}{reject_early} . ' Greylisted for ' . $self->{sqlgrey}{reconnect_delay} . ' minutes'; # whitelist check if ($self->is_in_whitelists($sender_name, $sender_domain, $addr, $fqdn, $recipient)) { $self->mylog('whitelist', 2, "$sender_name\@$sender_domain, $addr($fqdn) -> $recipient"); return $self->{sqlgrey}{prepend} ? $prepend . 'whitelisted by ' . $software : 'dunno'; } # optin/optout checks if (! $self->greylisting_active($recipient)) { $self->mylog('optin', 3, "greylisting inactive for $recipient"); return $self->{sqlgrey}{prepend} ? $prepend . "greylisting inactive for $recipient in $software" : 'dunno'; } else { $self->mylog('optin', 3, "greylisting active for $recipient"); } # discrimination checks if ($dflt{discrimination}) { # if discrimination is enabled # Check if sender data lets him skip greylisting if ($discrimination_rulenr = $self->discriminate_check($attr)) { # note: Checks are run against the raw $attr fields. #We DO greylist # Add the rule.nr. (that is, linenumber in regexfile) of the rule that matched to response (helps the support department) $reject_text.= " ($discrimination_rulenr)" if ($dflt{discrimination_add_rulenr}); } else { #We DONT greylist $self->mylog('conf', 3, "Discrimination Passed check - not greylisting $addr"); return $self->{sqlgrey}{prepend} ? $prepend . "not greylisting mail from $addr in $software" : 'dunno'; } } # this is the identifier we use in AWLs my $cltid = $self->client_identifier($addr, $fqdn); # we need the value of now() in the database $self->update_dbnow(); # If !defined last_dbclean, reload value from DB if (!defined $self->{sqlgrey}{last_dbclean}) { $self->{sqlgrey}{last_dbclean} = $self->getconfig('last_dbclean'); # if last_dbclean not found in db then write it. if (!defined $self->{sqlgrey}{last_dbclean}) { # 0 will force a cleanup (unless db_cleandelay is really huge) $self->setconfig('last_dbclean',0); $self->{sqlgrey}{last_dbclean} = 0; } } # Is it time for cleanups ? my $current_time = time(); if ($current_time > ($self->{sqlgrey}{last_dbclean} + $self->{sqlgrey}{db_cleandelay})) { # updateconfig() returns affected_rows if ($self->updateconfig('last_dbclean',$current_time,$self->{sqlgrey}{last_dbclean})) { # If affected_rows > 0, its my job to clean the db $self->{sqlgrey}{last_dbclean} = $current_time; $self->start_cleanup(); } else { #If affected_rows == 0, then someone already cleaned db $self->{sqlgrey}{last_dbclean} = undef; #make sqlgrey reload time from db on next pass } } # domain scale awl check if ($self->is_in_domain_awl($sender_domain, $cltid)) { $self->mylog('grey', 2, "domain awl match: updating $cltid($addr), $sender_domain"); # update awl entry $self->update_domain_awl($sender_domain, $cltid); return $self->{sqlgrey}{prepend} ? $prepend . 'domain auto-whitelisted by ' . $software : 'dunno'; } # address scale awl check if ($self->is_in_from_awl($deverp_sender_name, $sender_domain, $cltid)) { $self->mylog('grey', 2, "from awl match: updating $cltid($addr), " . "$deverp_sender_name\@$sender_domain" . "($sender_name\@$sender_domain)"); # update awl entry $self->update_from_awl($deverp_sender_name, $sender_domain, $cltid); return $self->{sqlgrey}{prepend} ? $prepend . 'from auto-whitelisted by ' . $software : 'dunno'; } # is it an early reconnect ? if ($self->recently_in_connect($sender_name, $sender_domain, $cltid, $recipient)) { $self->mylog('grey', 2, "early reconnect: $cltid($addr), " . "$sender_name\@$sender_domain -> $recipient"); return $reject_text; } # is it a reconnection ? if ($self->in_connect($sender_name, $sender_domain, $cltid, $recipient)) { my ($first_seen, $delay) = $self->get_reconnect_delay($sender_name, $sender_domain, $cltid, $recipient); $self->mylog('grey', 2, "reconnect ok: $cltid($addr), $sender_name" . '@' . $sender_domain . " -> $recipient ($delay)"); # check if we have others from the same domain in the from_awl # add 1 for our sample and compare to the aggregation level if ( ($self->{sqlgrey}{domain_level} != 0) and ($self->count_from_awl($sender_domain, $cltid)+1 >= $self->{sqlgrey}{domain_level}) ) { # use domain-level AWL $self->move_domain_from_mail_to_domain_awl($sender_domain, $cltid); $self->mylog('grey', 2, "domain awl: $cltid, $sender_domain added"); $self->delete_domain_from_connect($sender_domain, $cltid); } else { # add to mail-level AWL $self->mylog('grey', 2, "from awl: $cltid, $deverp_sender_name" . '@' . "$sender_domain added"); $self->put_in_from_awl($deverp_sender_name, $sender_domain, $cltid, $first_seen); $self->delete_mail_ip_from_connect($deverp_sender_name, $sender_domain, $cltid); } return $self->{sqlgrey}{prepend} ? $prepend . "delayed $delay by $software" : 'dunno'; } # Throttling too many connections from same new host if (defined $self->{sqlgrey}{connect_src_throttle} and $self->{sqlgrey}{connect_src_throttle} > 0) { if ($self->count_src_connect($cltid) >= $self->{sqlgrey}{connect_src_throttle} and $self->count_src_domain_awl($cltid) < 1 and $self->count_src_from_awl($cltid) < $self->{sqlgrey}{connect_src_throttle}) { $self->mylog('grey', 2, "throttling: $cltid($addr), $sender_name\@$sender_domain -> $recipient"); return ($self->{sqlgrey}{reject_first} . ' Throttling too many connections from new source - ' . ' Try again later.'); } } # new connection $self->mylog('grey', 2, "new: $cltid($addr), $sender_name\@$sender_domain -> $recipient"); $self->put_in_connect($sender_name, $sender_domain, $cltid, $recipient); return $reject_text; } sub read_conffile($) { my $optional_file = shift; if (defined $optional_file) { $config_file = $optional_file; } # Check if conf file is readable if explicitly told to use one if (defined $optional_file) { open(CONF, '<' . $config_file) or die "Couldn't open $config_file for reading: $!\n"; } else { open(CONF, '<' . $config_file) or return; } while () { chomp; # no newline s/#.*//; # no comments s/^\s+//; # no leading white s/\s+$//; # no trailing white next unless length; # anything left ? my ($var, $value) = split(/\s*=\s*/, $_, 2); $dflt{$var} = $value || 1; } close CONF or die "Couldn't close config file $config_file\n"; # log levels # 1/ use default one foreach my $logtype (keys %{$dflt{log}}) { $dflt{log}{$logtype} = $dflt{loglevel}; } # 2/ apply exceptions if (defined $dflt{log_override}) { my @overrides = split(/\s*,\s*/, $dflt{log_override}); foreach my $override (@overrides) { my ($logtype, $loglevel) = split(/\s*:\s*/, $override); # some simple checks if (!defined $loglevel) { die "Invalid log_override format\n"; } if (! defined $dflt{log}{$logtype}){ die "Invalid logtype in log_override: $logtype\n"; } if ($loglevel eq '0') { $loglevel = -1; } if ($loglevel !~ /\d/ || $loglevel > 4) { die "Invalid loglevel for $logtype: $loglevel\n"; } $dflt{log}{$logtype} = $loglevel; } } # file locations # whitelist files $stat_ip_whitelist_file = $dflt{conf_dir} . '/clients_ip_whitelist'; $dyn_ip_whitelist_file = $dflt{conf_dir} . '/clients_ip_whitelist.local'; $stat_fqdn_whitelist_file = $dflt{conf_dir} . '/clients_fqdn_whitelist'; $dyn_fqdn_whitelist_file = $dflt{conf_dir} . '/clients_fqdn_whitelist.local'; # regexp files $smtp_server_regexp_file = $dflt{conf_dir} . '/smtp_server.regexp'; $dyn_fqdn_regexp_file = $dflt{conf_dir} . '/dyn_fqdn.regexp'; } # Setup the environment sub main() { # save arguments for Net:Server HUP restart my @ARGV_saved = @ARGV; # options parsing my %opt = (); GetOptions(\%opt, 'help|h', 'man', 'version', 'configfile|f=s', 'daemonize|d', 'kill|k', 'pidfile|p=s') or exit(1); if ($opt{help}) { pod2usage(1) } if ($opt{man}) { pod2usage(-exitstatus => 0, -verbose => 2) } if ($opt{version}) { print "sqlgrey $VERSION\n"; exit(0) } # Read the config file read_conffile($opt{configfile}); # Set some cluster specific stuff (move to an init_cluster() sub?) no warnings 'uninitialized'; #Perl will spew warn's if running DBI only if ($dflt{db_cluster} eq 'on') { # if loglevel >= 4, enable debugging for DBCluster $DBIx::DBCluster::DEBUG = ($dflt{'loglevel'}>3)?1:0; # Ugly hack to make perl shut up about about "possible typo". 1 if ($DBIx::DBCluster::DEBUG); $dflt{dont_db_clean} = (-e $dflt{conf_dir}."/dont_db_clean"); } # Check pidfile from command line arguments if (defined $opt{pidfile}) { $dflt{pidfile} = $opt{pidfile}; } # Are we on a killing spray ? if (defined $opt{kill}) { my $pidfile = $dflt{pidfile}; open(PIDFILE, '<' . $pidfile) or die "Coudn't read pidfile: $pidfile\n"; while () { # should only have one pid kill 15, $_; } close PIDFILE; unlink $pidfile; exit; } # bind only localhost if no host is specified if(defined $dflt{inet}) { $proto = "tcp"; if ($dflt{inet}=~/^\d+$/) { $port = "localhost:$dflt{inet}"; } else { $port = $dflt{inet}; } } elsif (defined $dflt{unix}) { $proto = "unix"; $port = $dflt{unix} ."|unix"; } # Make a new DSN or verify supplied DSN if ($dflt{db_dsn} ne '') { my @res = DBI->parse_dsn($dflt{db_dsn}) or die ('Error parsing db_dsn'); if ((defined $res[1]) && $res[1] ne '') { $dflt{db_type} = $res[1]; } else { die ('db_dsn is missing a database driver'); } } else { my $dsn; $dsn = 'DBI:' . $dflt{db_type}; # only MySQL uses database= if ($dflt{db_type} eq 'mysql') { $dsn .= ':database='; } else { $dsn .= ':dbname='; } $dsn .= $dflt{db_name}; # only SQLite doesn't require a hostname or port if ($dflt{db_type} ne 'SQLite') { $dsn .= ';host=' . $dflt{db_host}; if ($dflt{db_port} ne "default") { $dsn .= ';port=' . $dflt{db_port}; } } $dflt{db_dsn} = $dsn; } # set the actual reject code values if ($dflt{reject_first_attempt} eq 'delay') { $dflt{reject_first_attempt} = 'defer_if_permit'; } elsif ($dflt{reject_first_attempt} eq 'immed') { $dflt{reject_first_attempt} = $dflt{reject_code}; } else { pod2usage(1); } if (defined $dflt{reject_early_reconnect}) { if ($dflt{reject_early_reconnect} eq 'delay') { $dflt{reject_early_reconnect} = 'defer_if_permit'; } elsif ($dflt{reject_early_reconnect} eq 'immed') { $dflt{reject_early_reconnect} = $dflt{reject_code}; } else { pod2usage(1); } } # create Net::Server object and run it my $server = bless { server => { commandline => [ $0, @ARGV_saved ], port => [ $port ], proto => $proto, user => $dflt{user}, group => $dflt{group}, setsid => $opt{daemonize} ? 1 : undef, pid_file => $opt{daemonize} ? $dflt{pidfile} : undef, # ugly hack: 4 will triger Net::Server debugs log_level => $dflt{loglevel} > 2 ? $dflt{loglevel} : 2, log_file => $opt{daemonize} ? 'Sys::Syslog' : undef, syslog_facility => 'mail', syslog_logsock => 'unix', syslog_ident => defined $dflt{log_ident} ? $dflt{log_ident} : # process name $0 =~ m{.*/(.*)}, syslog_logopt => 'cons', Reuse => 1, }, sqlgrey => { # min time before reconnect (min) reconnect_delay => $dflt{reconnect_delay}, # max time before reconnect (hour) max_connect_age => $dflt{max_connect_age}, # How long is an AWL entry valid (days) awl_age => $dflt{awl_age}, # How many from match a domain/IP before a switch to domain AWL domain_level => $dflt{group_domain_level}, last_dbclean => undef, # triggers reload from db db_cleandelay => $dflt{db_cleandelay}, # between table cleanups (seconds) db_prepare_cache => $dflt{db_prepare_cache}, db_type => $dflt{db_type}, db_name => $dflt{db_name}, db_host => $dflt{db_host}, db_port => $dflt{db_port}, db_dsn => $dflt{db_dsn}, db_user => $dflt{db_user}, db_pass => $dflt{db_pass}, db_available => 1, # used to trigger e-mails clean_method => $dflt{clean_method}, prepend => $dflt{prepend}, greymethod => $dflt{greymethod}, optmethod => $dflt{optmethod}, reject_first => $dflt{reject_first_attempt}, reject_early => $dflt{reject_early_reconnect} || $dflt{reject_first_attempt}, connect_src_throttle => $dflt{connect_src_throttle}, admin_mail => $dflt{admin_mail}, warn_db => 0, # mask SQL errors during db init mail_maxbucket => 10, # max burst of mails mail_period => 10, # one mail each 10 minutes max mail_bucket => 5, # initial bucket last_mail => time, log => $dflt{log}, # discrimination => $dflt{discrimination} }, }, 'sqlgrey'; my $greymethod = $server->{sqlgrey}{greymethod}; if ($greymethod ne 'smart' and $greymethod ne 'full' and $greymethod ne 'classc') { pod2usage(1); } $server->run; } #################################### ## Net::Server::Multiplex methods ## #################################### sub post_bind_hook() { my ($self) = @_; # unix socket permissions should be 666 if($self->{server}{port}[0] =~ /^(.*)\|unix$/) { chmod 0666, $1; } } # Called before the first query comes. sub pre_loop_hook() { my $self = shift; # store ourselves $ref_to_sqlgrey = $self; # be sure to put in syslog any warnings / fatal errors if($self->{server}{log_file} eq 'Sys::Syslog') { $SIG{__WARN__} = sub {Sys::Syslog::syslog('warning', "warning: $_[0]")}; $SIG{__DIE__} = sub {Sys::Syslog::syslog('crit', "fatal: $_[0]"); die @_;}; } $SIG{USR1} = \&mark_reload_request; $self->initdb(); $self->init_whitelists(); $self->init_smart_regexps(); $self->init_discrimination(); if (defined $self->{server}{setsid}) { # Detach from terminal close(STDIN); close(STDOUT); close(STDERR); # Ugly hack to prevent perl from complaining # 'warning: Filehandle STDERR reopened as FILE only \ # for input at /usr/bin/sqlgrey line 717, line 57' open(STDIN,'/dev/null'); open(STDERR,'>/dev/null'); } } sub restart_open_hook() { my $self = shift; my $pidfile = $self->{server}{pid_file}; unlink $pidfile; } sub restart_close_hook() { my $self = shift; # SIGUSR1 triggers the whitelist reloading $self->mark_reload_request(); } # Main muxer : # reads a line at a time, call smtpd_access_policy if the input looks valid # and return the result sub mux_input() { my ($self, $mux, $fh, $in_ref) = @_; defined $self->{sqlgrey_attr} or $self->{sqlgrey_attr} = {}; my $attr = $self->{sqlgrey_attr}; # consume entire lines while ($$in_ref =~ s/^([^\n]*)\n//) { next unless defined $1; my $in = $1; if($in =~ /([^=]+)=(.*)/) { # read attributes $attr->{substr($1, 0, 512)} = substr($2, 0, 512); } elsif($in eq '') { defined $attr->{request} or $attr->{request}=''; if($attr->{request} ne 'smtpd_access_policy') { $self->{net_server}->log(1, 'unrecognized request type: ' . "'$attr->{request}'"); } else { # decide my $action = $self->{net_server}->smtpd_access_policy($attr); # debug if ($ref_to_sqlgrey->{sqlgrey}{log}{other} >= 4) { my $a = 'request: '; $a .= join(' ', map {"$_=$attr->{$_}"} (sort keys %$attr)); $a .= " action=$action"; $self->{net_server}->log(4, $a); } # give answer print $fh "action=$action\n\n"; } $self->{sqlgrey_attr} = {}; } else { $self->{net_server}->log(1, 'ignoring garbage: <' . substr($in, 0, 100).'>'); } } } main; __END__ =head1 NAME sqlgrey - Postfix Greylisting Policy Server =head1 SYNOPSIS B [I...] -h, --help display this help and exit --man display man page --version output version information and exit -d, --daemonize run in the background -p, --pidfile=FILE write process ID to FILE (overrides 'pidfile' in configfile) -k, --kill kill a running sqlgrey (identified by 'pidfile' content) -f, --configfile=FILE read config from FILE (default /etc/sqlgrey/sqlgrey.conf) expecting config_param=value lines, - spaces are ignored, - '#' is used for comments See the default config file at /etc/sqlgrey/sqlgrey.conf for runtime parameters. If you got sqlgrey from sources, read the HOWTO file in the compressed archive. If it came prepackaged, look into the documentation tree for this file: /usr/share/doc/sqlgrey-/ on most Linux distributions for example. =head1 DESCRIPTION Sqlgrey is a Postfix policy server implementing greylisting. When a request for delivery of a mail is received by Postfix via SMTP, the triplet C / C / C is built. If it is the first time that this triplet is seen, or if the triplet was first seen less than I minutes (1 is the default), then the mail gets rejected with a temporary error. Hopefully spammers or viruses will not try again later, as it is however required per RFC. In order to alleviate the reconnect delay, sqlgrey uses a 2-level auto-white-list (AWL) system: =over 4 =item * As soon as a C / C is accepted, it is added to an AWL. The couple expires when it isn't seen for more than I days (60 is the default). =item * If I Cs (2 is the default) from the same domain or more use the same C, another AWL is used based on a C / C couple. This couple expires after awl-age days too. This AWL is meant to be used on high throughput sites in order to : =over 4 =item * minimize the amount of data stored in database, =item * minimize the amount of processing required to find an entry in the AWL. =item * don't impose any further mail delay when a C / C couple is known. =back It can be disabled by setting I to 0. =back General idea: When a SMTP client has been accepted once, if the IP isn't dynamic, greylisting the IP again is only a waste of time when it sends another e-mail. As we already know that this IP runs an RFC-compliant MTA (at least the 4xx error code handling) and will get the new e-mail through anyway. In the case of mail relays, these AWLs works very well as the same senders and mail domains are constantly coming through the same IP addresses -E the e-mails are quickly accepted on the first try. In the case of individual SMTP servers, this works well if the IP is fixed too. When using a floating IP address, the AWLs are defeated, but it should be the least common case by far. Why do we put the domain in the AWL and not the IP only ? If we did only store IP addresses, polluting the AWL would be far too easy. It would only take one correctly configured MTA sending one e-mail from one IP one single time to put it in a whitelist used whatever future mails from this IP look like. With this AWL system, one single mail can only allow whitelisting of mails from a single sender from the same IP... =head1 INSTALLATION =over 4 =item * Create a C user. This will be the user the daemon runs as. =item * When using a full-fledge SGBD (MySQL and PostgreSQL, not SQLite), create a 'sqlgrey' db user and a 'sqlgrey' database. Grant access to the newly created database to sqlgrey. =item * Use the packaged init script to start sqlgrey at boot and start it manually. =back =head1 CONFIGURATION =head2 General =over 4 =item * Start by adding check_policy_service after reject_unauth_destination in /etc/postfix/main.cf : smtpd_recipient_restrictions = ... reject_unauth_destination check_policy_service inet:127.0.0.1:2501 =item * Be aware that some servers do not behave correctly and do not resend mails (as required by the standard) or use unique return addresses. This is the reason why you should maintain whitelists for them. SQLgrey comes with a comprehensive whitelisting system. It can even be configured to fetch up-to-date whitelists from a repository. See the HOWTO for the details. =back =head2 Disabling greylisting for some users If you want to disable greylisting for some users you can configure Postfix like this: /etc/postfix/sqlgrey_recipient_access: i_like_spam@ee.ethz.ch OK Then you'll add a check_recipient_access in main.cf before the check_policy_service : smtpd_recipient_restrictions = ... reject_unauth_destination check_client_access hash:/etc/postfix/sqlgrey_client_access check_recipient_access hash:/etc/postfix/sqlgrey_recipient_access check_policy_service inet:127.0.0.1:10023 =head1 SEE ALSO See L for a description of what greylisting is and L for a description of how Postfix policy servers work. =head1 COPYRIGHT Copyright (c) 2004 by Lionel Bouton. =head1 LICENSE 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., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA =head1 AUTHOR Slionel-dev@bouton.nameE> =cut # Emacs Configuration # # Local Variables: # mode: cperl # eval: (cperl-set-style "PerlStyle") # mode: flyspell # mode: flyspell-prog # End: # # vi: sw=4 et sqlgrey-1.8.0/sqlgrey-logstats.pl000077500000000000000000000371001171713015400170730ustar00rootroot00000000000000#!/usr/bin/perl -w # sqlgrey: a postfix greylisting policy server using an SQL backend # based on postgrey # Copyright 2004 (c) ETH Zurich # Copyright 2004 (c) Lionel Bouton # # 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., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA # package sqlgrey_logstats; use strict; use Pod::Usage; use Getopt::Long qw(:config posix_default no_ignore_case); use Time::Local; use Date::Calc; my $VERSION = "1.8.0"; # supports IPv4 and IPv6 my $ipregexp = '[\dabcdef\.:]+'; ###################### # Time-related methods my %months = ( "Jan" => 0, "Feb" => 1, "Mar" => 2, "Apr" => 3, "May" => 4, "Jun" => 5, "Jul" => 6, "Aug" => 7, "Sep" => 8, "Oct" => 9, "Nov" => 10, "Dec" => 11 ); sub validate_tstamp { my $self = shift; my $value = shift; my ($monthname, $mday, $hour, $min, $sec); if ($value =~ /^(\w{3}) ([\d ]\d) (\d\d):(\d\d):(\d\d)$/) { ($monthname, $mday, $hour, $min, $sec) = ($1, $2, $3, $4, $5); } else { $self->debug("invalid date format: $value\n"); return undef; } my $month = $months{$monthname}; my $year = $self->{year}; if ($month > $self->{month}) { # yes we can compute stats across years... $year--; } my $epoch_seconds = Time::Local::timelocal($sec, $min, $hour, $mday, $month, $year); if (! $epoch_seconds) { $self->debug("can't compute timestamp from: $value\n"); return undef; } if ($epoch_seconds < $self->{begin} or $epoch_seconds > $self->{end}) { $self->debug("date out of range: $value\n"); return undef; } return $epoch_seconds; } # What was the tstamp yesterday at 00:00 ? sub yesterday_tstamp { # Get today 00:00:00 and deduce one day my ($day, $month, $year) = reverse Date::Calc::Add_Delta_Days(Date::Calc::Today(), -1 ); # Adjust Date::Calc 1-12 month to 0-11 $month--; return Time::Local::timelocal(0,0,0,$day,$month,$year); } # What was the tstamp today at 00:00 ? sub today_tstamp { # Get today 00:00:00 return Time::Local::timelocal(0, 0, 0, ((localtime())[3,4,5])); } # set time period sub yesterday { my $self = shift; $self->{begin} = $self->yesterday_tstamp(); $self->{end} = $self->{begin} + (60 * 60 * 24); } sub today { my $self = shift; $self->{begin} = $self->today_tstamp(); $self->{end} = time(); } sub lasthour { my $self = shift; my $now = time(); $self->{begin} = $now - (60 * 60); $self->{end} = $now; } sub last24h { my $self = shift; my $now = time(); $self->{begin} = $now - (60 * 60 * 24); $self->{end} = $now; } sub lastweek { my $self = shift; $self->{end} = $self->today_tstamp(); $self->{begin} = $self->{end} - (60 * 60 * 24 * 7); } ################## # Argument parsing sub parse_args { my $self = shift; my %opt = (); GetOptions(\%opt, 'help|h', 'man', 'version', 'yesterday|y', 'today|t', 'lasthour', 'last24h|d', 'lastweek|w', 'programname', 'debug', 'top-domain=i', 'top-from=i', 'top-spam=i', 'top-throttled=i', 'print-delayed') or pod2usage(1); if ($opt{debug}) { $self->{debug} = 1; } if ($opt{help}) { pod2usage(1) } if ($opt{man}) { pod2usage(-exitstatus => 0, -verbose => 2) } if ($opt{version}) { print "sqlgrey-logstats.pl $VERSION\n"; exit(0) } my $setperiod_count = 0; if ($opt{yesterday}) { $self->yesterday(); $setperiod_count++; } if ($opt{today}) { $self->today(); $setperiod_count++; } if ($opt{lasthour}) { $self->lasthour(); $setperiod_count++; } if ($opt{last24h}) { $self->last24h(); $setperiod_count++; } if ($opt{lastweek}) { $self->lastweek(); $setperiod_count++; } if ($setperiod_count > 1) { pod2usage(1); } if ($opt{'top-domain'}) { $self->{top_domain} = $opt{'top-domain'}; } if ($opt{'top-from'}) { $self->{top_from} = $opt{'top-from'}; } if ($opt{'top-spam'}) { $self->{top_spam} = $opt{'top-spam'}; } if ($opt{'top-throttled'}) { $self->{top_throttled} = $opt{'top-throttled'}; } if ($opt{'print-delayed'}) { $self->{print_delayed} = 1; } # compute current year and month ($self->{month}, $self->{year}) = (localtime)[4,5]; if ($opt{programname}) { $self->{programname} = $opt{programname}; } } ################ # percent string sub percent { my $portion = shift; my $total = shift; if ($total == 0) { return "N/A%"; } return sprintf ("%.2f%%", ($portion / $total) * 100); } # quick debug function sub debug { my $self = shift; if (defined $self->{debug}) { print shift; } } sub split_date_event { my ($self, $line) = @_; if ($line =~ m/^(\w{3} [\d ]\d \d\d:\d\d:\d\d)\s\S+\s$self->{programname}: (\w+): (.*)$/o ) { my $time = $self->validate_tstamp($1); if (! defined $time) { return (undef,undef,undef); } else { #$self->debug("match: $time, $2, $3\n"); return ($time, $2, $3); } } else { $self->debug("not matched: $line\n"); return (undef,undef,undef); } } sub parse_grey { my ($self, $time, $event) = @_; ## old format if ($event =~ /^domain awl match: updating ($ipregexp), (.*)$/i) { $self->{events}++; $self->{passed}++; $self->{domain_awl_match}{$1}{$2}++; $self->{domain_awl_match_count}++; } elsif ($event =~ /^from awl match: updating ($ipregexp), (.*)$/i) { $self->{events}++; $self->{passed}++; $self->{from_awl_match}{$1}{$2}++; $self->{from_awl_match_count}++; } elsif ($event =~ /^new: ($ipregexp), (.*) -> (.*)$/i) { $self->{events}++; $self->{new}{$1}++; $self->{new_count}++; } elsif ($event =~ /^throttling: ($ipregexp), (.*) -> (.*)$/i) { $self->{events}++; $self->{throttled}{$1}{$2}++; $self->{throttled_count}++; } elsif ($event =~ /^early reconnect: ($ipregexp), (.*) -> (.*)$/i) { $self->{events}++; $self->{early}{$1}++; $self->{early_count}++; } elsif ($event =~ /^reconnect ok: ($ipregexp), (.*) -> (.*) \((.*)\)/i) { $self->{events}++; $self->{passed}++; $self->{reconnect}{$1}{$2}++; $self->{reconnect_count}++; ## new format } elsif ($event =~ /^domain awl match: updating ($ipregexp)\($ipregexp\), (.*)$/i) { $self->{events}++; $self->{passed}++; $self->{domain_awl_match}{$1}{$2}++; $self->{domain_awl_match_count}++; ## new format for from_awl match (deverp log) } elsif ($event =~ /^from awl match: updating ($ipregexp)\($ipregexp\), (.*)\(.*\)$/i) { $self->{events}++; $self->{passed}++; $self->{from_awl_match}{$1}{$2}++; $self->{from_awl_match_count}++; } elsif ($event =~ /^from awl match: updating ($ipregexp)\($ipregexp\), (.*)$/i) { $self->{events}++; $self->{passed}++; $self->{from_awl_match}{$1}{$2}++; $self->{from_awl_match_count}++; } elsif ($event =~ /^new: ($ipregexp)\($ipregexp\), (.*) -> (.*)$/i) { $self->{events}++; $self->{new}{$1}++; $self->{new_count}++; } elsif ($event =~ /^throttling: ($ipregexp)\($ipregexp\), (.*) -> (.*)$/i) { $self->{events}++; $self->{throttled}{$1}{$2}++; $self->{throttled_count}++; } elsif ($event =~ /^early reconnect: ($ipregexp)\($ipregexp\), (.*) -> (.*)$/i) { $self->{events}++; $self->{early}{$1}++; $self->{early_count}++; } elsif ($event =~ /^reconnect ok: ($ipregexp)\($ipregexp\), (.*) -> (.*) \((.*)\)/i) { $self->{events}++; $self->{passed}++; $self->{reconnect}{$1}{$2}++; $self->{reconnect_count}++; } elsif ($event =~ /^domain awl: $ipregexp, .* added$/i) { ## what? } elsif ($event =~ /^from awl: $ipregexp, .* added$/i) { ## what? } elsif ($event =~ /^from awl: $ipregexp, .* added/i) { ## what? } elsif ($event =~ /^domain awl: $ipregexp, .* added/i) { ## what? } else { $self->debug("unknown grey event at $time: $event\n"); } } sub parse_whitelist { my ($self, $time, $event) = @_; if ($event =~ /^.*, $ipregexp\(.*\) -> .*$/i) { $self->{events}++; $self->{passed}++; $self->{whitelisted}++; } else { $self->debug("unknown whitelist event at $time: $event\n"); } } sub parse_spam { my ($self, $time, $event) = @_; if ($event =~ /^([\d\.]+): (.*) -> (.*) at (.*)$/) { $self->{rejected_count}++; $self->{rejected}{$1}{$2}++; } else { $self->debug("unknown spam event at $time: $event\n"); } } # TODO sub parse_perf { } # distribute processing to appropriate parser sub parse_line { my ($self, $line) = @_; my ($time, $type, $event) = $self->split_date_event($line); if (! defined $time) { return; } # else parse event if ($type eq 'grey') { $self->parse_grey($time, $event); } elsif ($type eq 'whitelist') { $self->parse_whitelist($time, $event); } elsif ($type eq 'spam') { $self->parse_spam($time, $event); } elsif ($type eq 'perf') { $self->parse_perf($time, $event); } # don't care for other types } # format a title sub print_title { my $self = shift; my $title = shift; my $ln = length($title); my $line = ' ' . '-' x ($ln + 2) . ' '; print $line . "\n"; print "| $title |\n"; print $line . "\n\n"; } # breaks down and print an hash sub print_distribution { my $self = shift; my $hash_to_print = shift; my $max_to_print = shift; my $title = shift; my @top; my $idx; my $count = 0; foreach my $id (keys(%{$hash_to_print})) { $count++; my $hash; $hash->{count} = 0; $hash->{id} = $id; foreach my $subval (keys(%{$hash_to_print->{$id}})) { $hash->{count} += $hash_to_print->{$id}{$subval}; } $top[$#top+1] = $hash; @top = reverse sort { $a->{count} <=> $b->{count} } @top; pop @top if (($max_to_print != -1) && ($#top >= $max_to_print)); } if ($max_to_print != -1) { $self->print_title("$title (top " . ($#top + 1) . ", " . ($#top + 1 - $count) . " hidden)"); } else { $self->print_title($title); } for ($idx = 0; $idx <= $#top; $idx++) { my @dtop; foreach my $subval (keys(%{$hash_to_print->{$top[$idx]->{id}}})) { my $hash; $hash->{count} = $hash_to_print->{$top[$idx]->{id}}{$subval}; $hash->{domain} = $subval; $dtop[$#dtop+1] = $hash; @dtop = sort { $a->{count} <=> $b->{count} } @dtop; } @dtop = reverse @dtop; print "$top[$idx]->{id}: $top[$idx]->{count}\n"; for (my $didx = 0; $didx <= $#dtop; $didx++) { print " $dtop[$didx]->{domain}: $dtop[$didx]->{count}\n"; } } print "\n"; } sub print_domain_awl { my $self = shift; $self->print_distribution($self->{domain_awl_match}, $self->{top_domain}, "Domain AWL"); } sub print_from_awl { my $self = shift; $self->print_distribution($self->{from_awl_match}, $self->{top_from}, "From AWL"); } sub print_spam { my $self = shift; $self->print_distribution($self->{rejected}, $self->{top_spam}, "Spam"); } sub print_delayed { my $self = shift; if (! defined $self->{print_delayed}) { return; } $self->print_distribution($self->{reconnect}, -1, "Delayed"); } sub print_throttled { my $self = shift; $self->print_distribution($self->{throttled}, $self->{top_throttled}, "Throttled"); } sub print_stats { my $self = shift; print "##################\n" . "## Global stats ##\n" . "##################\n\n"; print "Events : " . $self->{events} . "\n"; print "Passed : " . $self->{passed} . "\n"; print "Early : " . $self->{early_count} . "\n"; print "Delayed : " . $self->{new_count} . "\n\n"; print "Probable SPAM : " . $self->{rejected_count} . "\n"; print "Throttled : " . $self->{throttled_count} . "\n\n"; print "###############################\n" . "## Whitelist/AWL performance ##\n" . "###############################\n\n"; print "Breakdown for $self->{passed} accepted messages:\n\n"; print "Whitelists : " . percent($self->{whitelisted}, $self->{passed}) . "\t($self->{whitelisted})\n"; print "Domain AWL : " . percent($self->{domain_awl_match_count}, $self->{passed}) . "\t($self->{domain_awl_match_count})\n"; print "From AWL : " . percent($self->{from_awl_match_count}, $self->{passed}) . "\t($self->{from_awl_match_count})\n"; print "Delayed : " . percent($self->{reconnect_count},$self->{passed}) . "\t($self->{reconnect_count})\n\n"; $self->print_domain_awl(); $self->print_from_awl(); $self->print_spam(); $self->print_throttled(); $self->print_delayed(); } # create parser with no period limits # and counters set to 0 my $parser = bless { begin => 0, end => (1 << 31) - 1, programname => 'sqlgrey', events => 0, passed => 0, whitelisted => 0, rejected_count => 0, new_count => 0, throttled_count => 0, early_count => 0, domain_awl_match_count => 0, from_awl_match_count => 0, domain_awl_match => {}, from_awl_match => {}, rejected => {}, reconnect => {}, reconnect_count => 0, top_domain => -1, top_from => -1, top_spam => -1, top_throttled => -1, }, 'sqlgrey_logstats'; $parser->parse_args(); while () { chomp; $parser->parse_line($_); } $parser->print_stats(); __END__ =head1 NAME sqlgrey-logstats.pl - SQLgrey log parser =head1 SYNOPSIS B [I...] < syslogfile -h, --help display this help and exit --man display man page --version output version information and exit --debug output detailed log parsing steps -y, --yesterday compute stats for yesterday -t, --today compute stats for today --lasthour compute stats for last hour -d, --lastday compute stats for last 24 hours -w, --lastweek compute stats for last 7 days --programname program name looked into log file --top-from how many from AWL entries to print (default: all) --top-domain how many domain AWL entries to print (default: all) --top-spam how many SPAM sources to print (default: all) --top-throttled how many throttled sources to print (default: all) --print-delayed print delayed sources (default: don't) =head1 DESCRIPTION sqlgrey-logstats.pl ... =head1 SEE ALSO See L for a description of what greylisting is and L for a description of how Postfix policy servers work. =head1 COPYRIGHT Copyright (c) 2004 by Lionel Bouton. =head1 LICENSE 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., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA =head1 AUTHOR Slionel-dev@bouton.nameE> =cut sqlgrey-1.8.0/sqlgrey.ebuild000066400000000000000000000204201171713015400160600ustar00rootroot00000000000000# Copyright 1999-2005 Gentoo Foundation# Distributed under the terms of the GNU General Public License v2 # Distributed under the terms of the GNU General Public License v2 # $Header$ inherit eutils DESCRIPTION="SQLgrey is a postfix policy service implementing a grey-listing policy" #SRC_URI="mirror://sourceforge/sqlgrey/${PN}-${PV}.tar.bz2" SRC_URI="http://sqlgrey.bouton.name/${PN}-${PV}.tar.bz2" HOMEPAGE="http://sqlgrey.sourceforge.net/" LICENSE="GPL-2" SLOT="0" IUSE="mysql postgres sqlite" RDEPEND="dev-lang/perl dev-perl/DBI dev-perl/net-server || ( postgres? ( dev-perl/DBD-Pg ) sqlite? ( dev-perl/DBD-SQLite ) mysql? ( dev-perl/DBD-mysql ) dev-perl/DBD-Pg )" DEPEND="$RDEPEND sys-apps/sed" KEYWORDS="~x86 ~amd64" pkg_setup() { has_version dev-perl/IO-Multiplex || die "IO-Multiplex needed. Please emerge it or run g-cpan.pl IO::Multiplex" enewgroup sqlgrey enewuser sqlgrey -1 -1 /var/spool/sqlgrey sqlgrey } src_install () { make gentoo-install ROOTDIR=${D} prepall dodoc HOWTO FAQ README README.OPTINOUT README.PERF COPYING TODO Changelog # keeps SQLgrey data in /var/spool/sqlgrey diropts -m0775 -o sqlgrey -g sqlgrey dodir /var/spool/sqlgrey } pkg_postinst() { echo einfo "To make use of greylisting, please update your postfix config." einfo einfo "Put something like this in /etc/postfix/main.cf:" einfo " smtpd_recipient_restrictions =" einfo " ..." einfo " check_policy_service inet:127.0.0.1:2501" einfo einfo "Remember to restart Postfix after that change. Also remember" einfo "to make the daemon start durig boot:" einfo " rc-update add sqlgrey default" einfo echo einfo "To setup SQLgrey to run out-of-the-box on your system, run:" einfo "emerge --config ${PF}" echo ewarn "Read the documentation for more info (perldoc sqlgrey) or the" ewarn "included howto /usr/share/doc/${PF}/HOWTO.gz" echo ebeep 2 epause 5 } pkg_config () { # SQLgrey configuration file local SQLgrey_CONFIG="/etc/sqlgrey/sqlgrey.conf" local SQLgrey_DB_USER_NAME="sqlgrey" local SQLgrey_DB_NAME="sqlgrey" # Check if a password is set in sqlgrey.conf local SQLgrey_CONF_PWD="" if [ -f "${SQLgrey_CONFIG}" ]; then if (grep -iq "^[\t ]*db_pass[\t ]*=[\t ]*.*$" ${SQLgrey_CONFIG}); then # User already has a db_pass entry SQLgrey_CONF_PWD="$(sed -n 's:^[\t ]*db_pass[\t ]*=[\t ]*\(.*\)[\t ]*:\1:gIp' ${SQLgrey_CONFIG})" else SQLgrey_CONF_PWD="" fi else ewarn "SQLgrey configuration missing. Exiting now." echo exit 0 fi # Check if we need SQLgrey to configure for this system or not local SQLgrey_DB_HOST="localhost" local SQLgrey_KEY_INPUT="l,r,x" einfo "SQLgrey database backend configuration" einfo " Please select where SQLgrey database will run:" einfo " [l] Database backend runs on localhost" einfo " [r] Database backend runs on remote host" einfo " [x] Exit" echo einfo " Press one of the keys [${SQLgrey_KEY_INPUT}]: " while true; do read -n 1 -s SQLgrey_ACCESS_TYPE case "${SQLgrey_ACCESS_TYPE}" in "r" | "R" ) SQLgrey_ACCESS_TYPE="r" einfo " remote setup" read -p " Please enter the remote hostname: " SQLgrey_DB_HOST echo break ;; "l" | "L" ) SQLgrey_ACCESS_TYPE="l" einfo " local setup" echo break ;; "x" | "X" ) exit 0 ;; esac done # Generate random password if [[ "${SQLgrey_CONF_PWD}" == "" ]]; then einfo "Generating random database user password..." local SQLgrey_PWD_MATRIX="0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz" local SQLgrey_DB_USER_PWD="" while [ "${n:=1}" -le "16" ]; do SQLgrey_DB_USER_PWD="${SQLgrey_DB_USER_PWD}${SQLgrey_PWD_MATRIX:$(($RANDOM%${#SQLgrey_PWD_MATRIX})):1}" let n+=1 done else einfo "Reusing current database user password..." local SQLgrey_DB_USER_PWD="${SQLgrey_CONF_PWD}" fi echo # Configure the various database backends local SQLgrey_KEY_INPUT="" einfo "Creating SQLgrey database backend data and configuration" einfo " Please select what kind of database you like to use:" if use postgres || has_version dev-perl/DBD-Pg ; then einfo " [p] PostgreSQL" SQLgrey_KEY_INPUT="${SQLgrey_KEY_INPUT},p" fi if use mysql || has_version dev-perl/DBD-mysql ; then einfo " [m] MySQL" SQLgrey_KEY_INPUT="${SQLgrey_KEY_INPUT},m" fi if use sqlite || has_version dev-perl/DBD-SQLite ; then einfo " [s] SQLite" SQLgrey_KEY_INPUT="${SQLgrey_KEY_INPUT},s" fi einfo " [x] Exit" SQLgrey_KEY_INPUT="${SQLgrey_KEY_INPUT},x" echo einfo " Press one of the keys [${SQLgrey_KEY_INPUT:1}]: " while true; do read -n 1 -s SQLgrey_DB_TYPE case "${SQLgrey_DB_TYPE}" in "p" | "P" ) SQLgrey_DB_TYPE="p" einfo " PostgreSQL database backend" echo break ;; "m" | "M" ) SQLgrey_DB_TYPE="m" einfo " MySQL database backend" echo break ;; "s" | "S" ) SQLgrey_DB_TYPE="s" einfo " SQLite database backend" echo break ;; "x" | "X" ) exit 0 ;; esac done # If we don't use SQLite, the password must not be set if [[ ( "${SQLgrey_DB_TYPE}" != "s" ) && ( "${SQLgrey_CONF_PWD}" != "" ) ]]; then ewarn "This configuration is only for new installations. You seem to" ewarn "have already a modified sqlgrey.conf" ewarn "Do you want to continue?" SQLgrey_KEY_INPUT="y,n" einfo " Press one of the keys [$SQLgrey_KEY_INPUT]: " while true; do read -n 1 -s SQLgrey_Ignore case "$SQLgrey_Ignore" in "y"|"Y" ) break ;; "n"|"N" ) exit 0 ;; esac done fi ## Per-RDBMS configuration ## # POSTGRESQL if [[ "${SQLgrey_DB_TYPE}" == "p" ]] ; then ewarn "If prompted for a password, please enter your PgSQL postgres password" ewarn "" einfo "Creating SQLgrey PostgreSQL database \"${SQLgrey_DB_NAME}\" and user \"${SQLgrey_DB_USER_NAME}\"" /usr/bin/psql -h ${SQLgrey_DB_HOST} -d template1 -U postgres -c "CREATE USER ${SQLgrey_DB_USER_NAME} WITH PASSWORD '${SQLgrey_DB_USER_PWD}' NOCREATEDB NOCREATEUSER; CREATE DATABASE ${SQLgrey_DB_NAME}; GRANT ALL PRIVILEGES ON DATABASE ${SQLgrey_DB_NAME} TO ${SQLgrey_DB_USER_NAME}; GRANT ALL PRIVILEGES ON SCHEMA public TO ${SQLgrey_DB_USER_NAME}; UPDATE pg_database SET datdba=(SELECT usesysid FROM pg_shadow WHERE usename='${SQLgrey_DB_USER_NAME}') WHERE datname='${SQLgrey_DB_NAME}';" einfo "Changing SQLgrey configuration in sqlgrey.conf" sed -i "s:^[# ]*\(db_type[ \t]*= \).*:\1Pg:gI" ${SQLgrey_CONFIG} sed -i "s:^[# ]*\(db_user[ \t]*= \).*:\1${SQLgrey_DB_USER_NAME}:gI" ${SQLgrey_CONFIG} sed -i "s:^[# ]*\(db_pass[ \t]*= \).*:\1${SQLgrey_DB_USER_PWD}:gI" ${SQLgrey_CONFIG} sed -i "s:^[# ]*\(db_host[ \t]*= \).*:\1${SQLgrey_DB_HOST}:gI" ${SQLgrey_CONFIG} sed -i "s:^[# ]*\(db_name[ \t]*= \).*:\1${SQLgrey_DB_NAME}:gI" ${SQLgrey_CONFIG} elif [[ "${SQLgrey_DB_TYPE}" == "m" ]] ; then # MYSQL ewarn "If prompted for a password, please enter your MySQL root password" ewarn "" einfo "Creating SQLgrey MySQL database \"${SQLgrey_DB_NAME}\" and user \"${SQLgrey_DB_USER_NAME}\"" echo -ne " " /usr/bin/mysql -u root -h ${SQLgrey_DB_HOST} -p -e "CREATE DATABASE IF NOT EXISTS ${SQLgrey_DB_NAME}; GRANT ALL ON ${SQLgrey_DB_NAME}.* TO ${SQLgrey_DB_USER_NAME}@${SQLgrey_DB_HOST} IDENTIFIED BY '${SQLgrey_DB_USER_PWD}';FLUSH PRIVILEGES;" -D mysql echo einfo "Changing SQLgrey configuration in sqlgrey.conf" sed -i "s:^[# ]*\(db_type[ \t]*= \).*:\1mysql:gI" ${SQLgrey_CONFIG} sed -i "s:^[# ]*\(db_user[ \t]*= \).*:\1${SQLgrey_DB_USER_NAME}:gI" ${SQLgrey_CONFIG} sed -i "s:^[# ]*\(db_pass[ \t]*= \).*:\1${SQLgrey_DB_USER_PWD}:gI" ${SQLgrey_CONFIG} sed -i "s:^[# ]*\(db_host[ \t]*= \).*:\1${SQLgrey_DB_HOST}:gI" ${SQLgrey_CONFIG} sed -i "s:^[# ]*\(db_name[ \t]*= \).*:\1${SQLgrey_DB_NAME}:gI" ${SQLgrey_CONFIG} elif [[ "${SQLgrey_DB_TYPE}" == "s" ]] ; then einfo "Changing SQLgrey configuration in sqlgrey.conf" sed -i "s:^[# ]*\(db_type[ \t]*= \).*:\1SQLite:gI" ${SQLgrey_CONFIG} sed -i "s:^[# ]*\(db_name[ \t]*= \).*:\1${SQLgrey_DB_NAME}:gI" ${SQLgrey_CONFIG} sed -i "s:^[# ]*\(db_user[ \t]*=.*\)$:# \1:gI" ${SQLgrey_CONFIG} sed -i "s:^[# ]*\(db_pass[ \t]*= .*\)$:# \1:gI" ${SQLgrey_CONFIG} sed -i "s:^[# ]*\(db_host[ \t]*= .*\)$:# \1:gI" ${SQLgrey_CONFIG} sed -i "s:^[# ]*\(db_cleandelay[ \t]*= .*\)$:# \1:gI" ${SQLgrey_CONFIG} fi echo if [[ "${SQLgrey_DB_TYPE}" != "s" ]]; then einfo "Note: the database password is stored in $SQLgrey_CONFIG" fi } sqlgrey-1.8.0/sqlgrey.spec000066400000000000000000000215731171713015400155600ustar00rootroot00000000000000%define name sqlgrey %define ver 1.8.0 %define rel 1 Summary: SQLgrey is a postfix grey-listing policy service. Name: %{name} Version: %{ver} Release: %{rel} License: GPL Vendor: Lionel Bouton Url: http://sqlgrey.sourceforge.net Packager: Lionel Bouton Group: System Utils Source: %{name}-%{ver}.tar.bz2 BuildRoot: /var/tmp/%{name}-%{ver}-build BuildArch: noarch %description SQLgrey is a Postfix grey-listing policy service with auto-white-listing written in Perl with SQL database as storage backend. Greylisting stops 50 to 90 % junk mails (spam and virus) before they reach your Postfix server (saves BW, user time and CPU time). %prep %setup %build make %install make rh-install ROOTDIR=$RPM_BUILD_ROOT %clean make clean %files %defattr(-,root,root) /etc/init.d/sqlgrey /usr/sbin/sqlgrey /usr/sbin/update_sqlgrey_config /usr/bin/sqlgrey-logstats.pl /usr/share/man/man1/sqlgrey.1* %doc README* HOWTO Changelog FAQ TODO %defattr(644,root,root) %config(noreplace) /etc/sqlgrey/sqlgrey.conf /etc/sqlgrey/clients_ip_whitelist /etc/sqlgrey/clients_fqdn_whitelist /etc/sqlgrey/discrimination.regexp /etc/sqlgrey/dyn_fqdn.regexp /etc/sqlgrey/smtp_server.regexp /etc/sqlgrey/README %pre getent group sqlgrey > /dev/null || /usr/sbin/groupadd sqlgrey getent passwd sqlgrey > /dev/null || /usr/sbin/useradd -g sqlgrey \ -d /var/sqlgrey -s /bin/true sqlgrey %postun if [ $1 = 0 ]; then if [ `getent passwd sqlgrey | wc -l` = 1 ]; then /usr/sbin/userdel sqlgrey fi if [ `getent group sqlgrey | wc -l` = 1 ]; then /usr/sbin/groupdel sqlgrey fi fi %changelog * Mon Feb 13 2012 Martin Matuska - 1.8.0 release - Allow to specify complete DSN in configuration file - Support listening on UNIX sockets - Support pidfile command line argument * Mon Aug 17 2009 Michal Ludvig - 1.7.7 release getting ready - Reworked "smart" IPv6 address handling. - Added IPv6 address support for clients_ip_whitelist(.local) file * Sun Aug 05 2007 Lionel Bouton - 1.7.6 release - numerous bugfixes, update to last current release version * Wed Nov 16 2005 Lionel Bouton - 1.7.3 release - fixes for a crash with '*' in email adresses * Tue Oct 25 2005 Lionel Bouton - 1.7.2 release - fixes for several errors in logging - clean_method ported from 1.6.x * Thu Sep 15 2005 Lionel Bouton - 1.7.1 release - fix for race condition in multiple instances configurations - fix for weekly stats * Tue Jun 21 2005 Lionel Bouton - 1.7.0 release - now continue if the DB isn't available at startup time - based on 1.6.0 with Michel Bouissou's work: . better connect cleanup when creating AWL entries . source IP throttling * Thu Jun 16 2005 Lionel Bouton - 1.6.0 release - fix for alternate conf_dir - fix for timestamp handling in log parser - log parser cleanup - added README.PERF and documentation cleanup * Tue Jun 07 2005 Lionel Bouton - 1.5.9 release - fix for MySQL's mishandling of timestamps - better log parser * Thu Jun 02 2005 Lionel Bouton - 1.5.8 release - fix for Makefile: rpmbuild didn't work * Wed Jun 01 2005 Lionel Bouton - 1.5.7 release - fix for a memory leak - config directory now user-configurable - preliminary log analyser * Mon May 02 2005 Lionel Bouton - 1.5.6 release - fix for MySQL disconnection crash - IPv6 support - Optin/optout support * Tue Apr 25 2005 Lionel Bouton - 1.5.5 release - small fix for SRS (again!) - small fix for deverp code - log types * Tue Mar 15 2005 Lionel Bouton - 1.5.4 release - fix for regexp compilation (regexp in fqdn_whitelists didn't work) * Sat Mar 05 2005 Lionel Bouton - 1.5.3 release - the cleanup is now done in a separate process to avoid stalling the service * Thu Mar 03 2005 Lionel Bouton - 1.5.2 release - optimize SQL queries by avoiding some now() function calls * Wed Mar 02 2005 Lionel Bouton - 1.5.1 release - replaced smart algorithm with Michel Bouissou's one * Wed Feb 23 2005 Lionel Bouton - 1.5.0 release - drop support for obsolete command-line parameters - migrate databases to a new layout : . first_seen added to the AWLs . optimize AWL Primary Keys . add indexes * Mon Feb 21 2005 Lionel Bouton - 1.4.8 release - AWL performance bugfix - bad handling of database init errors fixed * Fri Feb 18 2005 Lionel Bouton - 1.4.7 release - MAIL FROM: <> bugfix * Fri Feb 18 2005 Lionel Bouton - 1.4.6 release - update_sqlgrey_whitelists fix - removed superfluous regexp in deVERP code * Thu Feb 17 2005 Lionel Bouton - 1.4.5 release - update_sqlgrey_whitelists temporary directory fixes from Michel Bouissou - return code configurable patch from Michel Bouissou - VERP and SRS tuning, with input from Michel Bouissou - VERP and SRS normalisation is used only in the AWLs * Mon Feb 14 2005 Lionel Bouton - 1.4.4 release - Autowhitelists understand SRS - more VERP support for autowhitelists - SQLgrey can warn by mail when the database is unavailable - update_sqlgrey_whitelists doesn't rely on mktemp's '-t' parameter anymore. * Sun Feb 06 2005 Lionel Bouton - 1.4.3 release - log to stdout when not in daemon mode - added update_sqlgrey_whitelists script whitelists can now be fetched from repositories * Thu Jan 13 2005 Lionel Bouton - 1.4.2 release - Better cleanup logging from Rene Joergensen - Fix for Syslog.pm error messages at init time - Fix doc packaging in RPM * Tue Jan 11 2005 Lionel Bouton - 1.4.1 release - fix for invalid group id messages from Øystein Viggen - allow reloading whitelists with SIGUSR1 - db_maintdelay user-configurable - don't log pid anymore * Fri Dec 10 2004 Lionel Bouton - 1.4.0 release - windows for SQL injection fix (reported by Øystein Viggen) - spec file tuning inspired by Derek Battams * Tue Nov 30 2004 Lionel Bouton - 1.3.6 release - whitelist for FQDN as well as IP - 3 different greylisting algorithms (RFE from Derek Battams) * Mon Nov 22 2004 Lionel Bouton - 1.3.4 release - ip whitelisting * Mon Nov 22 2004 Lionel Bouton - 1.3.3 release - preliminary whitelist support * Wed Nov 17 2004 Lionel Bouton - 1.3.2 release - RPM packaging fixed - DB connection pbs don't crash SQLgrey anymore * Thu Nov 11 2004 Lionel Bouton - 1.3.0 release - Database schema slightly changed, - Automatic database schema upgrade framework * Sun Nov 07 2004 Lionel Bouton - 1.2.0 release - SQL code injection protection - better DBI error reporting - better VERP support - small log related typo fix - code cleanups * Mon Oct 11 2004 Lionel Bouton - 1.1.2 release - pidfile handling code bugfix * Mon Sep 27 2004 Lionel Bouton - 1.1.1 release - MySQL-related SQL syntax bugfix * Tue Sep 21 2004 Lionel Bouton - 1.1.0 release - SQLite support (RFE from Klaus Alexander Seistrup) * Tue Sep 14 2004 Lionel Bouton - 1.0.1 release - man page cleanup * Tue Sep 07 2004 Lionel Bouton - pushed default max-age from 12 to 24 hours * Sat Aug 07 2004 Lionel Bouton - bug fix for space trimming values from database * Tue Aug 03 2004 Lionel Bouton - trim spaces before logging possible spams - v1.0 added license reference at the top at savannah request * Fri Jul 30 2004 Lionel Bouton - Bugfix: couldn't match on undefined sender - debug code added * Fri Jul 30 2004 Lionel Bouton - Removed NetAddr::IP dependency at savannah request * Sat Jul 17 2004 Lionel Bouton - Default max-age pushed to 12 hours instead of 5 (witnessed more than 6 hours for a mailing-list subscription system) * Fri Jul 02 2004 Lionel Bouton - Documentation * Thu Jul 01 2004 Lionel Bouton - PostgreSQL support added * Tue Jun 29 2004 Lionel Bouton - various cleanups and bug hunting * Mon Jun 28 2004 Lionel Bouton - 2-level AWL support * Sun Jun 27 2004 Lionel Bouton - Initial Version, replaced BDB by mysql in postgrey sqlgrey-1.8.0/tester.pl000077500000000000000000000035501171713015400150570ustar00rootroot00000000000000#!/usr/bin/perl # Tester for SQLgrey # Michal Ludvig (c) 2009 use strict; use IO::Socket::INET; use Getopt::Long; my $host = "localhost"; my $port = 2501; my $client_address = ""; my $client_name = ""; my $sender = ""; my $recipient = ""; GetOptions ( 'host|server=s' => \$host, 'port=i' => \$port, 'client-ip|client-address=s' => \$client_address, 'name|client-name=s' => \$client_name, 'sender|from=s' => \$sender, 'recipient|to=s' => \$recipient, 'help' => sub { &usage(); }, ); if (not $client_address) { &usage(); } my %connect_args = ( PeerAddr => $host, PeerPort => $port, Proto => 'tcp', Timeout => 5); my $sock = IO::Socket::INET->new(%connect_args) or die ("Connect failed: $@\n"); $sock->print("request=smtpd_access_policy protocol_state=RCPT protocol_name=SMTP client_address=$client_address client_name=$client_name reverse_client_name=$client_name helo_name=$client_name sender=$sender recipient=$recipient recipient_count=0 queue_id= instance=abc.defghi.jklm.no size=0 etrn_domain= sasl_method= sasl_username= sasl_sender= ccert_subject= ccert_issuer= ccert_fingerprint= encryption_protocol= encryption_cipher= encryption_keysize=0 "); print $sock->getline(); exit(0); sub usage() { print( "Test tool for SQLgrey daemon. Author: Michal Ludvig (c) 2009 http://www.logix.net.nz Usage: tester.pl --client-ip
[--options] --host address to talk to (default: 127.0.0.1) --port TCP port SQLgrey daemon listens on (2501) --client-ip IP or IPv6 address of the 'client' (Required). --client-fqdn Domain name corresponding to --ip --sender / --from Envelop MAIL FROM value --recipient / --to Envelop RCPT TO value --help Guess what ;-) "); exit(0); } sqlgrey-1.8.0/update_sqlgrey_config000077500000000000000000000041671171713015400175210ustar00rootroot00000000000000#!/bin/bash # We need md5sum, diff and wget MD5SUM=`which md5sum 2>/dev/null` if [ $? -ne 0 ] then echo "md5sum not found in PATH, can't continue" exit -1 fi DIFF=`which diff 2>/dev/null` if [ $? -ne 0 ] then echo "diff not found in PATH, can't continue" exit -1 fi WGET=`which wget 2>/dev/null` if [ $? -ne 0 ] then echo "wget not found in PATH, can't continue" exit -1 fi # md5sum output parsing need a known locale LANG=C LC_ALL=C MYDIR=/etc/sqlgrey CONF=$MYDIR/sqlgrey.conf # Get whitelists host and pidfile from conf whitelist_host=`grep "^[[:space:]]*whitelists_host" $CONF | cut -d= -f2 | awk '{print $1}'` if [ -z "$whitelists_host" ] then whitelists_host="sqlgrey.bouton.name" fi pidfile=`grep "^[[:space:]]*pidfile" $CONF | cut -d= -f2 | awk '{print $1}'` if [ -z "$pidfile" ] then pidfile="/var/run/sqlgrey.pid" fi # Go into a temp directory MYTMP=`mktemp -d ${TMPDIR:-/tmp}/sqlgrey.XXXXXX` [ -n "$MYTMP" -a -d "$MYTMP" ] && cd $MYTMP || { echo "Error creating temporary directory" exit 1 } # Setup a clean exit clean_exit() { cd ~sqlgrey [ -n "$MYTMP" -a -d "$MYTMP" ] && rm -rf $MYTMP exit $1 } trap clean_exit 2 3 15 # Fetch MD5 $WGET -q http://$whitelists_host/MD5SUMS # Check installed files cd $MYDIR TOUPDATE=`md5sum -c $MYTMP/MD5SUMS 2>/dev/null | grep FAILED | cut -d: -f1` if [ -z "$TOUPDATE" ] then clean_exit 0 fi cd $MYTMP # copy old files for whitelist in `cat MD5SUMS|awk '{print $2}'` do cp $MYDIR/$whitelist . 2>/dev/null done # fetch new ones for todownload in $TOUPDATE do echo "updating $MYDIR/$todownload:" rm $todownload 2>/dev/null $WGET -N -q http://$whitelists_host/$todownload if [ -f $MYDIR/$todownload ]; then $DIFF -u $MYDIR/$todownload $todownload else echo "new file: $todownload" fi done md5sum -c MD5SUMS >/dev/null 2>/dev/null if [ $? -ne 0 ] then # Can only happen if remote site is borked or file got corrupt in transit echo "Error fetching new files, try later" clean_exit -1 fi # MD5SUMS isn't needed anymore rm MD5SUMS # Replace whitelists mv * $MYDIR # Reload whitelists kill -USR1 `cat $pidfile` clean_exit 0