pax_global_header00006660000000000000000000000064124024760240014513gustar00rootroot0000000000000052 comment=3b8a0f9c9bad59be8b4df73be23cc7a3af13e169 qpsmtpd-0.94/000077500000000000000000000000001240247602400131375ustar00rootroot00000000000000qpsmtpd-0.94/.gitignore000066400000000000000000000005751240247602400151360ustar00rootroot00000000000000/config /config/ /pm_to_blib /blib/ # only ignore top-level Makefile; we need the one in packaging/rpm! /Makefile Makefile.[a-z]* # ignore file produced by rpm build process /packaging/rpm/qpsmtpd.spec packaging/rpm/build/ *~ *.bak denysoft_greylist.dbm denysoft_greylist.dbm.lock greylist.dbm greylist.dbm.lock /cover_db/ .last_cover_stats *.tar.gz MANIFEST.bak nytprof.out qpsmtpd-0.94/.perltidyrc000066400000000000000000000006471240247602400153300ustar00rootroot00000000000000 -i=4 # 4 space indentation (we used to use 2; in the future we'll use 4) -ci=2 # continuation indention -pt=2 # tight parens -sbt=2 # tight square parens -bt=2 # tight curly braces -bbt=0 # open code block curly braces -lp # line up with parentheses -cti=1 # align closing parens with opening parens ("closing token placement") # -nolq # don't outdent long quotes (not sure if we should enable this) qpsmtpd-0.94/.travis.yml000066400000000000000000000001011240247602400152400ustar00rootroot00000000000000language: perl perl: - "5.16" - "5.14" - "5.12" - "5.10" qpsmtpd-0.94/CREDITS000066400000000000000000000027271240247602400141670ustar00rootroot00000000000000Jim Winstead : the core "command dispatch" system in qpsmtpd is taken from his colobus nntp server. The check_badmailfrom and check_mailrcptto plugins. John Peacock : More changes, fixes and vast improvements for me to ever catch up on here. Matt Sergeant : Clamav plugin. Patch for the dnsbl plugin to give us all the dns results. Resident SpamAssassin guru. PPerl. smtp-forward plugin. Documentation (yay!). Lots of fixes and tweaks. Apache module. Event based high performance experiment. Devin Carraway : Patch to not accept half mails if the connection gets dropped at the wrong moment. Support and enable taint checking. MAIL FROM host dns check configurable. HELO hook. initial earlytalker plugin. Andrew Pam : fixing the maximum message size (databytes) stuff. Marius Kjeldahl , Zukka Zitting : Patches for supporting $ENV{RELAYCLIENT} Robert Spier : Klez filter. Rasjid Wilcox : Lots of patches as per the Changes file. Kee Hinckley : Sent me the correct strftime format for the dates in the "Received" headers. Gergely Risko : Fixed timeout bug when the client sent DATA and then stopped before sending the next line. ... and many many others per the Changes file and version control logs and mailing list archives. Thanks everyone! qpsmtpd-0.94/Changes000066400000000000000000001111261240247602400144340ustar00rootroot00000000000000 0.94 Sep 05, 2014 Added null char in username check to auth_cvm plugin Build updates for CentOS 6 (Robert Siddall) SpamAssassin plugin fixes (Priyadi Nurcahyo) Added plugins/stunnel (luzluna) Fixed a config error in Apache/Qpsmtpd.pm (luzluna) loadcheck: imported (Robert Siddall) return a useful error message when temp rejecting connections (Priyadi) smtp_forward: added Postfix XCLIENT support (Chase Venters) smtp_forward: add the remote message id in log entry (tpoindessous) clamdscan: added support for remote (TCP/IP) clamd (M Simerson) Updated DMARC plugin to use Mail::DMARC Updated SPF & DKIM plugins to store data for DMARC processing karma plugin: added spammy TLD penalty a few more log prefixes (corralling stragglers) 0.93 Dec 17, 2013 Added Authentication-Results header moves Authentication-Results to Original-Authentication-Results on inbound. no longer puts auth info in Received header TcpServer: ignore DNS search path and explicitely request PTR lookups (speedup) store envelope TO/FROM in connection notes raised max msg size in clamdscan SPF enabled by default (if Mail::SPF available) auth_vpopmaild: added taint checking to responses added run files for most common deployment methods (easier install) untaint config data passed to plugins Qpsmtpd.pm: split config args on /\s+/, was / / (compatibility with newer versions of perl) dmarc: added subdomain policy handling 0.92 Apr 20, 2013 new plugins: dmarc, fcrdns new feature: DKIM message signing. See 'perldoc plugins/dkim' for details. includes script for generating DKIM selectors, keys, and DNS records. RAM bumped up to 300MB, to avoid memory exhaustion errors. Qpsmtpd.pm: untaint config options before passing them to plugins. auth_vpopmaild: untaint responses obtained from network. Combined with the taint fix for config options, enables auth_vpopmaild to work when setting the host config and port tls: added ability to store SSL keys in config/ssl log2sql: added UPDATE query support removed FAQ to: https://github.com/qpsmtpd-dev/qpsmtpd-dev/wiki/faq helo: cease processing DNS records after first positive match karma: sprinkled karma awards throughout other plugins - limit poor karma hosts to 1 concurrent connection - allow +3 conncurrent connections to hosts with good karma - limit recipients to 1 for senders with negative karma Sanitize spamd_sock path for perl taint mode - Markus Ullmann geo_ip: added too_far option (deduct karma from distant senders) bogus_bounce: add Return-Path check, per RFC 3834 Fix for Net::DNS break - Markus Ullmann SPF: arrange logic to so improve reliability of spf pass reporting (helpful to DMARC plugin) is_naughty removed from is_immune feature. Allows more granular handling by plugins. 0.91 Nov 20, 2012 a handful of minor changes to log messages, similar to v0.90 replace all instances of split '' with split // (required for 5.1?+) clamdscan: skip processing of naughty messages TcpServer: improved IPv6 support (Michael Holzt) SPF: improved support for IPv6, removed is_in_relayclient in favor of checking if relayclient() note is set. spamassassin: added 'headers none' option qmail_deliverable: added vpopmail extension support, reject null senders to ezmlm mailing lists. dnsbl rejections handled by naughty plugin changed default loglevel from 9 to 6 allow messages with no body: (Robin's patch) ordered config.sample/plugins roughly in SMTP phase order added Plugins::adjust_karma, reduces code requirements in other plugins added whitelist plugin helo: added is_plain_ip to lenient checks dspam improvements added log2sql, log/watch.pl, log/summarize.pl, and plugins/registry.txt new dkim plugin added (deprecates domainkeys plugin). 0.90 Jun 27, 2012 Many logging adjustments for plugins, to achieve the goal of emitting a single message per plugin that provides a summary of that plugins action(s) and/or outcome(s). qmail_deliverable plugin added (depends on Qmail::Deliverable). karma plugin added. naughty plugin added. count_unrecognized_commands: corrected variable assignment error connection_time: added tcpserver deployment compatibility loop: max_hops was sometimes unset dnsbl,rhsbl: process DNS queries syncronously to improve overall efficiency insert headers at top of message (consistent SMTP behavior) in uribl domainkeys, spamassassin plugins. spamassassin: consolidated two data_post methods (more linear, simpler) rewrote check_basicheaders -> headers renamed check_loop -> loop renamed check_badrcptto -> badrcptto renamed check_badmailfromto -> badmailfromto renamed check_badmailfrom -> badmailfrom check_badmailfrom_patterns, merged functionality into check_badmailfrom check_badrcptto_patterns, merged functionality into check_badrcptto check_basicheaders. New arguments available: past, future, reject, reject_type sender_permitted_from. see UPGRADING (Matt Simerson) dspam plugin added (Matt Simerson) p0f version 3 supported and new default. see UPGRADING (Matt Simerson) resolvable_fromhost ignores DNS search path (i.e. it expects fully resolved domains) (Robert Spier, Charlie Brady) new plugin auth_vpopmaild (Robin Bowes) new plugin auth_checkpassword (Matt Simerson) auth_vpopmail_sql: more flexible db config (Matt Simerson) new plugin check_bogus_bounce (Steve Kemp) clamav: added ClamAV version to the X-Virus-Checked header, as well as noting "no virus found". (Matt Simerson) assorted documentation cleanups (Steve Kemp, Robert Spier) Revert "Spool body when $transaction->body_fh() is called" 0.84 April 7, 2010 uribl: fix scan-headers option (Jost Krieger, Robert Spier) exim: Use BSMTP response codes, various cleanups (Devin Carraway) config: cache returned values from config plugins (Peter J. Holzer) AUTH PLAIN bug with Alpine (Rick Richard) resolvable_fromhost: Moved DENYSOFT for temp_resolver_failed to the RCPT TO hook. (Larry Nedry) Note Net::IP dependency (Larry Nedry) Various minor spelling cleanups and such (Steve Kemp, Devin Carraway) rpm: create .rpm files from the packaging/rpm directory (Peter J. Holzer, Robin Bowes, Filippo Carletti, Richard Siddell) spamassasin: Custom spam tag subject munging (Jonathan Martens, Robert Spier) clamav: Fix typo in name of default configuration file (Filippo Carletti) 0.83 September 15, 2009 plugins/queue/maildir: Allow hyphens in the maildir path (Hinrik Örn Sigurðsson) Modify plugins/virus/clamav no-summary option for ClamAV 0.95 (Jonathan Martens) Temporary deny if clamd is not running (Shad L. Lords) Fix spamassassin plugin log noise if spam score is 0.0 Fix spool_dir configuration documentation and README update (Tomas Lee) Disconnect host in rhsbl (Charlie Brady) POD cleanups (Steve Kemp) check_badmailfrom: Fix parsing of reason messages etc (Robert Spier, Tomas Lee) check_spamhelo disconnects after denying a 'helo' (Filippo Carletti) Log even when aren't in a transaction (Jared Johnson) prefork: More robust child spawning (Peter Samuelson) Add dup_body_fh method to return a dup'd body FH (Jared Johnson) 0.82 - June 2, 2009 prefork: Fix problem with processes sometimes being "left behind" (Charlie Brady) prefork: Fix startup when no interface addresses are specified (Devin Carraway) prefork: add multi-address support The clamdscan virus-scanning plugin now requires the ClamAV::Client perl module instead of the older, deprecated Clamd module (Devin Carraway) prefork: support --listen-address for consistency with forkserver prefork: Sanitize the shell environment before loading modules 0.81 - April 2, 2009 Close spamd socket after reading the result back (Jared Johnson) p0f plugin updates (Tom Callahan) Change transaction->add_recipient to skip adding "null" rcpt if passed Add logging/apache plugin for logging to the apache error log Add connection_time plugin Add git information to version number when running from a git clone Add rcpt_regexp plugin (Hanno Hecker) Add notes method to Qpsmtpd::Address objects (Jared Johnson) Add remove_recipient method to the transaction object (Jared Johnson) 0.80 - February 27, 2009 moved development to git repository! reorganized plugin author documentation added End of headers hook: data_headers_end added "random error plugin" improve logging of plugins generating fatal errors (Steve Kemp) async: added $connection->local_ip, $connection->local_port async: Fix bug where the body_file/body_filename wouldn't have headers lower log level of rcpt/from addresses prefork: improve shutdown of parent (and children) on very busy systems (Diego d'Ambra) prefork: exit codes cleanup (based on patch by Diego d'Ambra) prefork: detect and reset locked shared memory (based on patch by Diego d'Ambra) prefork: untaint the value of the --interface option (reported by Diego d'Ambra) prefork: the children pool size was sometimes not adjusted immediately after the exit of children (reported by Diego d'Ambra) async, prefork: detach and daemonize only after reading the configuration and loading the plugins, to give the init scripts a chance to detect failed startups due to broken configuration or plugins (Diego d'Ambra) plugins/tls: close the file descriptor for the SSL socket plugins/queue/maildir: multi user / multi domain support added set the Return-Path header when queuing into maildir mailboxes plugins/resolvable_fromhost: check all MX hosts, not just the first remove outdated virus/check_for_hi_virus plugin prefork, forkserver: restart on SIGHUP (reload all modules, with register() or init() phase). prefork: add --detach option to daemonize like forkserver use user/group switching from forkserver to support secondary groups (needed with plugins/queue/postfix-queue) --pid-file now works apache: add post-connection hook, connection->reset Create async version of dns_whitelist_soft, rhsbl and uribl plugins. async: added pre- and post-connection hooks improve handling of inetd/xinetd connections (Hanno Hecker) Qpsmtpd::Connection->notes are now reset on end of connection (currently not in Apache). The workaround plugins/tls for -prefork is no longer needed now. keep the square brackets around the IP as "remote_host" if the reverse lookup failed (Hanno Hecker) async: Dereference the DATA deny message before sending it to the client Change async/resolvable_fromhost to match the logic of the non-async version and other MTAs async: Handle End-of-data marker split across packets Allow plugins to use the post-fork hook Add qpsmtpd-prefork to the install targets (Robin Bowes) Address definitions are now package vars and can be overriden for sites that wish to change the definition of an email address. (Jared Johnson) http://groups.google.com/group/perl.qpsmtpd/browse_thread/thread/35e3a187d8e75cbe New config option "spool_perms" to set permissions of spool_dir (Jared Johnson) leading/trailing whitespace in config files is ignored (Henry Baragar) 0.43 - February 5, 2008 - Never offically released; oops. (This release was mostly done by Matt Sergeant and Hanno Hecker) Allow qpsmtpd-async to detatch (Chris Lewis). plugins/tls: work-around for failed connections in -prefork after STARTTLS connection (Stefan Priebe, Hanno Hecker) Make the cleanup socket location parameter in the postfix plugin work (ulr...@topfen.net) Implement config caching properly (for async). Hook/plugin caching Remove the connection / transaction id feature (never released) Option to clamdscan to scan all messages, even if there are no attachments add new clamd_user parameter that sets the user we pass to clamd async: Support for HUPing the server to clear the cache. Wake-one child support. async: Don't listen for readiness in the parent any more - breaks under high load. Made user() and host() setters as well as getters in Qpsmtpd::Address. Suggested by mpelzer@gmail.com. Pluggable "help", based on patch by Jose Luis Martinez. Updated plugin documentation. 0.42 - October 1, 2007 - Never released Pluggable hook "noop" Pluggable hook "help" (based on patch by Jose Luis Martinez) async: better config caching (of flat files, not results from hook_config or .cdb files), send SIGHUP to clear cache New docs/plugins.pod documentation! Add X-Spam-Level header in spamassassin plugin (idea from Werner Fleck) prefork: support two or more parallel running instances (on different ports; the first 4 digits of the port number must be different for each instance - see IPC::Sharable). prefork: Fix sporadic bug showing itself after millions of connections (S. Priebe) Remove the auth/authnull sample plugin (there are plenty proper examples now so we don't have to include this insecure plugin) POD syntax cleanup (Steve Kemp) Fix Qpsmtpd::Plugins::isa_plugin() with multiple plugin dirs (Gavin Carr) Fix false positives in check_for_hi_virus plugin (Jerry D. Hedden) Make connection->local_ip available from the Apache transport (Peter Eisch) Support checking for early talkers at DATA Make the documented DENY{,SOFT}_DISCONNECT work in the data-post hook Allow buffered writes in Postfix plugin (from Joe Schaefer) Cleanup spamassassin plugin code a little Fix bug which breaks queue plugins that implement continuations Fix false positives in check_for_hi_virus plugin (Jerry D. Hedden) Unrecognized command fix (issue #16) Updated documentation (Apache 2.2, more) Add uribl plugin (Devin Carraway) 0.40 - June 11, 2007 Add async server - uses epoll/kqueue/poll where available. (Matt Sergeant) Add preforking qpsmtp server (Lars Roland) Support SMTPS (John Peacock) Support "module" plugins ("My::Plugin" in the config/plugins file) Added IPv6 support. (Mike Williams) Added tests for the rcpt_ok plugin (Guy Hulbert, issue #4) Fix logging when dropping a mail due to size (m. allan noah / kitno455, issue #13) Don't drop privileges in forkserver if we don't have to. greylisting: fix db_dir configuration option so it actually works (kitno455, issue #6) Correct header parsing of "space only" lines (Joerg Meyer, issue #11) Update the sample configuration to use zen.spamhaus.org Make the badmailfrom plugin support (optional) rejection messages after the rejection pattern (Robin Hugh Johnson) The ill-named $transaction->body_size() is depreceated now, use $transaction->data_size() instead. Check your logs for LOGWARN messages about "body_size" and fix your plugins. (Hanno Hecker) Support pluggable Received headers (Matt Sergeant) RFC3848 support for ESMTP. (Nick Leverton) Updated the list of DNSBLs in the default config Instead of failing with cryptic message, ignore lines in config/plugins for uninstalled plugins. (John Peacock) Clean up some of the logging (hjp) Patch to prefork code to make it run (Leonardo Helman). Add --pretty option to qpsmtpd-prefork to change $0 for child processes (John Peacock). Add support for multiple plugin directories, whose paths are given by the 'plugin_dirs' configuration. (Devin Carraway, Nick Leverton) Greylisting DBs may now be stored in a configured location, and are looked for by default in /var/lib/qpsmtpd/greylisting in addition to the previous locations relative to the qpsmtpd binary. (Devin Carraway) New Qpsmtpd::Postfix::Constants to encapsulate all of the current return codes from Postfix, plus script to generate it. (Hanno Hecker) Add ability to specific socket for syslog (Peter Eisch) Do the right thing for unimplemented AUTH mechanisms (Brian Szymanski) relay_only plugin for smart relay host. (John Peacock) Enhance the spamassassin plugin to support connecting to a remote spamd process (Kjetil Kjernsmo). Add domainkeys plugin (John Peacock) Add SSL encryption method to header to mirror other qmail/SSL patches. Add tls_before_auth to suppress AUTH unless TLS has already been established (Robin Johnson). Fix "help" command when there's no "smtpgreeting" configured (the default) (Thanks to Thomas Ogrisegg) Move the Qpsmtpd::Auth POD to a top-level README to be more obvious. Add Qpsmtpd::Command to gather all parsing logic in one place (Hanno Hecker) Support multiline responses from plugins (Charlie Brady) Added queue_pre and queue_post hooks (John Peacock) Implement multiple host/port listening for qpsmtpd-forkserver (Devin Carraway) Fix a spurious newline at the start of messages queued via exim (Devin Carraway) Make the clamdscan plugin temporarily deny mail if if can't talk to clamd (Filippo Carletti) Improve Qpsmtpd::Transaction documentation (Fred Moyer) 0.32 - 2006/02/26 Add logging/file plugin for simple logging to a file (Devin Carraway and Peter J. Holzer). Add logging/syslog plugin for logging via the syslog facility (Devin Carrway) Add Qpsmtpd::DSN to return extended SMTP status codes from RFC-1893 and patch existing plugins to use it when appropriate (Hanno Hecker). Add plugins/tls_cert to generate appropriately shaped self-signed certs for TLS support. Add explicit use of CA used to sign cert. Abstract clone()ing of connection information when switching to TLS. Fix the AUTH code to work correctly with TLS. Add hosts_allow plugin to support pre- and post-connection hooks as well as move --max-from-ip tests out of core (Hanno Hecker). Improve postfix-queue plugin to support the known processing flags (Hanno Hecker). Drop root privileges before loading plugins, rather than after. A few fixes to the clamdscan plugin (Dave Rolsky) Various minor fixes and improvements 0.31.1 - 2005/11/18 Add missing files to the distribution, oops... (Thanks Budi Ang!) (exim plugin, tls plugin, various sample configuration files) 0.31 - 2005/11/16 STARTTLS support (see plugins/tls) Added queue/exim-bsmtp plugin to spool accepted mail into an Exim backend via BSMTP. (Devin Carraway) New plugin inheritance system, see the bottom of README.plugins for more information qpsmtpd-forkserver: --listen-address may now be given more than once, to request listening on multiple local addresses (Devin Carraway) (also: no more signal problems making qpsmtpd-forkserver crash/loop when forking). qpsmtpd-forkserver: add an option for writing a PID file (pjh) qpsmtpd-forkserver: set auxiliary groups (this is needed for the postfix backend, which expects to have write permission to a fifo which usually belongs to group postdrop). (pjh) qpsmtpd-forkserver: if -d or --detach is given on the commandline, forkserver will detach from the controlling terminal and daemonize itself (Devin Carraway) replace some fun smtp comments with boring ones. example patterns for badrcptto plugin - Gordon Rowell Extend resolvable_fromhost to include a configurable list of "impossible" addresses to combat spammer forging. (Hanno Hecker) Use qmail/control/smtpdgreeting if it exists, otherwise show the original qpsmtpd greeting (with version information). Apply slight variation on patch from Peter Holzer to allow specification of an explicit $QPSMTPD_CONFIG variable to specify where the config lives, overriding $QMAIL/control and /var/qmail/control if set. The usual "last location with the file wins" rule still applies. Refactor Qpsmtpd::Address when disconncting with a temporary failure, return 421 rather than 450 or 451. (Peter J. Holzer) The unrecognized_command hook now uses DENY_DISCONNECT return for disconnecting the user. If the environment variable $QPSMTPD_CONFIG is set, qpsmtpd will look for its config files in the directory given therein, in addition to (and in preference to) other locations. (Peter J. Holzer) Updated documentation Various minor cleanups 0.30 - 2005/07/05 Add plugable logging support include sample plugin which replicates the existing core code. Add OK hook. Add new logging plugin, logging/adaptive, which logs at different levels depending on whether the message was accepted/rejected. (See README.logging for information about the new logging system by John Peacock) plugins/auth/auth_ldap_bind - New plugin to authenticate against an LDAP database. Thanks to Elliot Foster new plugin: plugins/auth/auth_flat_file - flat file auth plugin new plugin: plugins/auth/auth_cvm_unix_local - Only DENY if the credentials were accepted but incorrect (bad password?). Interfaces with Bruce Guenther's Credential Validation Module (CVM) Revamp Qpsmtpd::Constants so it is possible to retrieve the text representation from the numeric (for logging purposes). new plugin: plugins/check_badrcptto_patterns - Match bad RCPTO address with regex (Gordon Rowell) new plugin: plugins/check_norelay - Carve out holes from larger relay blocks (Also Gordon Rowell) new plugin: plugins/virus/sophie - Uses SOPHOS Antivirus via Sophie resident daemon. Store mail in memory up to a certain threshold (default 10k). Remove needless restriction on temp_file() to allow the spool directory path to include dots (as in ../) Fix off-by-one line numbers in warnings from plugins (thanks to Brian Grossman). Don't check the HELO host for rfc-ignorant compliance body_write patches from Brian Grossman Fix for corruption problem under Apache Update Apache::Qpsmtpd to work with the latest Apache/mod_perl 2.0 API. Fix various bucket issues. Replace $ENV{RELAYCLIENT} with $connection->relay_client in last plugin. Fix typo in qpsmtpd-forkserver commandline help 0.29 - 2005/03/03 Store entire incoming message in spool file (so that scanners can read the complete message) and ignore old headers before adding lines and queuing for delivery. New anti-virus scanners: hbedv (Hanno Hecker), bitdefender, and clamdscan (John Peacock). Update clamav plugin to directly scan the spool file. New temp_file() and temp_dir() methods; when used by plugins, they create a filename or directory which will last only as long as the current transaction. Also created a spool_dir() method which checks/creates the spool_dir when the application starts up. All three methods are also available in the base class where the temp_* objects are not automatically limited to the transaction's lifetime. (John Peacock) Added Gavin Carr's greylisting plugin Renamed config/ to config.sample/ Qpsmtpd::Auth - document $mechanism option, improve fallback to generic hooks, document that auth-login works now, stash auth user and method for later use by Qpsmtpd::SMTP to generate authentication header. (Michael Toren) Qpsmtpd::SMTP - "MAIL FROM: <#@[]>" now works like qmail (null sender), add LOGIN to default auth mechanisms, display auth user and method in Received: line instead of X-Qpsmtpd-Auth header. (Michael Toren) check_badmailfromto - NEW PLUGIN - like check_badmailfrom except matches both FROM: and TO:, and effectively makes it seem like the recipient no longer exists for that sender (great for harassment cases). (John Peacock) earlytalker and resolvable_fromhost - short circuit test if whitelistclient is set. (Michael Toren) check_badmailfrom - Do not say why a given message is denied. (Michael Toren) dns_whitelist_soft - NEW PLUGIN - dns-based whitelist override for other qpsmtpd plugins. Add suuport for whitelisthost to dnsbl. (John Peacock) auth/auth_vpopmail_sql - Support CRAM-MD5 (requires clear_passwd) (John Peacock) plugins/queue/qmail-queue - Added a timestamp and the qmail-queue qp identifier to the "Queued!" message, for compatibility with qmail-smtpd (Michael Toren) Support qmail-smtpd's timeoutsmtpd config file Many improvements to the forking server (qpsmtpd-forkserver) Plugin testing framework (Matt) Added Apache::Qpsmtpd (Apache/mod_perl 2.0 connection handler) Allow for multiple instances of a single plugin by using plugin:0 notation (Robert) Fix CDB support so the server can work without it VRFY plugin support (Robert Spier) Added Makefile.PL etc to make it easier to build a package (Matt). Added Apache::Qpsmtpd to the distro. Make the distro follow the CPAN module style (Makefile.PL, MANIFEST, etc) Make the rhsbl plugin do DNS lookups in the background. (Mark Powell) Fix warning in count_unrecognized_commands plugin (thanks to spaze and Roger Walker) Improve error messages from the Postfix module (Erik I. Bolsø, ) make the maildir plugin record who the message was to (with a bit of improvements this could make a decent local delivery plugin) Pass extra "stuff" to HELO/EHLO callbacks (to make it easier to support SMTP extensions) Renamed the *HARD return codes to DENY_DISCONNECT and DENYSOFT_DISCONNECT (DENYSOFT_DISCONNECT is new) Mail::Address does RFC822 addresses, we need SMTP addresses. Replace Mail::Address with Peter J. Holzer's Qpsmtpd::Address module. Don't keep adding ip addresses to the process status line ($0) when running under PPerl. Include the date and time the session started in the process status line. Add "plugin/virus/uvscan" - McAfee commandline virus scanner Inbound connections logged as soon as the remote host address is known when running under tcpserver. Add Qpsmtpd::Auth (authentication handlers! See plugins/auth/) (John Peacock) Add a plugin hook for the DATA command earlytalker - + optionally react to an earlytalker by denying all MAIL-FROM commands rather than issuing a 4xx/5xx greeting and disconnecting. (Mark Powell) + initial "awkward silence" period now configurable (Mark Powell) + DENY/DENYSOFT now configurable Move relay flag to connection object (John Peacock): + add relay_client() method to Connection.pm + Remove $transaction->relaying() completely (due to popular demand) Split check_relay plugin into two plugins (John Peacock): + check_relay now fires on connect and sets relay_client() flag + rcpt_ok runs last of rcpt plugins and performs final OK/DENY + change default config/plugins to reflect new order 0.28 - 2004/06/05 Don't keep adding ip addresses to the process status line ($0) when running under PPerl. Include the date and time the session started in the process status line. Added a "queue/maildir" plugin for writing incoming mails to a maildir. Create temp files with permissions 0600 (thanks to Robert James Kaes again) Fix warning in check_badrcptto plugin (Thanks to Robert James Kaes) Proper "Log levels" with a configuration option $Include feature in config/plugins 0.27.1 - 2004/03/11 SpamAssassin plugin Outlook compatibility fix (Thanks to Gergely Risko) 0.27 - 2004/03/10 Support for unix sockets in the spamassassin plugin (requires SA 2.60 or higher). Thanks to John Peacock! Modified the dnsbl plugin to better support both A and TXT records and support all of the RBLSMTPD functionality. (Thanks to Mark Powell) reject bare carriage-returns in addition to the bare line-feeds (based on a patch from Robert James Kaes, thanks!) Bugfix to the count_unrecognized_commands plugin so it works under PPerl (it wasn't resetting the count properly). reset_transaction is called after disconnect plugins are called so the Transaction objects DESTROY method is called. (Thanks to Robert James Kaes ) Made the SpamAssassin plugin work with SA 2.6+ (thanks to numerous contributors, thanks everyone!). Note that for now it's not including the Spam: headers with the score explained. For that use the spamassassin_spamc plugin from http://projects.bluefeet.net/ (for now). Added Postfix queue plugin thanks to Peter J Holzer! Took out the last "exit" call from the SMTP object; the "transport" module ("TcpServer", "SelectServer") needs to do the right thing in it's disconnect method. Update the SPF plugin (Philip Gladstone, philip@gladstonefamily.net): * Integrated with Mail::SPF::Query 1.991 * Don't do SPF processing when you are acting as a relay system * Remove the MX changes as they are now inside Mail::SPF::Query Take out Data::Dumper to save a few bytes of memory Say Received: ... via ESMTP instead of via SMTP when the client speaks ESMTP. (Hoping this can be a useful SpamAssassin rule). Take out the X-SMTPD header. Add pod documentation and sanity checking of the config to check_badmailfrom Use $ENV{QMAIL} to override /var/qmail for where to find the control/ directory. Enable "earlytalker" in the default plugins config Added a milter plugin to allow use of sendmail milters Don't store the Qpsmtpd object in the Plugin object any more (this caused a circular reference) Added a new qpsmtpd-server - a select() based server for qpsmtpd Allow a config/relayclients and config/morerelayclients files to define who can relay (useful with the select() server) Fixed qpsmtpd unfolding all header lines Speed up persistent qpsmtpd's by checking for plugin functions after munging the name (the main breakage was with queue/qmail-queue) Use dup2() instead of perl open("<&") style. POSIX seems to work better. Added SPF, sender permitted from, plugin More minor changes and probably a few big ones that we missed adding here :-) 0.26 - 2003/06/11 Add queue/smtp-forward plugin (Matt Sergeant) Add documentation to Qpsmtpd::Transaction (Matt Sergeant) Fix bug in dnsbl that made it sometimes ignore "hits" (thanks to James H. Thompson ) Fix bug hiding the error message when an existing configuration file isn't readable. If a plugin running the ehlo hook add something to the ARRAY reference $self->transaction->notes('capabilities') then it will be added to the EHLO response. Add command_counter method to the SMTP object. Plugins can use this to catch (or not) consecutive commands. In particular useful with the unrecognized_command hook. Filter out all uncommon characters from the remote_host setting. (thanks to Frank Denis / Jedi/Sector One for the hint). Added a check for the spool_dir having mode 0700. Don't break under taint mode on OpenBSD. (thanks to Frank Denis / Jedi/Sector One) Have the qmail-queue plugin add the message-id to the "Queued!" message we send back to the client (to help those odd sendmail using people debug their logs) Set the process name to "qpsmtpd [1.2.3.4 : host.name.tld]" Fixed timeout bug when the client sent DATA and then stopped before sending the next line. (Gergely Risko ) unrecognized_command hook and a count_unrecognized_commands plugin. (Rasjid Wilcox) earlytalker plugin. Deny the connection if the client talks before we show our SMTP banner. (From Devin Carraway) Patch Qpsmtpd::SMTP to allow connect plugins to give DENY and DENYSOFT return codes. Based on patch from Devin Carraway. Support morercpthosts.cdb config now takes an extra "type" parameter. If it's "map" then a reference to a tied hash will be returned. 0.25 - 2003/03/18 Use the proper RFC2822 date format in the Received headers. (Somehow I had convinced myself that ISO8601 dates were okay). Thanks to Kee Hinckley . Print the date in the local timezone instead of in -0000. (Not entirely convinced this is a good idea) Lots of changes from Rasjid Wilcox : Fix error handling in queue/qmail-queue. (Rasjid) Add option to queue/qmail-queue to specify an alternate qmail-queue location. (Rasjid) Add support for the QMAILQUEUE environment variable. (Rasjid) PPerl compatibility (yay!) (Rasjid) Allow mail to and to go through. (Rasjid) Add "deny" hook that gets called when another hook returns DENY or DENYSOFT. (Rasjid) Add list of required modules to the README. Thanks to Skaag Argonius . Fix dnsbl plugin to give us all the results. (Patch from Matt Sergeant ) Disable identd lookups by passing -R to tcpserver. (Thanks to Matt) add plugin hooks for HELO and EHLO (Devin Carraway ) check_spamhelo plugin to deny mail from claimed senders from the list specified in F. (For example aol.com or yahoo.com) (Devin Carraway) 0.20 - 2002/12/09 Fix the "too many dots in the beginning of the line" bug. Add munge_subject_threshold and reject_threshold options to the spamassassin plugin. Add documentation to the spamassassin plugin. Add -p to mkdir in log/run (Rasjid Wilcox ) clamav plugin, thanks to Matt Sergeant, matt@sergeant.org. Enabling this might require you to increase your "softlimit" in the run file. http://www.clamav.org/ Make the spamassassin plugin not stop the next content plugins from running. Store hooks runtime config globally so they will work within the transaction objects too. content_log plugin - log the content of all mails for debugging. Robert Spier . http_config plugin - get configuration via http plugins can take arguments via their line in the "plugins" file make the quit_fortune plugin check that the fortune program exists 0.12 - 2002/10/17 Better error messages when a plugin fails Remove some debug messages in the log Fix NOOP command with perl 5.6. Better installation instructions and error message when no plugin allowed or denied relaying (thanks to Lars Rander ). Use /usr/bin/perl instead of the non-standard /home/perl/bin/perl 0.11 - 2002/10/09 Make a "queue" plugin hook and move the qmail-queue functionality to plugins/queue/qmail-queue. This allows you to make qpsmtpd delivery mail via smtp or lmtp or into a database or whatever you want. Reorganize most of Qpsmtpd.pm into Qpsmtpd/SMTP.pm. Add spool_dir option (thanks to Ross Mueller ) Add plugin name to the "hooks" data structure, so we can log plugin module had an error when we run a hook. Make klez filter run for mails bigger than 220KB; they are sometimes bigger than that. Avoid "use of uninitialized variable" warning when the "MAIL" or the "RCPT" command is executed without a parameter. Compatibility with perl 5.5.3. Fix "Could not print" error message in the TcpServer object. (Thanks to Ross Mueller ) dnsbl plugin queues lookups in the background upon connect but doesn't block for the results until they are needed, greatly speeding up connection times. Also fix a typo in the dnsbl plugin so it'll actually work(!). check_badmailfrom and check_badrcptto plugins (Jim Winstead ) Better RFC conformance. (Reset transactions after the DATA command and when the MAIL command is being done) 0.10 - 2002/09/08 New object oriented internals Very flexible plugin All functionality not core to SMTP moved to plugins Can accept mails as large as your file system will allow (instead of up to as much memory you would allow qpsmtpd to eat). 2002/09/08 Add klez_filter plugin Support more return codes for data_post Document data_post Add plugin name to the log entries when plugins use log() Add plugin_name method to the default plugin object. Improve error handling in the spamassassin plugin 2002/08/06 Spool message bodies to a tmp file so we can support HUGE messages API to read the message body (undocumented, subject to change) data_post hook (undocumented) SpamAssassin plugin (connects to spamd on localhost), see plugins/spamassassin 2002/07/15 DNS RBL and RHSBL support via plugins. More hooks. 2002/07/03 First (non functional) version of the new object oriented mail engine (0.10). Changes on the old v0.0x branch: 2002/05/09 Klez filter (thanks to Robert Spier) 2002/04/20 Bumped version number to 0.07 Support comments in configuration files (prefix the line with #) Support RELAYCLIENT like qmail-smtpd (thanks to Marius Kjeldahl and Zukka Zitting ) If the connection fails while in DATA we would just accept the message. Ouch! Thanks to Devin Carraway for the patch. 2002/01/26 Allow [1.2.3.4] for the hostname when checking if the dns resolves 2002/01/21 assorted fixes; getting dnsbl's to actually work fixing the maximum message size (databytes) stuff (thanks for the spot to Andrew Pam ) support and enable taint checking (thanks to Devin Carraway ) Make the MAIL FROM host dns check configurable. (thanks to Devin Carraway). Add more documentation to the README file. qpsmtpd-0.94/LICENSE000066400000000000000000000020721240247602400141450ustar00rootroot00000000000000Copyright (C) 2001-2010 Ask Bjoern Hansen, Develooper LLC Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions: The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. qpsmtpd-0.94/MANIFEST000066400000000000000000000112431240247602400142710ustar00rootroot00000000000000.gitignore .travis.yml bin/install_deps.pl Changes config.sample/badhelo config.sample/badmailfrom config.sample/badrcptto config.sample/dkim/dkim_key_gen.sh config.sample/dnsbl_allow config.sample/dnsbl_zones config.sample/flat_auth_pw config.sample/invalid_resolvable_fromhost config.sample/IP config.sample/log2sql config.sample/logging config.sample/loglevel config.sample/norelayclients config.sample/plugins config.sample/public_suffix_list config.sample/rcpthosts config.sample/relayclients config.sample/rhsbl_zones config.sample/size_threshold config.sample/smtpauth-checkpassword config.sample/tls_before_auth config.sample/tls_ciphers CREDITS docs/advanced.pod docs/authentication.pod docs/config.pod docs/development.pod docs/hooks.pod docs/logging.pod docs/plugins.pod docs/writing.pod lib/Apache/Qpsmtpd.pm lib/Danga/Client.pm lib/Danga/TimeoutSocket.pm lib/Qpsmtpd.pm lib/Qpsmtpd/Address.pm lib/Qpsmtpd/Auth.pm lib/Qpsmtpd/Command.pm lib/Qpsmtpd/ConfigServer.pm lib/Qpsmtpd/Connection.pm lib/Qpsmtpd/Constants.pm lib/Qpsmtpd/DSN.pm lib/Qpsmtpd/Plugin.pm lib/Qpsmtpd/Plugin/Async/DNSBLBase.pm lib/Qpsmtpd/PollServer.pm lib/Qpsmtpd/Postfix.pm lib/Qpsmtpd/Postfix/Constants.pm lib/Qpsmtpd/Postfix/pf2qp.pl lib/Qpsmtpd/SMTP.pm lib/Qpsmtpd/SMTP/Prefork.pm lib/Qpsmtpd/TcpServer.pm lib/Qpsmtpd/TcpServer/Prefork.pm lib/Qpsmtpd/Transaction.pm lib/Qpsmtpd/Utils.pm LICENSE log/log2sql log/log2sql.sql log/run log/show_message log/summarize log/watch Makefile.PL MANIFEST This list of files MANIFEST.SKIP META.yml Module meta-data (added by MakeMaker) plugins/async/dns_whitelist_soft plugins/async/dnsbl plugins/async/earlytalker plugins/async/queue/smtp-forward plugins/async/resolvable_fromhost plugins/async/rhsbl plugins/async/uribl plugins/auth/auth_checkpassword plugins/auth/auth_cvm_unix_local plugins/auth/auth_flat_file plugins/auth/auth_ldap_bind plugins/auth/auth_vpopmail plugins/auth/auth_vpopmail_sql plugins/auth/auth_vpopmaild plugins/auth/authdeny plugins/badmailfrom plugins/badmailfromto plugins/badrcptto plugins/bogus_bounce plugins/connection_time plugins/content_log plugins/count_unrecognized_commands plugins/dkim plugins/dmarc plugins/dns_whitelist_soft plugins/dnsbl plugins/domainkeys plugins/dont_require_anglebrackets plugins/dspam plugins/earlytalker plugins/fcrdns plugins/greylisting plugins/headers plugins/helo plugins/help plugins/hosts_allow plugins/http_config plugins/ident/geoip plugins/ident/p0f plugins/karma plugins/karma_tool plugins/loadcheck plugins/logging/adaptive plugins/logging/apache plugins/logging/connection_id plugins/logging/devnull plugins/logging/file plugins/logging/syslog plugins/logging/transaction_id plugins/logging/warn plugins/loop plugins/milter plugins/naughty plugins/noop_counter plugins/parse_addr_withhelo plugins/qmail_deliverable plugins/queue/exim-bsmtp plugins/queue/maildir plugins/queue/postfix-queue plugins/queue/qmail-queue plugins/queue/smtp-forward plugins/quit_fortune plugins/random_error plugins/rcpt_map plugins/rcpt_ok plugins/rcpt_regexp plugins/registry.txt plugins/relay plugins/resolvable_fromhost plugins/rhsbl plugins/sender_permitted_from plugins/spamassassin plugins/stunnel plugins/tls plugins/tls_cert plugins/uribl plugins/virus/aveclient plugins/virus/bitdefender plugins/virus/clamav plugins/virus/clamdscan plugins/virus/hbedv plugins/virus/kavscanner plugins/virus/klez_filter plugins/virus/sophie plugins/virus/uvscan plugins/whitelist qpsmtpd qpsmtpd-async qpsmtpd-forkserver qpsmtpd-prefork README README.md README.plugins run.forkserver run.tcpserver STATUS t/addresses.t t/auth.t t/config.t t/config/badhelo t/config/badrcptto t/config/dnsbl_allow t/config/dnsbl_zones t/config/flat_auth_pw t/config/invalid_resolvable_fromhost t/config/norelayclients t/config/plugins t/config/public_suffix_list t/config/rcpthosts t/config/relayclients t/helo.t t/misc.t t/plugin_tests.t t/plugin_tests/auth/auth_checkpassword t/plugin_tests/auth/auth_flat_file t/plugin_tests/auth/auth_vpopmail t/plugin_tests/auth/auth_vpopmail_sql t/plugin_tests/auth/auth_vpopmaild t/plugin_tests/auth/authdeny t/plugin_tests/auth/authnull t/plugin_tests/badmailfrom t/plugin_tests/badmailfromto t/plugin_tests/badrcptto t/plugin_tests/count_unrecognized_commands t/plugin_tests/dmarc t/plugin_tests/dnsbl t/plugin_tests/dspam t/plugin_tests/earlytalker t/plugin_tests/greylisting t/plugin_tests/headers t/plugin_tests/helo t/plugin_tests/ident/geoip t/plugin_tests/ident/p0f t/plugin_tests/rcpt_ok t/plugin_tests/relay t/plugin_tests/resolvable_fromhost t/plugin_tests/sender_permitted_from t/plugin_tests/spamassassin t/plugin_tests/virus/clamdscan t/qpsmtpd-address.t t/rset.t t/tempstuff.t t/Test/Qpsmtpd.pm t/Test/Qpsmtpd/Plugin.pm UPGRADING.pod xt/01-syntax.t xt/02-pod.t qpsmtpd-0.94/MANIFEST.SKIP000066400000000000000000000005621240247602400150400ustar00rootroot00000000000000CVS/.* \.cvsignore$ \.bak$ \.sw[a-z]$ \.tar$ \.tgz$ \.tar\.gz$ \.o$ \.xsi$ \.bs$ output/.* \.# ^mess/ ^sqlite/ ^output/ ^tmp/ ^blib/ ^blibdirs$ ^Makefile$ ^Makefile\.[a-z]+$ ^pm_to_blib$ ~$ ^MANIFEST\.bak ^MYMETA\. ^tv\.log$ ^MakeMaker-\d \#$ \B\.svn\b ^\.perltidyrc$ ^\.git/.* ^cover_db/ \.(orig|rej)$ packaging ^log/main/ ^config/ ^supervise/ ^ssl/ ^t/config/greylist qpsmtpd-0.94/META.yml000066400000000000000000000012611240247602400144100ustar00rootroot00000000000000--- abstract: 'Flexible smtpd daemon written in Perl' author: - 'Ask Bjoern Hansen ' build_requires: ExtUtils::MakeMaker: 0 configure_requires: ExtUtils::MakeMaker: 0 dynamic_config: 0 generated_by: 'ExtUtils::MakeMaker version 6.64, CPAN::Meta::Converter version 2.120921' license: unknown meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: 1.4 name: qpsmtpd no_index: directory: - t - inc requires: Data::Dumper: 0 Date::Parse: 0 File::Tail: 0 File::Temp: 0 IO::Socket::SSL: 0 MIME::Base64: 0 Mail::DKIM: 0 Mail::Header: 0 Net::DNS: 0.39 Net::IP: 0 Time::HiRes: 0 Time::TAI64: 0 version: 0.91 qpsmtpd-0.94/Makefile.PL000066400000000000000000000027311240247602400151140ustar00rootroot00000000000000#!/usr/bin/perl -w use strict; use ExtUtils::MakeMaker; WriteMakefile( NAME => 'qpsmtpd', VERSION_FROM => 'lib/Qpsmtpd.pm', PREREQ_PM => { 'Data::Dumper' => 0, 'Date::Parse' => 0, 'File::Temp' => 0, 'Mail::Header' => 0, 'MIME::Base64' => 0, 'Net::DNS' => 0.39, 'Net::IP' => 0, 'Time::HiRes' => 0, 'IO::Socket::SSL' => 0, # modules for specific features 'Mail::DKIM' => 0, 'File::Tail' => 0, # log/summarize, log/watch 'Time::TAI64' => 0, # log2sql # 'DBI' => 0, # auth_vpopmail_sql and # 'DBD::mysql' => 0, # log2sql # 'DBIx::Simple' => 0, # log2sql # modules that cause Travis build tests to fail # 'Mail::SpamAssassin' => 0, # 'Geo::IP' => 0, # 'Math::Complex' => 0, # geodesic distance in Geo::IP # 'Mail::SPF' => 0, }, ABSTRACT => 'Flexible smtpd daemon written in Perl', AUTHOR => 'Ask Bjoern Hansen ', EXE_FILES => [qw(qpsmtpd qpsmtpd-forkserver qpsmtpd-prefork qpsmtpd-async)], clean => { FILES => [ '*.bak' ], }, ); sub MY::libscan { my $path = $_[1]; return '' if $path =~ /\B\.svn\b/; return $path; } sub MY::postamble { qq[ testcover : \t cover -delete && \\ HARNESS_PERL_SWITCHES=-MDevel::Cover \$(MAKE) test && \\ cover ] } qpsmtpd-0.94/README000066400000000000000000000133741240247602400140270ustar00rootroot00000000000000# # this file is best read with `perldoc README` # =head1 NAME Qpsmtpd - qmail perl simple mail transfer protocol daemon web: http://smtpd.github.io/qpsmtpd/ mailinglist: qpsmtpd-subscribe@perl.org FAQ: https://github.com/smtpd/qpsmtpd/wiki/faq =head1 DESCRIPTION What is Qpsmtpd? Qpsmtpd is an extensible SMTP engine written in Perl. No, make that easily extensible! See plugins/quit_fortune for a very useful, er, cute example. =head2 License Qpsmtpd is licensed under the MIT License; see the LICENSE file for more information. =head2 What's new in this release? See the Changes file! :-) =head1 Installation =head2 Required Perl Modules The following Perl modules are required: Net::DNS MIME::Base64 Mail::Header (part of the MailTools distribution) If you use a version of Perl older than 5.8.0 you will also need Data::Dumper File::Temp Time::HiRes The easiest way to install modules from CPAN is with the CPAN shell. Run it with perl -MCPAN -e shell =head2 qpsmtpd installation Make a new user and a directory where you'll install qpsmtpd. I usually use "smtpd" for the user and /home/smtpd/qpsmtpd/ for the directory. Put the files there. If you install from git you can just do run the following command in the /home/smtpd/ directory. git clone git://github.com/smtpd/qpsmtpd.git Beware that the master branch might be unstable and unsuitable for anything but development, so you might want to get a specific release, for example (after running git clone): git checkout -b local_branch v0.93 chmod o+t ~smtpd/qpsmtpd/ (or whatever directory you installed qpsmtpd in) to make supervise start the log process. Edit the file config/IP and put the ip address you want to use for qpsmtpd on the first line (or use 0 to bind to all interfaces). If you use the supervise tools, then you are practically done! Just symlink /home/smtpd/qpsmtpd into your /services (or /var/services or /var/svscan or whatever) directory. Remember to shutdown qmail-smtpd if you are replacing it with qpsmtpd. If you don't use supervise, then you need to run the ./run script in some other way. The smtpd user needs write access to ~smtpd/qpsmtpd/tmp/ but should not need to write anywhere else. This directory can be configured with the "spool_dir" configuration and permissions can be set with "spool_perms". As per version 0.25 the distributed ./run script runs tcpserver with the -R flag to disable identd lookups. Remove the -R flag if that's not what you want. =head2 Configuration Configuration files can go into either /var/qmail/control or into the config subdirectory of the qpsmtpd installation. Configuration should be compatible with qmail-smtpd making qpsmtpd a drop-in replacement. If qmail is installed in a nonstandard location you should set the $QMAIL environment variable to that location in your "./run" file. If there is anything missing, then please send a patch (or just information about what's missing) to the mailinglist or a PR to github. =head1 Better Performance For better performance we recommend using "qpsmtpd-forkserver" or running qpsmtpd under Apache 2.x. If you need extremely high concurrency and all your plugins are compatible, you might want to try the "qpsmtpd-async" model. =head1 Plugins The qpsmtpd core only implements the SMTP protocol. No useful function can be done by qpsmtpd without loading plugins. Plugins are loaded on startup where each of them register their interest in various "hooks" provided by the qpsmtpd core engine. At least one plugin MUST allow or deny the RCPT command to enable receiving mail. The "rcpt_ok" is one basic plugin that does this. Other plugins provide extra functionality related to this; for example the resolvable_fromhost plugin described above. =head1 Configuration files All the files used by qmail-smtpd should be supported; so see the man page for qmail-smtpd. Extra files used by qpsmtpd include: =over 4 =item plugins List of plugins, one per line, to be loaded in the order they appear in the file. Plugins are in the plugins directory (or in a subdirectory of there). =item rhsbl_zones Right hand side blocking lists, one per line. For example: dsn.rfc-ignorant.org does not accept bounces - http://www.rfc-ignorant.org/ See http://www.rfc-ignorant.org/ for more examples. =item dnsbl_zones Normal ip based DNS blocking lists ("RBLs"). For example: relays.ordb.org spamsources.fabel.dk =item spool_dir If this file contains a directory, it will be the spool directory smtpd uses during the data transactions. If this file doesn't exist, it will default to use $ENV{HOME}/tmp/. This directory should be set with a mode of 700 and owned by the smtpd user. =item spool_perms The default spool permissions are 0700. If you need some other value, chmod the directory and set it's octal value in config/spool_perms. =item tls_before_auth If this file contains anything except a 0 on the first noncomment line, then AUTH will not be offered unless TLS/SSL are in place, either with STARTTLS, or SMTP-SSL on port 465. =item everything (?) that qmail-smtpd supports. In my test qpsmtpd installation I have a "config/me" file containing the hostname I use for testing qpsmtpd (so it doesn't introduce itself with the normal name of the server). =back =head1 Problems In case of problems, always check the logfile first. By default, qpsmtpd logs to log/main/current. Qpsmtpd can log a lot of debug information. You can get more or less by adjusting the number in config/loglevel. Between 1 and 3 should give you a little. Setting it to 10 or higher will get lots of information in the logs. If the logfile doesn't give away the problem, then post to the mailinglist (subscription instructions above). If possible, put the logfile on a webserver and include a reference to it in the mail. qpsmtpd-0.94/README.md000066400000000000000000000131161240247602400144200ustar00rootroot00000000000000 ![Build Status](https://travis-ci.org/smtpd/qpsmtpd.svg?branch=master "Build Status") # Qpsmtpd - qmail perl simple mail transfer protocol daemon [Web site](http://smtpd.github.io/qpsmtpd/), [FAQ](https://github.com/smtpd/qpsmtpd/wiki/faq), [Email List](mailto:qpsmtpd-subscribe@perl.org) Qpsmtpd is an extensible SMTP engine written in Perl. See `plugins/quit_fortune` for a cute example. # License Qpsmtpd is licensed under the MIT License; see the LICENSE file for more information. # What's new? See the Changes file! :-) # Installation ## Required Perl Modules * Net::DNS * MIME::Base64 * Mail::Header (part of the MailTools distribution) If your Perl is older than 5.8.0, you will also need * Data::Dumper * File::Temp * Time::HiRes The easiest way to install modules from CPAN is with the CPAN shell. Run it with perl -MCPAN -e shell ## qpsmtpd installation Make a new user and a directory where you'll install qpsmtpd. I usually use "smtpd" for the user and /home/smtpd/qpsmtpd/ for the directory. Put the files there. If you install from git you can just do run the following command in the /home/smtpd/ directory. git clone git://github.com/smtpd/qpsmtpd.git Beware that the master branch might be unstable and unsuitable for anything but development, so you might want to get a specific release, for example (after running git clone): git checkout -b local_branch v0.93 chmod o+t ~smtpd/qpsmtpd/ (or whatever directory you installed qpsmtpd in) to make supervise start the log process. Edit the file config/IP and put the ip address you want to use for qpsmtpd on the first line (or use 0 to bind to all interfaces). If you use the supervise tools, then you are practically done! Just symlink /home/smtpd/qpsmtpd into your /services (or /var/services or /var/svscan or whatever) directory. Remember to shutdown qmail-smtpd if you are replacing it with qpsmtpd. If you don't use supervise, then you need to run the ./run script in some other way. The smtpd user needs write access to ~smtpd/qpsmtpd/tmp/ but should not need to write anywhere else. This directory can be configured with the `spool_dir` configuration and permissions can be set with `spool_perms`. As of version 0.25 the distributed ./run script runs tcpserver with the -R flag to disable identd lookups. Remove the -R flag if that's not what you want. # Configuration Configuration files can go into either /var/qmail/control or into the config subdirectory of the qpsmtpd installation. Configuration should be compatible with qmail-smtpd making qpsmtpd a drop-in replacement. If qmail is installed in a nonstandard location you should set the $QMAIL environment variable to that location in your "./run" file. If there is anything missing, then please send a patch (or just information about what's missing) to the mailinglist or a PR to github. # Better Performance For better performance we recommend using "qpsmtpd-forkserver" or running qpsmtpd under Apache 2.x. If you need extremely high concurrency and all your plugins are compatible, you might want to try the "qpsmtpd-async" model. # Plugins The qpsmtpd core only implements the SMTP protocol. No useful function can be done by qpsmtpd without loading plugins. Plugins are loaded on startup where each of them register their interest in various "hooks" provided by the qpsmtpd core engine. At least one plugin MUST allow or deny the RCPT command to enable receiving mail. The `rcpt_ok` is one basic plugin that does this. Other plugins provide extra functionality related to this; for example the `resolvable_fromhost` plugin described above. # Configuration files All the files used by qmail-smtpd should be supported; so see the man page for qmail-smtpd. Extra files used by qpsmtpd include: ## plugins List of plugins, one per line, to be loaded in the order they appear in the file. Plugins are in the plugins directory (or in a subdirectory of there). ## rhsbl_zones Right hand side blocking lists, one per line. For example: dsn.rfc-ignorant.org does not accept bounces - http://www.rfc-ignorant.org/ See http://www.rfc-ignorant.org/ for more examples. ## `dnsbl_zones` Normal ip based DNS blocking lists ("RBLs"). For example: relays.ordb.org spamsources.fabel.dk ## `spool_dir` If this file contains a directory, it will be the spool directory smtpd uses during the data transactions. If this file doesn't exist, it will default to use $ENV{HOME}/tmp/. This directory should be set with a mode of 700 and owned by the smtpd user. ## `spool_perms` The default spool permissions are 0700. If you need some other value, chmod the directory and set it's octal value in `config/spool_perms`. ## `tls_before_auth` If this file contains anything except a 0 on the first noncomment line, then AUTH will not be offered unless TLS/SSL are in place, either with STARTTLS, or SMTP-SSL on port 465. ## everything (?) that qmail-smtpd supports. In my test qpsmtpd installation I have a "config/me" file containing the hostname I use for testing qpsmtpd (so it doesn't introduce itself with the normal name of the server). # Problems In case of problems, always check the logfile first. By default, qpsmtpd logs to log/main/current. Qpsmtpd can log a lot of debug information. You can get more or less by adjusting the number in config/loglevel. Between 1 and 3 should give you a little. Setting it to 10 or higher will get lots of information in the logs. If the logfile doesn't give away the problem, then post to the mailinglist (subscription instructions above). If possible, put the logfile on a webserver and include a reference to it in the mail. qpsmtpd-0.94/README.plugins000066400000000000000000000004531240247602400155010ustar00rootroot00000000000000# # read this with 'perldoc README.plugins' ... # =head1 qpsmtpd plugin system; developer documentation Plugin documentation is now in F. See the examples in plugins/ and ask questions on the qpsmtpd mailinglist; subscribe by sending mail to qpsmtpd-subscribe@perl.org. =cut qpsmtpd-0.94/STATUS000066400000000000000000000014451240247602400141110ustar00rootroot00000000000000 Qpsmtpd - an SMTP daemon for developers and hackers Roadmap ======= - https://github.com/smtpd/qpsmtpd/issues - Add user configuration plugin infrastructure - Add plugin API for checking if a local email address is valid Issues ====== plugin support; allow plugins to return multiple response lines (does it have to join them to one for SMTP?) support plugins for the rest of the commands. specify a priority in register_hook. ("LAST", "FIRST", "MIDDLE", or maybe a number) plugin access to the data line by line during the DATA phase (instead of just after) if qmail-queue can't be loaded we still return 250 ?! localiphost - support foo@[a.b.c.d] addresses Move dispatch() etc from SMTP.pm to Qpsmtpd.pm to allow other similar protocols to use the qpsmtpd framework. qpsmtpd-0.94/UPGRADING.pod000066400000000000000000000030671240247602400151710ustar00rootroot00000000000000 =head1 Upgrade notes When upgrading please review these notes for the versions you are upgrading I. =head2 v0.84 or below =head3 CHECK_RELAY, CHECK_NORELAY, RELAY_ONLY All 3 plugins are deprecated and replaced with a new 'relay' plugin. The new plugin reads the same config files (see 'perldoc plugins/relay') as the previous plugins. To get the equivalent functionality of enabling 'relay_only', use the 'only' argument to the relay plugin as documented in the RELAY ONLY section of plugins/relay. =head3 GREYLISTING plugin 'mode' config argument is deprecated. Use reject and reject_type instead. The greylisting DB format has changed to accommodate IPv6 addresses. (The DB key has colon ':' seperated fields, and IPv6 addresses are colon delimited). The new format converts the IPs into integers. There is a new config option named 'upgrade' that when enabled, updates all the records in your DB to the new format. Simply add 'upgrade 1' to the plugin entry in config/plugins, start up qpsmtpd once, make one connection. A log entry will be made, telling how many records were upgraded. Remove the upgrade option from your config. =head3 SPF plugin spf_deny setting deprecated. Use reject N setting instead, which provides administrators with more granular control over SPF. For backward compatibility, a spf_deny setting of 1 is mapped to 'reject 3' and a 'spf_deny 2' is mapped to 'reject 4'. =head3 P0F plugin defaults to p0f v3 (was v2). Upgrade p0f to version 3 or add 'version 2' to your p0f line in config/plugins. perldoc plugins/ident/p0f for more details. qpsmtpd-0.94/bin/000077500000000000000000000000001240247602400137075ustar00rootroot00000000000000qpsmtpd-0.94/bin/install_deps.pl000077500000000000000000000252151240247602400167350ustar00rootroot00000000000000#!/usr/bin/perl # v1.7 - 2013-04-20 - Matt # - get list of modules from Makefile.PL or dist.ini # - abstracted yum and apt into subs # # v1.6 - 2013-04-01 - Matt # - improved error reporting for FreeBSD port installs # # v1.5 - 2013-03-27 - Matt # - added option to specify port category # # v1.4 - 2012-10-23 - Matt # - improved yum & apt-get module installer # # v1.3 - 2012-10-23 - Matt # - added apt-get support # - added app install support # # circa 2008, by Matt Simerson & Phil Nadeau # - based on installer in Mail::Toaster dating back to the 20th century use strict; use warnings; use CPAN; use English qw( -no_match_vars ); my $apps = [ { app => 'daemontools', info => { } }, { app => 'ucspi-tcp', info => { } }, # { app => 'dspam', info => { } }, # { app => 'mysql-server-55', info => { port => 'mysql55-server', dport=>'mysql5', yum =>'mysql-server'} }, # { app => 'apache22' , info => { port => 'apache22', dport=>'', yum => 'httpd' } }, ]; $EUID == 0 or die "You will have better luck if you run me as root.\n"; my @failed; foreach ( @$apps ) { my $name = $_->{app} or die 'missing app name'; install_app( $name, $_->{info} ); }; foreach ( get_perl_modules() ) { #print Dumper($_); my $module = $_->{module} or die 'missing module name'; my $info = $_->{info}; my $version = $info->{version} || ''; print "checking for $module $version\n"; ## no critic eval "use $module $version"; next if ! $EVAL_ERROR; next if $info->{ships_with} && $info->{ships_with} eq 'perl'; install_module( $module, $info, $version ); eval "use $module $version"; ## use critic if ($EVAL_ERROR) { push @failed, $module; } } if ( scalar @failed > 0 ) { print "The following modules failed installation:\n"; print join( "\n", @failed ); print "\n"; } exit; sub get_perl_modules { if ( -f 'dist.ini' ) { return get_perl_modules_from_ini(); }; if ( -f 'Makefile.PL' ) { return get_perl_modules_from_Makefile_PL(); }; die "unable to find module list. Run this script in the dist dir\n"; }; sub get_perl_modules_from_Makefile_PL { my $fh = new IO::File 'Makefile.PL', 'r' or die "unable to read Makefile.PL\n"; my $in = 0; my @modules; foreach my $line ( <$fh> ) { if ( $line =~ /PREREQ_PM/ ) { $in++; next; }; next if ! $in; last if $line =~ /}/; next if $line !~ /=/; # no = char means not a module my ($mod,$ver) = split /\s*=\s*/, $line; $mod =~ s/[\s'"\#]*//g; # remove whitespace and quotes next if ! $mod; push @modules, name_overrides($mod); #print "module: .$mod.\n"; } $fh->close; return @modules; }; sub get_perl_modules_from_ini { my $fh = new IO::File 'dist.ini', 'r' or die "unable to read dist.ini\n"; my $in = 0; my @modules; foreach my $line ( <$fh> ) { if ( '[Prereqs]' eq substr($line,0,9) ) { $in++; next; }; next if ! $in; print "line: $line\n"; last if '[' eq substr($line,0,1); # [...] starts a new section my ($mod,$ver) = split /\s*=\s*/, $line; $mod =~ s/\s*//g; # remove whitespace next if ! $mod; push @modules, name_overrides($mod); print "module: $mod\n"; } $fh->close; #print Dumper(\@modules); return @modules; }; sub install_app { my ( $app, $info) = @_; if ( lc($OSNAME) eq 'darwin' ) { install_app_darwin($app, $info ); } elsif ( lc($OSNAME) eq 'freebsd' ) { install_app_freebsd($app, $info ); } elsif ( lc($OSNAME) eq 'linux' ) { install_app_linux( $app, $info ); }; }; sub install_app_darwin { my ($app, $info ) = @_; my $port = $info->{dport} || $info->{port} || $app; if ( ! -x '/opt/local/bin/port' ) { print "MacPorts is not installed! Consider installing it.\n"; return; } system "/opt/local/bin/port install $port" and warn "install failed for Darwin port $port"; } sub install_app_freebsd { my ($app, $info ) = @_; print " from ports..."; my $name = $info->{port} || $app; if ( `/usr/sbin/pkg_info | /usr/bin/grep $name` ) { return print "$app is installed.\n"; } elsif( `/usr/sbin/pkg info | /usr/bin/grep $name` ) { return print "$app is installed.\n"; } print "installing $app"; my $category = $info->{category} || '*'; my ($portdir) = glob "/usr/ports/$category/$name"; if ( $portdir && -d $portdir && chdir $portdir ) { print " from ports ($portdir)\n"; system "make install clean" and warn "'make install clean' failed for port $app\n"; }; }; sub install_app_linux { my ($app, $info ) = @_; if ( -x '/usr/bin/yum' ) { my $rpm = $info->{yum} || $app; system "/usr/bin/yum -y install $rpm"; } elsif ( -x '/usr/bin/apt-get' ) { my $package = $info->{apt} || $app; system "/usr/bin/apt-get -y install $package"; } else { warn "no Linux package manager detected\n"; }; }; sub install_module { my ($module, $info, $version) = @_; if ( lc($OSNAME) eq 'darwin' ) { install_module_darwin($module, $info, $version); } elsif ( lc($OSNAME) eq 'freebsd' ) { install_module_freebsd($module, $info, $version); } elsif ( lc($OSNAME) eq 'linux' ) { install_module_linux( $module, $info, $version); }; ## no critic eval "require $module"; ## use critic return 1 if ! $EVAL_ERROR; install_module_cpan($module, $version); }; sub install_module_cpan { my ($module, $version) = @_; print " from CPAN..."; sleep 1; # this causes problems when CPAN is not configured. #$ENV{PERL_MM_USE_DEFAULT} = 1; # supress CPAN prompts $ENV{FTP_PASSIVE} = 1; # for FTP behind NAT/firewalls # some Linux distros break CPAN by auto/preconfiguring it with no URL mirrors. # this works around that annoying little habit no warnings; $CPAN::Config = get_cpan_config(); use warnings; # a hack to grab the latest version on CPAN before its hits the mirrors if ( $module eq 'Provision::Unix' && $version ) { $module =~ s/\:\:/\-/g; $module = "M/MS/MSIMERSON/$module-$version.tar.gz"; } CPAN::Shell->install($module); } sub install_module_darwin { my ($module, $info, $version) = @_; my $dport = '/opt/local/bin/port'; if ( ! -x $dport ) { print "MacPorts is not installed! Consider installing it.\n"; return; } my $port = "p5-$module"; $port =~ s/::/-/g; system "$dport install $port" and warn "install failed for Darwin port $module"; } sub install_module_freebsd { my ($module, $info, $version) = @_; my $name = $info->{port} || $module; my $portname = "p5-$name"; $portname =~ s/::/-/g; print " from ports...$portname..."; if ( `/usr/sbin/pkg_info | /usr/bin/grep $portname` ) { return print "$module is installed.\n"; } elsif( `/usr/sbin/pkg info | /usr/bin/grep $portname` ) { return print "$module is installed.\n"; } print "installing $module ..."; my $category = $info->{category} || '*'; my ($portdir) = glob "/usr/ports/$category/$portname"; if ( ! $portdir || ! -d $portdir ) { print "oops, no match at /usr/ports/$category/$portname\n"; return; }; if ( ! chdir $portdir ) { print "unable to cd to /usr/ports/$category/$portname\n"; }; print " from ports ($portdir)\n"; system "make install clean" and warn "'make install clean' failed for port $module\n"; } sub install_module_linux { my ($module, $info, $version) = @_; my $package; if ( -x '/usr/bin/yum' ) { return install_module_linux_yum($module, $info); } elsif ( -x '/usr/bin/apt-get' ) { return install_module_linux_apt($module, $info); } warn "no Linux package manager detected\n"; }; sub install_module_linux_yum { my ($module, $info) = @_; my $package; if ( $info->{yum} ) { $package = $info->{yum}; } else { $package = "perl-$module"; $package =~ s/::/-/g; }; system "/usr/bin/yum -y install $package"; }; sub install_module_linux_apt { my ($module, $info) = @_; my $package; if ( $info->{apt} ) { $package = $info->{apt}; } else { $package = 'lib' . $module . '-perl'; $package =~ s/::/-/g; }; system "/usr/bin/apt-get -y install $package"; }; sub get_cpan_config { my $ftp = `which ftp`; chomp $ftp; my $gzip = `which gzip`; chomp $gzip; my $unzip = `which unzip`; chomp $unzip; my $tar = `which tar`; chomp $tar; my $make = `which make`; chomp $make; my $wget = `which wget`; chomp $wget; return { 'build_cache' => q[10], 'build_dir' => qq[$ENV{HOME}/.cpan/build], 'cache_metadata' => q[1], 'cpan_home' => qq[$ENV{HOME}/.cpan], 'ftp' => $ftp, 'ftp_proxy' => q[], 'getcwd' => q[cwd], 'gpg' => q[], 'gzip' => $gzip, 'histfile' => qq[$ENV{HOME}/.cpan/histfile], 'histsize' => q[100], 'http_proxy' => q[], 'inactivity_timeout' => q[5], 'index_expire' => q[1], 'inhibit_startup_message' => q[1], 'keep_source_where' => qq[$ENV{HOME}/.cpan/sources], 'lynx' => q[], 'make' => $make, 'make_arg' => q[], 'make_install_arg' => q[], 'makepl_arg' => q[], 'ncftp' => q[], 'ncftpget' => q[], 'no_proxy' => q[], 'pager' => q[less], 'prerequisites_policy' => q[follow], 'scan_cache' => q[atstart], 'shell' => q[/bin/csh], 'tar' => $tar, 'term_is_latin' => q[1], 'unzip' => $unzip, 'urllist' => [ 'http://www.perl.com/CPAN/', 'http://mirrors.kernel.org/pub/CPAN/', 'ftp://cpan.cs.utah.edu/pub/CPAN/', 'ftp://mirrors.kernel.org/pub/CPAN', 'ftp://osl.uoregon.edu/CPAN/', 'http://cpan.yahoo.com/', 'ftp://ftp.funet.fi/pub/languages/perl/CPAN/' ], 'wget' => $wget, }; } sub name_overrides { my $mod = shift; # Package and port managers have naming conventions for perl modules. The # methods will typically work out the name based on the module name and a # couple rules. When that doesn't work, add entries here for FreeBSD (port), # MacPorts ($dport), yum, and apt. my @modules = ( { module=>'LWP::UserAgent', info => { cat=>'www', port=>'p5-libwww', dport=>'p5-libwww-perl' }, }, { module=>'Mail::Send' , info => { port => 'Mail::Tools', } }, { module=>'Mail::SpamAssassin' , info => { cat => 'mail', } }, ); my ($match) = grep { $_->{module} eq $mod } @modules; return $match if $match; return { module=>$mod, info => { } }; }; qpsmtpd-0.94/config.sample/000077500000000000000000000000001240247602400156645ustar00rootroot00000000000000qpsmtpd-0.94/config.sample/IP000066400000000000000000000001771240247602400161240ustar00rootroot000000000000000 # the first line of this file is being used as the IP # address tcpserver will bind to. Use 0 to bind to all # interfaces. qpsmtpd-0.94/config.sample/badhelo000066400000000000000000000001441240247602400172040ustar00rootroot00000000000000# these domains never uses their domain when greeting us, so reject transactions aol.com yahoo.com qpsmtpd-0.94/config.sample/badmailfrom000066400000000000000000000003061240247602400200630ustar00rootroot00000000000000# This is a sample config file for badmailfrom # - single email address badmailexample@microsoft.com # - block and entire host, and provide a custom reason @www.yahoo.com yahoo never sends from wwwqpsmtpd-0.94/config.sample/badrcptto000066400000000000000000000005141240247602400175710ustar00rootroot00000000000000######## entries used for testing ### bad@example.com @bad.example.com ######## Example patterns ####### # Format is pattern\s+Response # Don't forget to anchor the pattern if required ! Sorry, bang paths not accepted here @.*@ Sorry, multiple at signs not accepted here % Sorry, percent hack not accepted here qpsmtpd-0.94/config.sample/dkim/000077500000000000000000000000001240247602400166105ustar00rootroot00000000000000qpsmtpd-0.94/config.sample/dkim/dkim_key_gen.sh000077500000000000000000000025521240247602400216000ustar00rootroot00000000000000#!/bin/sh usage() { echo " usage: $0 [qpsmtpd username]" echo " " exit } if [ -z $1 ]; then usage fi DOMAIN=$1 SMTPD=$2 if [ -z $SMTPD ]; then SMTPD="smtpd" fi # create a directory for each DKIM signing domain mkdir -p $DOMAIN cd $DOMAIN # create a selector in the format mmmYYYY (apr2013) date '+%h%Y' | tr "[:upper:]" "[:lower:]" > selector # generate a private and public keys openssl genrsa -out private 2048 chmod 400 private openssl rsa -in private -out public -pubout # make it really easy to publish the public key in DNS cat > dns < dont_require_anglebrackets # MAIL FROM plugins badmailfrom reject naughty #badmailfromto resolvable_fromhost reject 0 sender_permitted_from reject 1 # RCPT TO plugins badrcptto #qmail_deliverable # this plugin needs to run after all other "rcpt" plugins rcpt_ok # DATA plugins #uribl headers reject 0 reject_type temp require From,Date future 2 past 15 bogus_bounce log #loop dkim reject 0 # dmarc requires dkim and SPF to run before it dmarc # content filters virus/klez_filter # You can run the spamassassin plugin with options. See perldoc # plugins/spamassassin for details. # spamassassin reject 12 # rejects mails with a SA score higher than 20 and munges the subject # of the score is higher than 10. # # spamassassin reject 20 munge_subject_threshold 10 # dspam must run after spamassassin for the learn_from_sa feature to work dspam autolearn spamassassin reject 0.95 # run the clamav virus checking plugin (max size in Kb) # virus/clamav # virus/clamdscan deny_viruses yes max_size 1024 naughty reject data # You must enable a queue plugin - see the options in plugins/queue/ - for example: # queue to a maildir # queue/maildir /home/spamtrap/mail # queue the mail with qmail-queue # queue/qmail-queue # forward to another mail server # queue/smtp-forward 10.2.2.2 9025 # If you need to run the same plugin multiple times, you can do # something like the following # relay # relay:0 somearg # relay:1 someotherarg qpsmtpd-0.94/config.sample/public_suffix_list000066400000000000000000003064641240247602400215210ustar00rootroot00000000000000// This Source Code Form is subject to the terms of the Mozilla Public // License, v. 2.0. If a copy of the MPL was not distributed with this // file, You can obtain one at http://mozilla.org/MPL/2.0/. // ===BEGIN ICANN DOMAINS=== // ac : http://en.wikipedia.org/wiki/.ac ac com.ac edu.ac gov.ac net.ac mil.ac org.ac // ad : http://en.wikipedia.org/wiki/.ad ad nom.ad // ae : http://en.wikipedia.org/wiki/.ae // see also: "Domain Name Eligibility Policy" at http://www.aeda.ae/eng/aepolicy.php ae co.ae net.ae org.ae sch.ae ac.ae gov.ae mil.ae // aero : see http://www.information.aero/index.php?id=66 aero accident-investigation.aero accident-prevention.aero aerobatic.aero aeroclub.aero aerodrome.aero agents.aero aircraft.aero airline.aero airport.aero air-surveillance.aero airtraffic.aero air-traffic-control.aero ambulance.aero amusement.aero association.aero author.aero ballooning.aero broker.aero caa.aero cargo.aero catering.aero certification.aero championship.aero charter.aero civilaviation.aero club.aero conference.aero consultant.aero consulting.aero control.aero council.aero crew.aero design.aero dgca.aero educator.aero emergency.aero engine.aero engineer.aero entertainment.aero equipment.aero exchange.aero express.aero federation.aero flight.aero freight.aero fuel.aero gliding.aero government.aero groundhandling.aero group.aero hanggliding.aero homebuilt.aero insurance.aero journal.aero journalist.aero leasing.aero logistics.aero magazine.aero maintenance.aero marketplace.aero media.aero microlight.aero modelling.aero navigation.aero parachuting.aero paragliding.aero passenger-association.aero pilot.aero press.aero production.aero recreation.aero repbody.aero res.aero research.aero rotorcraft.aero safety.aero scientist.aero services.aero show.aero skydiving.aero software.aero student.aero taxi.aero trader.aero trading.aero trainer.aero union.aero workinggroup.aero works.aero // af : http://www.nic.af/help.jsp af gov.af com.af org.af net.af edu.af // ag : http://www.nic.ag/prices.htm ag com.ag org.ag net.ag co.ag nom.ag // ai : http://nic.com.ai/ ai off.ai com.ai net.ai org.ai // al : http://www.ert.gov.al/ert_alb/faq_det.html?Id=31 al com.al edu.al gov.al mil.al net.al org.al // am : http://en.wikipedia.org/wiki/.am am // an : http://www.una.an/an_domreg/default.asp an com.an net.an org.an edu.an // ao : http://en.wikipedia.org/wiki/.ao // http://www.dns.ao/REGISTR.DOC ao ed.ao gv.ao og.ao co.ao pb.ao it.ao // aq : http://en.wikipedia.org/wiki/.aq aq // ar : http://en.wikipedia.org/wiki/.ar *.ar !congresodelalengua3.ar !educ.ar !gobiernoelectronico.ar !mecon.ar !nacion.ar !nic.ar !promocion.ar !retina.ar !uba.ar // arpa : http://en.wikipedia.org/wiki/.arpa // Confirmed by registry 2008-06-18 e164.arpa in-addr.arpa ip6.arpa iris.arpa uri.arpa urn.arpa // as : http://en.wikipedia.org/wiki/.as as gov.as // asia : http://en.wikipedia.org/wiki/.asia asia // at : http://en.wikipedia.org/wiki/.at // Confirmed by registry 2008-06-17 at ac.at co.at gv.at or.at // au : http://en.wikipedia.org/wiki/.au // http://www.auda.org.au/ // 2LDs com.au net.au org.au edu.au gov.au asn.au id.au // Historic 2LDs (closed to new registration, but sites still exist) info.au conf.au oz.au // CGDNs - http://www.cgdn.org.au/ act.au nsw.au nt.au qld.au sa.au tas.au vic.au wa.au // 3LDs act.edu.au nsw.edu.au nt.edu.au qld.edu.au sa.edu.au tas.edu.au vic.edu.au wa.edu.au act.gov.au // Removed at request of Shae.Donelan@services.nsw.gov.au, 2010-03-04 // nsw.gov.au nt.gov.au qld.gov.au sa.gov.au tas.gov.au vic.gov.au wa.gov.au // aw : http://en.wikipedia.org/wiki/.aw aw com.aw // ax : http://en.wikipedia.org/wiki/.ax ax // az : http://en.wikipedia.org/wiki/.az az com.az net.az int.az gov.az org.az edu.az info.az pp.az mil.az name.az pro.az biz.az // ba : http://en.wikipedia.org/wiki/.ba ba org.ba net.ba edu.ba gov.ba mil.ba unsa.ba unbi.ba co.ba com.ba rs.ba // bb : http://en.wikipedia.org/wiki/.bb bb biz.bb com.bb edu.bb gov.bb info.bb net.bb org.bb store.bb // bd : http://en.wikipedia.org/wiki/.bd *.bd // be : http://en.wikipedia.org/wiki/.be // Confirmed by registry 2008-06-08 be ac.be // bf : http://en.wikipedia.org/wiki/.bf bf gov.bf // bg : http://en.wikipedia.org/wiki/.bg // https://www.register.bg/user/static/rules/en/index.html bg a.bg b.bg c.bg d.bg e.bg f.bg g.bg h.bg i.bg j.bg k.bg l.bg m.bg n.bg o.bg p.bg q.bg r.bg s.bg t.bg u.bg v.bg w.bg x.bg y.bg z.bg 0.bg 1.bg 2.bg 3.bg 4.bg 5.bg 6.bg 7.bg 8.bg 9.bg // bh : http://en.wikipedia.org/wiki/.bh bh com.bh edu.bh net.bh org.bh gov.bh // bi : http://en.wikipedia.org/wiki/.bi // http://whois.nic.bi/ bi co.bi com.bi edu.bi or.bi org.bi // biz : http://en.wikipedia.org/wiki/.biz biz // bj : http://en.wikipedia.org/wiki/.bj bj asso.bj barreau.bj gouv.bj // bm : http://www.bermudanic.bm/dnr-text.txt bm com.bm edu.bm gov.bm net.bm org.bm // bn : http://en.wikipedia.org/wiki/.bn *.bn // bo : http://www.nic.bo/ bo com.bo edu.bo gov.bo gob.bo int.bo org.bo net.bo mil.bo tv.bo // br : http://registro.br/dominio/dpn.html // Updated by registry 2011-03-01 br adm.br adv.br agr.br am.br arq.br art.br ato.br b.br bio.br blog.br bmd.br cim.br cng.br cnt.br com.br coop.br ecn.br eco.br edu.br emp.br eng.br esp.br etc.br eti.br far.br flog.br fm.br fnd.br fot.br fst.br g12.br ggf.br gov.br imb.br ind.br inf.br jor.br jus.br leg.br lel.br mat.br med.br mil.br mus.br net.br nom.br not.br ntr.br odo.br org.br ppg.br pro.br psc.br psi.br qsl.br radio.br rec.br slg.br srv.br taxi.br teo.br tmp.br trd.br tur.br tv.br vet.br vlog.br wiki.br zlg.br // bs : http://www.nic.bs/rules.html bs com.bs net.bs org.bs edu.bs gov.bs // bt : http://en.wikipedia.org/wiki/.bt bt com.bt edu.bt gov.bt net.bt org.bt // bv : No registrations at this time. // Submitted by registry 2006-06-16 // bw : http://en.wikipedia.org/wiki/.bw // http://www.gobin.info/domainname/bw.doc // list of other 2nd level tlds ? bw co.bw org.bw // by : http://en.wikipedia.org/wiki/.by // http://tld.by/rules_2006_en.html // list of other 2nd level tlds ? by gov.by mil.by // Official information does not indicate that com.by is a reserved // second-level domain, but it's being used as one (see www.google.com.by and // www.yahoo.com.by, for example), so we list it here for safety's sake. com.by // http://hoster.by/ of.by // bz : http://en.wikipedia.org/wiki/.bz // http://www.belizenic.bz/ bz com.bz net.bz org.bz edu.bz gov.bz // ca : http://en.wikipedia.org/wiki/.ca ca // ca geographical names ab.ca bc.ca mb.ca nb.ca nf.ca nl.ca ns.ca nt.ca nu.ca on.ca pe.ca qc.ca sk.ca yk.ca // gc.ca: http://en.wikipedia.org/wiki/.gc.ca // see also: http://registry.gc.ca/en/SubdomainFAQ gc.ca // cat : http://en.wikipedia.org/wiki/.cat cat // cc : http://en.wikipedia.org/wiki/.cc cc // cd : http://en.wikipedia.org/wiki/.cd // see also: https://www.nic.cd/domain/insertDomain_2.jsp?act=1 cd gov.cd // cf : http://en.wikipedia.org/wiki/.cf cf // cg : http://en.wikipedia.org/wiki/.cg cg // ch : http://en.wikipedia.org/wiki/.ch ch // ci : http://en.wikipedia.org/wiki/.ci // http://www.nic.ci/index.php?page=charte ci org.ci or.ci com.ci co.ci edu.ci ed.ci ac.ci net.ci go.ci asso.ci aéroport.ci int.ci presse.ci md.ci gouv.ci // ck : http://en.wikipedia.org/wiki/.ck *.ck !www.ck // cl : http://en.wikipedia.org/wiki/.cl cl gov.cl gob.cl co.cl mil.cl // cm : http://en.wikipedia.org/wiki/.cm cm gov.cm // cn : http://en.wikipedia.org/wiki/.cn // Submitted by registry 2008-06-11 cn ac.cn com.cn edu.cn gov.cn net.cn org.cn mil.cn 公司.cn 网络.cn 網絡.cn // cn geographic names ah.cn bj.cn cq.cn fj.cn gd.cn gs.cn gz.cn gx.cn ha.cn hb.cn he.cn hi.cn hl.cn hn.cn jl.cn js.cn jx.cn ln.cn nm.cn nx.cn qh.cn sc.cn sd.cn sh.cn sn.cn sx.cn tj.cn xj.cn xz.cn yn.cn zj.cn hk.cn mo.cn tw.cn // co : http://en.wikipedia.org/wiki/.co // Submitted by registry 2008-06-11 co arts.co com.co edu.co firm.co gov.co info.co int.co mil.co net.co nom.co org.co rec.co web.co // com : http://en.wikipedia.org/wiki/.com com // coop : http://en.wikipedia.org/wiki/.coop coop // cr : http://www.nic.cr/niccr_publico/showRegistroDominiosScreen.do cr ac.cr co.cr ed.cr fi.cr go.cr or.cr sa.cr // cu : http://en.wikipedia.org/wiki/.cu cu com.cu edu.cu org.cu net.cu gov.cu inf.cu // cv : http://en.wikipedia.org/wiki/.cv cv // cw : http://www.una.cw/cw_registry/ // Confirmed by registry 2013-03-26 cw com.cw edu.cw net.cw org.cw // cx : http://en.wikipedia.org/wiki/.cx // list of other 2nd level tlds ? cx gov.cx // cy : http://en.wikipedia.org/wiki/.cy *.cy // cz : http://en.wikipedia.org/wiki/.cz cz // de : http://en.wikipedia.org/wiki/.de // Confirmed by registry (with technical // reservations) 2008-07-01 de // dj : http://en.wikipedia.org/wiki/.dj dj // dk : http://en.wikipedia.org/wiki/.dk // Confirmed by registry 2008-06-17 dk // dm : http://en.wikipedia.org/wiki/.dm dm com.dm net.dm org.dm edu.dm gov.dm // do : http://en.wikipedia.org/wiki/.do do art.do com.do edu.do gob.do gov.do mil.do net.do org.do sld.do web.do // dz : http://en.wikipedia.org/wiki/.dz dz com.dz org.dz net.dz gov.dz edu.dz asso.dz pol.dz art.dz // ec : http://www.nic.ec/reg/paso1.asp // Submitted by registry 2008-07-04 ec com.ec info.ec net.ec fin.ec k12.ec med.ec pro.ec org.ec edu.ec gov.ec gob.ec mil.ec // edu : http://en.wikipedia.org/wiki/.edu edu // ee : http://www.eenet.ee/EENet/dom_reeglid.html#lisa_B ee edu.ee gov.ee riik.ee lib.ee med.ee com.ee pri.ee aip.ee org.ee fie.ee // eg : http://en.wikipedia.org/wiki/.eg eg com.eg edu.eg eun.eg gov.eg mil.eg name.eg net.eg org.eg sci.eg // er : http://en.wikipedia.org/wiki/.er *.er // es : https://www.nic.es/site_ingles/ingles/dominios/index.html es com.es nom.es org.es gob.es edu.es // et : http://en.wikipedia.org/wiki/.et *.et // eu : http://en.wikipedia.org/wiki/.eu eu // fi : http://en.wikipedia.org/wiki/.fi fi // aland.fi : http://en.wikipedia.org/wiki/.ax // This domain is being phased out in favor of .ax. As there are still many // domains under aland.fi, we still keep it on the list until aland.fi is // completely removed. // TODO: Check for updates (expected to be phased out around Q1/2009) aland.fi // fj : http://en.wikipedia.org/wiki/.fj *.fj // fk : http://en.wikipedia.org/wiki/.fk *.fk // fm : http://en.wikipedia.org/wiki/.fm fm // fo : http://en.wikipedia.org/wiki/.fo fo // fr : http://www.afnic.fr/ // domaines descriptifs : http://www.afnic.fr/obtenir/chartes/nommage-fr/annexe-descriptifs fr com.fr asso.fr nom.fr prd.fr presse.fr tm.fr // domaines sectoriels : http://www.afnic.fr/obtenir/chartes/nommage-fr/annexe-sectoriels aeroport.fr assedic.fr avocat.fr avoues.fr cci.fr chambagri.fr chirurgiens-dentistes.fr experts-comptables.fr geometre-expert.fr gouv.fr greta.fr huissier-justice.fr medecin.fr notaires.fr pharmacien.fr port.fr veterinaire.fr // ga : http://en.wikipedia.org/wiki/.ga ga // gb : This registry is effectively dormant // Submitted by registry 2008-06-12 // gd : http://en.wikipedia.org/wiki/.gd gd // ge : http://www.nic.net.ge/policy_en.pdf ge com.ge edu.ge gov.ge org.ge mil.ge net.ge pvt.ge // gf : http://en.wikipedia.org/wiki/.gf gf // gg : http://www.channelisles.net/applic/avextn.shtml gg co.gg org.gg net.gg sch.gg gov.gg // gh : http://en.wikipedia.org/wiki/.gh // see also: http://www.nic.gh/reg_now.php // Although domains directly at second level are not possible at the moment, // they have been possible for some time and may come back. gh com.gh edu.gh gov.gh org.gh mil.gh // gi : http://www.nic.gi/rules.html gi com.gi ltd.gi gov.gi mod.gi edu.gi org.gi // gl : http://en.wikipedia.org/wiki/.gl // http://nic.gl gl // gm : http://www.nic.gm/htmlpages%5Cgm-policy.htm gm // gn : http://psg.com/dns/gn/gn.txt // Submitted by registry 2008-06-17 ac.gn com.gn edu.gn gov.gn org.gn net.gn // gov : http://en.wikipedia.org/wiki/.gov gov // gp : http://www.nic.gp/index.php?lang=en gp com.gp net.gp mobi.gp edu.gp org.gp asso.gp // gq : http://en.wikipedia.org/wiki/.gq gq // gr : https://grweb.ics.forth.gr/english/1617-B-2005.html // Submitted by registry 2008-06-09 gr com.gr edu.gr net.gr org.gr gov.gr // gs : http://en.wikipedia.org/wiki/.gs gs // gt : http://www.gt/politicas_de_registro.html gt com.gt edu.gt gob.gt ind.gt mil.gt net.gt org.gt // gu : http://gadao.gov.gu/registration.txt *.gu // gw : http://en.wikipedia.org/wiki/.gw gw // gy : http://en.wikipedia.org/wiki/.gy // http://registry.gy/ gy co.gy com.gy net.gy // hk : https://www.hkdnr.hk // Submitted by registry 2008-06-11 hk com.hk edu.hk gov.hk idv.hk net.hk org.hk 公司.hk 教育.hk 敎育.hk 政府.hk 個人.hk 个人.hk 箇人.hk 網络.hk 网络.hk 组織.hk 網絡.hk 网絡.hk 组织.hk 組織.hk 組织.hk // hm : http://en.wikipedia.org/wiki/.hm hm // hn : http://www.nic.hn/politicas/ps02,,05.html hn com.hn edu.hn org.hn net.hn mil.hn gob.hn // hr : http://www.dns.hr/documents/pdf/HRTLD-regulations.pdf hr iz.hr from.hr name.hr com.hr // ht : http://www.nic.ht/info/charte.cfm ht com.ht shop.ht firm.ht info.ht adult.ht net.ht pro.ht org.ht med.ht art.ht coop.ht pol.ht asso.ht edu.ht rel.ht gouv.ht perso.ht // hu : http://www.domain.hu/domain/English/sld.html // Confirmed by registry 2008-06-12 hu co.hu info.hu org.hu priv.hu sport.hu tm.hu 2000.hu agrar.hu bolt.hu casino.hu city.hu erotica.hu erotika.hu film.hu forum.hu games.hu hotel.hu ingatlan.hu jogasz.hu konyvelo.hu lakas.hu media.hu news.hu reklam.hu sex.hu shop.hu suli.hu szex.hu tozsde.hu utazas.hu video.hu // id : https://register.pandi.or.id/ id ac.id biz.id co.id go.id mil.id my.id net.id or.id sch.id web.id // ie : http://en.wikipedia.org/wiki/.ie ie gov.ie // il : http://en.wikipedia.org/wiki/.il *.il // im : https://www.nic.im/pdfs/imfaqs.pdf im co.im ltd.co.im plc.co.im net.im gov.im org.im nic.im ac.im // in : http://en.wikipedia.org/wiki/.in // see also: http://www.inregistry.in/policies/ // Please note, that nic.in is not an offical eTLD, but used by most // government institutions. in co.in firm.in net.in org.in gen.in ind.in nic.in ac.in edu.in res.in gov.in mil.in // info : http://en.wikipedia.org/wiki/.info info // int : http://en.wikipedia.org/wiki/.int // Confirmed by registry 2008-06-18 int eu.int // io : http://www.nic.io/rules.html // list of other 2nd level tlds ? io com.io // iq : http://www.cmc.iq/english/iq/iqregister1.htm iq gov.iq edu.iq mil.iq com.iq org.iq net.iq // ir : http://www.nic.ir/Terms_and_Conditions_ir,_Appendix_1_Domain_Rules // Also see http://www.nic.ir/Internationalized_Domain_Names // Two .ir entries added at request of , 2010-04-16 ir ac.ir co.ir gov.ir id.ir net.ir org.ir sch.ir // xn--mgba3a4f16a.ir (.ir, Persian YEH) ایران.ir // xn--mgba3a4fra.ir (.ir, Arabic YEH) ايران.ir // is : http://www.isnic.is/domain/rules.php // Confirmed by registry 2008-12-06 is net.is com.is edu.is gov.is org.is int.is // it : http://en.wikipedia.org/wiki/.it it gov.it edu.it // list of reserved geo-names : // http://www.nic.it/documenti/regolamenti-e-linee-guida/regolamento-assegnazione-versione-6.0.pdf // (There is also a list of reserved geo-names corresponding to Italian // municipalities : http://www.nic.it/documenti/appendice-c.pdf , but it is // not included here.) agrigento.it ag.it alessandria.it al.it ancona.it an.it aosta.it aoste.it ao.it arezzo.it ar.it ascoli-piceno.it ascolipiceno.it ap.it asti.it at.it avellino.it av.it bari.it ba.it andria-barletta-trani.it andriabarlettatrani.it trani-barletta-andria.it tranibarlettaandria.it barletta-trani-andria.it barlettatraniandria.it andria-trani-barletta.it andriatranibarletta.it trani-andria-barletta.it traniandriabarletta.it bt.it belluno.it bl.it benevento.it bn.it bergamo.it bg.it biella.it bi.it bologna.it bo.it bolzano.it bozen.it balsan.it alto-adige.it altoadige.it suedtirol.it bz.it brescia.it bs.it brindisi.it br.it cagliari.it ca.it caltanissetta.it cl.it campobasso.it cb.it carboniaiglesias.it carbonia-iglesias.it iglesias-carbonia.it iglesiascarbonia.it ci.it caserta.it ce.it catania.it ct.it catanzaro.it cz.it chieti.it ch.it como.it co.it cosenza.it cs.it cremona.it cr.it crotone.it kr.it cuneo.it cn.it dell-ogliastra.it dellogliastra.it ogliastra.it og.it enna.it en.it ferrara.it fe.it fermo.it fm.it firenze.it florence.it fi.it foggia.it fg.it forli-cesena.it forlicesena.it cesena-forli.it cesenaforli.it fc.it frosinone.it fr.it genova.it genoa.it ge.it gorizia.it go.it grosseto.it gr.it imperia.it im.it isernia.it is.it laquila.it aquila.it aq.it la-spezia.it laspezia.it sp.it latina.it lt.it lecce.it le.it lecco.it lc.it livorno.it li.it lodi.it lo.it lucca.it lu.it macerata.it mc.it mantova.it mn.it massa-carrara.it massacarrara.it carrara-massa.it carraramassa.it ms.it matera.it mt.it medio-campidano.it mediocampidano.it campidano-medio.it campidanomedio.it vs.it messina.it me.it milano.it milan.it mi.it modena.it mo.it monza.it monza-brianza.it monzabrianza.it monzaebrianza.it monzaedellabrianza.it monza-e-della-brianza.it mb.it napoli.it naples.it na.it novara.it no.it nuoro.it nu.it oristano.it or.it padova.it padua.it pd.it palermo.it pa.it parma.it pr.it pavia.it pv.it perugia.it pg.it pescara.it pe.it pesaro-urbino.it pesarourbino.it urbino-pesaro.it urbinopesaro.it pu.it piacenza.it pc.it pisa.it pi.it pistoia.it pt.it pordenone.it pn.it potenza.it pz.it prato.it po.it ragusa.it rg.it ravenna.it ra.it reggio-calabria.it reggiocalabria.it rc.it reggio-emilia.it reggioemilia.it re.it rieti.it ri.it rimini.it rn.it roma.it rome.it rm.it rovigo.it ro.it salerno.it sa.it sassari.it ss.it savona.it sv.it siena.it si.it siracusa.it sr.it sondrio.it so.it taranto.it ta.it tempio-olbia.it tempioolbia.it olbia-tempio.it olbiatempio.it ot.it teramo.it te.it terni.it tr.it torino.it turin.it to.it trapani.it tp.it trento.it trentino.it tn.it treviso.it tv.it trieste.it ts.it udine.it ud.it varese.it va.it venezia.it venice.it ve.it verbania.it vb.it vercelli.it vc.it verona.it vr.it vibo-valentia.it vibovalentia.it vv.it vicenza.it vi.it viterbo.it vt.it // je : http://www.channelisles.net/applic/avextn.shtml je co.je org.je net.je sch.je gov.je // jm : http://www.com.jm/register.html *.jm // jo : http://www.dns.jo/Registration_policy.aspx jo com.jo org.jo net.jo edu.jo sch.jo gov.jo mil.jo name.jo // jobs : http://en.wikipedia.org/wiki/.jobs jobs // jp : http://en.wikipedia.org/wiki/.jp // http://jprs.co.jp/en/jpdomain.html // Updated by registry 2012-05-28 jp // jp organizational type names ac.jp ad.jp co.jp ed.jp go.jp gr.jp lg.jp ne.jp or.jp // jp preficture type names aichi.jp akita.jp aomori.jp chiba.jp ehime.jp fukui.jp fukuoka.jp fukushima.jp gifu.jp gunma.jp hiroshima.jp hokkaido.jp hyogo.jp ibaraki.jp ishikawa.jp iwate.jp kagawa.jp kagoshima.jp kanagawa.jp kochi.jp kumamoto.jp kyoto.jp mie.jp miyagi.jp miyazaki.jp nagano.jp nagasaki.jp nara.jp niigata.jp oita.jp okayama.jp okinawa.jp osaka.jp saga.jp saitama.jp shiga.jp shimane.jp shizuoka.jp tochigi.jp tokushima.jp tokyo.jp tottori.jp toyama.jp wakayama.jp yamagata.jp yamaguchi.jp yamanashi.jp // jp geographic type names // http://jprs.jp/doc/rule/saisoku-1.html *.kawasaki.jp *.kitakyushu.jp *.kobe.jp *.nagoya.jp *.sapporo.jp *.sendai.jp *.yokohama.jp !city.kawasaki.jp !city.kitakyushu.jp !city.kobe.jp !city.nagoya.jp !city.sapporo.jp !city.sendai.jp !city.yokohama.jp // 4th level registration aisai.aichi.jp ama.aichi.jp anjo.aichi.jp asuke.aichi.jp chiryu.aichi.jp chita.aichi.jp fuso.aichi.jp gamagori.aichi.jp handa.aichi.jp hazu.aichi.jp hekinan.aichi.jp higashiura.aichi.jp ichinomiya.aichi.jp inazawa.aichi.jp inuyama.aichi.jp isshiki.aichi.jp iwakura.aichi.jp kanie.aichi.jp kariya.aichi.jp kasugai.aichi.jp kira.aichi.jp kiyosu.aichi.jp komaki.aichi.jp konan.aichi.jp kota.aichi.jp mihama.aichi.jp miyoshi.aichi.jp nagakute.aichi.jp nishio.aichi.jp nisshin.aichi.jp obu.aichi.jp oguchi.aichi.jp oharu.aichi.jp okazaki.aichi.jp owariasahi.aichi.jp seto.aichi.jp shikatsu.aichi.jp shinshiro.aichi.jp shitara.aichi.jp tahara.aichi.jp takahama.aichi.jp tobishima.aichi.jp toei.aichi.jp togo.aichi.jp tokai.aichi.jp tokoname.aichi.jp toyoake.aichi.jp toyohashi.aichi.jp toyokawa.aichi.jp toyone.aichi.jp toyota.aichi.jp tsushima.aichi.jp yatomi.aichi.jp akita.akita.jp daisen.akita.jp fujisato.akita.jp gojome.akita.jp hachirogata.akita.jp happou.akita.jp higashinaruse.akita.jp honjo.akita.jp honjyo.akita.jp ikawa.akita.jp kamikoani.akita.jp kamioka.akita.jp katagami.akita.jp kazuno.akita.jp kitaakita.akita.jp kosaka.akita.jp kyowa.akita.jp misato.akita.jp mitane.akita.jp moriyoshi.akita.jp nikaho.akita.jp noshiro.akita.jp odate.akita.jp oga.akita.jp ogata.akita.jp semboku.akita.jp yokote.akita.jp yurihonjo.akita.jp aomori.aomori.jp gonohe.aomori.jp hachinohe.aomori.jp hashikami.aomori.jp hiranai.aomori.jp hirosaki.aomori.jp itayanagi.aomori.jp kuroishi.aomori.jp misawa.aomori.jp mutsu.aomori.jp nakadomari.aomori.jp noheji.aomori.jp oirase.aomori.jp owani.aomori.jp rokunohe.aomori.jp sannohe.aomori.jp shichinohe.aomori.jp shingo.aomori.jp takko.aomori.jp towada.aomori.jp tsugaru.aomori.jp tsuruta.aomori.jp abiko.chiba.jp asahi.chiba.jp chonan.chiba.jp chosei.chiba.jp choshi.chiba.jp chuo.chiba.jp funabashi.chiba.jp futtsu.chiba.jp hanamigawa.chiba.jp ichihara.chiba.jp ichikawa.chiba.jp ichinomiya.chiba.jp inzai.chiba.jp isumi.chiba.jp kamagaya.chiba.jp kamogawa.chiba.jp kashiwa.chiba.jp katori.chiba.jp katsuura.chiba.jp kimitsu.chiba.jp kisarazu.chiba.jp kozaki.chiba.jp kujukuri.chiba.jp kyonan.chiba.jp matsudo.chiba.jp midori.chiba.jp mihama.chiba.jp minamiboso.chiba.jp mobara.chiba.jp mutsuzawa.chiba.jp nagara.chiba.jp nagareyama.chiba.jp narashino.chiba.jp narita.chiba.jp noda.chiba.jp oamishirasato.chiba.jp omigawa.chiba.jp onjuku.chiba.jp otaki.chiba.jp sakae.chiba.jp sakura.chiba.jp shimofusa.chiba.jp shirako.chiba.jp shiroi.chiba.jp shisui.chiba.jp sodegaura.chiba.jp sosa.chiba.jp tako.chiba.jp tateyama.chiba.jp togane.chiba.jp tohnosho.chiba.jp tomisato.chiba.jp urayasu.chiba.jp yachimata.chiba.jp yachiyo.chiba.jp yokaichiba.chiba.jp yokoshibahikari.chiba.jp yotsukaido.chiba.jp ainan.ehime.jp honai.ehime.jp ikata.ehime.jp imabari.ehime.jp iyo.ehime.jp kamijima.ehime.jp kihoku.ehime.jp kumakogen.ehime.jp masaki.ehime.jp matsuno.ehime.jp matsuyama.ehime.jp namikata.ehime.jp niihama.ehime.jp ozu.ehime.jp saijo.ehime.jp seiyo.ehime.jp shikokuchuo.ehime.jp tobe.ehime.jp toon.ehime.jp uchiko.ehime.jp uwajima.ehime.jp yawatahama.ehime.jp echizen.fukui.jp eiheiji.fukui.jp fukui.fukui.jp ikeda.fukui.jp katsuyama.fukui.jp mihama.fukui.jp minamiechizen.fukui.jp obama.fukui.jp ohi.fukui.jp ono.fukui.jp sabae.fukui.jp sakai.fukui.jp takahama.fukui.jp tsuruga.fukui.jp wakasa.fukui.jp ashiya.fukuoka.jp buzen.fukuoka.jp chikugo.fukuoka.jp chikuho.fukuoka.jp chikujo.fukuoka.jp chikushino.fukuoka.jp chikuzen.fukuoka.jp chuo.fukuoka.jp dazaifu.fukuoka.jp fukuchi.fukuoka.jp hakata.fukuoka.jp higashi.fukuoka.jp hirokawa.fukuoka.jp hisayama.fukuoka.jp iizuka.fukuoka.jp inatsuki.fukuoka.jp kaho.fukuoka.jp kasuga.fukuoka.jp kasuya.fukuoka.jp kawara.fukuoka.jp keisen.fukuoka.jp koga.fukuoka.jp kurate.fukuoka.jp kurogi.fukuoka.jp kurume.fukuoka.jp minami.fukuoka.jp miyako.fukuoka.jp miyama.fukuoka.jp miyawaka.fukuoka.jp mizumaki.fukuoka.jp munakata.fukuoka.jp nakagawa.fukuoka.jp nakama.fukuoka.jp nishi.fukuoka.jp nogata.fukuoka.jp ogori.fukuoka.jp okagaki.fukuoka.jp okawa.fukuoka.jp oki.fukuoka.jp omuta.fukuoka.jp onga.fukuoka.jp onojo.fukuoka.jp oto.fukuoka.jp saigawa.fukuoka.jp sasaguri.fukuoka.jp shingu.fukuoka.jp shinyoshitomi.fukuoka.jp shonai.fukuoka.jp soeda.fukuoka.jp sue.fukuoka.jp tachiarai.fukuoka.jp tagawa.fukuoka.jp takata.fukuoka.jp toho.fukuoka.jp toyotsu.fukuoka.jp tsuiki.fukuoka.jp ukiha.fukuoka.jp umi.fukuoka.jp usui.fukuoka.jp yamada.fukuoka.jp yame.fukuoka.jp yanagawa.fukuoka.jp yukuhashi.fukuoka.jp aizubange.fukushima.jp aizumisato.fukushima.jp aizuwakamatsu.fukushima.jp asakawa.fukushima.jp bandai.fukushima.jp date.fukushima.jp fukushima.fukushima.jp furudono.fukushima.jp futaba.fukushima.jp hanawa.fukushima.jp higashi.fukushima.jp hirata.fukushima.jp hirono.fukushima.jp iitate.fukushima.jp inawashiro.fukushima.jp ishikawa.fukushima.jp iwaki.fukushima.jp izumizaki.fukushima.jp kagamiishi.fukushima.jp kaneyama.fukushima.jp kawamata.fukushima.jp kitakata.fukushima.jp kitashiobara.fukushima.jp koori.fukushima.jp koriyama.fukushima.jp kunimi.fukushima.jp miharu.fukushima.jp mishima.fukushima.jp namie.fukushima.jp nango.fukushima.jp nishiaizu.fukushima.jp nishigo.fukushima.jp okuma.fukushima.jp omotego.fukushima.jp ono.fukushima.jp otama.fukushima.jp samegawa.fukushima.jp shimogo.fukushima.jp shirakawa.fukushima.jp showa.fukushima.jp soma.fukushima.jp sukagawa.fukushima.jp taishin.fukushima.jp tamakawa.fukushima.jp tanagura.fukushima.jp tenei.fukushima.jp yabuki.fukushima.jp yamato.fukushima.jp yamatsuri.fukushima.jp yanaizu.fukushima.jp yugawa.fukushima.jp anpachi.gifu.jp ena.gifu.jp gifu.gifu.jp ginan.gifu.jp godo.gifu.jp gujo.gifu.jp hashima.gifu.jp hichiso.gifu.jp hida.gifu.jp higashishirakawa.gifu.jp ibigawa.gifu.jp ikeda.gifu.jp kakamigahara.gifu.jp kani.gifu.jp kasahara.gifu.jp kasamatsu.gifu.jp kawaue.gifu.jp kitagata.gifu.jp mino.gifu.jp minokamo.gifu.jp mitake.gifu.jp mizunami.gifu.jp motosu.gifu.jp nakatsugawa.gifu.jp ogaki.gifu.jp sakahogi.gifu.jp seki.gifu.jp sekigahara.gifu.jp shirakawa.gifu.jp tajimi.gifu.jp takayama.gifu.jp tarui.gifu.jp toki.gifu.jp tomika.gifu.jp wanouchi.gifu.jp yamagata.gifu.jp yaotsu.gifu.jp yoro.gifu.jp annaka.gunma.jp chiyoda.gunma.jp fujioka.gunma.jp higashiagatsuma.gunma.jp isesaki.gunma.jp itakura.gunma.jp kanna.gunma.jp kanra.gunma.jp katashina.gunma.jp kawaba.gunma.jp kiryu.gunma.jp kusatsu.gunma.jp maebashi.gunma.jp meiwa.gunma.jp midori.gunma.jp minakami.gunma.jp naganohara.gunma.jp nakanojo.gunma.jp nanmoku.gunma.jp numata.gunma.jp oizumi.gunma.jp ora.gunma.jp ota.gunma.jp shibukawa.gunma.jp shimonita.gunma.jp shinto.gunma.jp showa.gunma.jp takasaki.gunma.jp takayama.gunma.jp tamamura.gunma.jp tatebayashi.gunma.jp tomioka.gunma.jp tsukiyono.gunma.jp tsumagoi.gunma.jp ueno.gunma.jp yoshioka.gunma.jp asaminami.hiroshima.jp daiwa.hiroshima.jp etajima.hiroshima.jp fuchu.hiroshima.jp fukuyama.hiroshima.jp hatsukaichi.hiroshima.jp higashihiroshima.hiroshima.jp hongo.hiroshima.jp jinsekikogen.hiroshima.jp kaita.hiroshima.jp kui.hiroshima.jp kumano.hiroshima.jp kure.hiroshima.jp mihara.hiroshima.jp miyoshi.hiroshima.jp naka.hiroshima.jp onomichi.hiroshima.jp osakikamijima.hiroshima.jp otake.hiroshima.jp saka.hiroshima.jp sera.hiroshima.jp seranishi.hiroshima.jp shinichi.hiroshima.jp shobara.hiroshima.jp takehara.hiroshima.jp abashiri.hokkaido.jp abira.hokkaido.jp aibetsu.hokkaido.jp akabira.hokkaido.jp akkeshi.hokkaido.jp asahikawa.hokkaido.jp ashibetsu.hokkaido.jp ashoro.hokkaido.jp assabu.hokkaido.jp atsuma.hokkaido.jp bibai.hokkaido.jp biei.hokkaido.jp bifuka.hokkaido.jp bihoro.hokkaido.jp biratori.hokkaido.jp chippubetsu.hokkaido.jp chitose.hokkaido.jp date.hokkaido.jp ebetsu.hokkaido.jp embetsu.hokkaido.jp eniwa.hokkaido.jp erimo.hokkaido.jp esan.hokkaido.jp esashi.hokkaido.jp fukagawa.hokkaido.jp fukushima.hokkaido.jp furano.hokkaido.jp furubira.hokkaido.jp haboro.hokkaido.jp hakodate.hokkaido.jp hamatonbetsu.hokkaido.jp hidaka.hokkaido.jp higashikagura.hokkaido.jp higashikawa.hokkaido.jp hiroo.hokkaido.jp hokuryu.hokkaido.jp hokuto.hokkaido.jp honbetsu.hokkaido.jp horokanai.hokkaido.jp horonobe.hokkaido.jp ikeda.hokkaido.jp imakane.hokkaido.jp ishikari.hokkaido.jp iwamizawa.hokkaido.jp iwanai.hokkaido.jp kamifurano.hokkaido.jp kamikawa.hokkaido.jp kamishihoro.hokkaido.jp kamisunagawa.hokkaido.jp kamoenai.hokkaido.jp kayabe.hokkaido.jp kembuchi.hokkaido.jp kikonai.hokkaido.jp kimobetsu.hokkaido.jp kitahiroshima.hokkaido.jp kitami.hokkaido.jp kiyosato.hokkaido.jp koshimizu.hokkaido.jp kunneppu.hokkaido.jp kuriyama.hokkaido.jp kuromatsunai.hokkaido.jp kushiro.hokkaido.jp kutchan.hokkaido.jp kyowa.hokkaido.jp mashike.hokkaido.jp matsumae.hokkaido.jp mikasa.hokkaido.jp minamifurano.hokkaido.jp mombetsu.hokkaido.jp moseushi.hokkaido.jp mukawa.hokkaido.jp muroran.hokkaido.jp naie.hokkaido.jp nakagawa.hokkaido.jp nakasatsunai.hokkaido.jp nakatombetsu.hokkaido.jp nanae.hokkaido.jp nanporo.hokkaido.jp nayoro.hokkaido.jp nemuro.hokkaido.jp niikappu.hokkaido.jp niki.hokkaido.jp nishiokoppe.hokkaido.jp noboribetsu.hokkaido.jp numata.hokkaido.jp obihiro.hokkaido.jp obira.hokkaido.jp oketo.hokkaido.jp okoppe.hokkaido.jp otaru.hokkaido.jp otobe.hokkaido.jp otofuke.hokkaido.jp otoineppu.hokkaido.jp oumu.hokkaido.jp ozora.hokkaido.jp pippu.hokkaido.jp rankoshi.hokkaido.jp rebun.hokkaido.jp rikubetsu.hokkaido.jp rishiri.hokkaido.jp rishirifuji.hokkaido.jp saroma.hokkaido.jp sarufutsu.hokkaido.jp shakotan.hokkaido.jp shari.hokkaido.jp shibecha.hokkaido.jp shibetsu.hokkaido.jp shikabe.hokkaido.jp shikaoi.hokkaido.jp shimamaki.hokkaido.jp shimizu.hokkaido.jp shimokawa.hokkaido.jp shinshinotsu.hokkaido.jp shintoku.hokkaido.jp shiranuka.hokkaido.jp shiraoi.hokkaido.jp shiriuchi.hokkaido.jp sobetsu.hokkaido.jp sunagawa.hokkaido.jp taiki.hokkaido.jp takasu.hokkaido.jp takikawa.hokkaido.jp takinoue.hokkaido.jp teshikaga.hokkaido.jp tobetsu.hokkaido.jp tohma.hokkaido.jp tomakomai.hokkaido.jp tomari.hokkaido.jp toya.hokkaido.jp toyako.hokkaido.jp toyotomi.hokkaido.jp toyoura.hokkaido.jp tsubetsu.hokkaido.jp tsukigata.hokkaido.jp urakawa.hokkaido.jp urausu.hokkaido.jp uryu.hokkaido.jp utashinai.hokkaido.jp wakkanai.hokkaido.jp wassamu.hokkaido.jp yakumo.hokkaido.jp yoichi.hokkaido.jp aioi.hyogo.jp akashi.hyogo.jp ako.hyogo.jp amagasaki.hyogo.jp aogaki.hyogo.jp asago.hyogo.jp ashiya.hyogo.jp awaji.hyogo.jp fukusaki.hyogo.jp goshiki.hyogo.jp harima.hyogo.jp himeji.hyogo.jp ichikawa.hyogo.jp inagawa.hyogo.jp itami.hyogo.jp kakogawa.hyogo.jp kamigori.hyogo.jp kamikawa.hyogo.jp kasai.hyogo.jp kasuga.hyogo.jp kawanishi.hyogo.jp miki.hyogo.jp minamiawaji.hyogo.jp nishinomiya.hyogo.jp nishiwaki.hyogo.jp ono.hyogo.jp sanda.hyogo.jp sannan.hyogo.jp sasayama.hyogo.jp sayo.hyogo.jp shingu.hyogo.jp shinonsen.hyogo.jp shiso.hyogo.jp sumoto.hyogo.jp taishi.hyogo.jp taka.hyogo.jp takarazuka.hyogo.jp takasago.hyogo.jp takino.hyogo.jp tamba.hyogo.jp tatsuno.hyogo.jp toyooka.hyogo.jp yabu.hyogo.jp yashiro.hyogo.jp yoka.hyogo.jp yokawa.hyogo.jp ami.ibaraki.jp asahi.ibaraki.jp bando.ibaraki.jp chikusei.ibaraki.jp daigo.ibaraki.jp fujishiro.ibaraki.jp hitachi.ibaraki.jp hitachinaka.ibaraki.jp hitachiomiya.ibaraki.jp hitachiota.ibaraki.jp ibaraki.ibaraki.jp ina.ibaraki.jp inashiki.ibaraki.jp itako.ibaraki.jp iwama.ibaraki.jp joso.ibaraki.jp kamisu.ibaraki.jp kasama.ibaraki.jp kashima.ibaraki.jp kasumigaura.ibaraki.jp koga.ibaraki.jp miho.ibaraki.jp mito.ibaraki.jp moriya.ibaraki.jp naka.ibaraki.jp namegata.ibaraki.jp oarai.ibaraki.jp ogawa.ibaraki.jp omitama.ibaraki.jp ryugasaki.ibaraki.jp sakai.ibaraki.jp sakuragawa.ibaraki.jp shimodate.ibaraki.jp shimotsuma.ibaraki.jp shirosato.ibaraki.jp sowa.ibaraki.jp suifu.ibaraki.jp takahagi.ibaraki.jp tamatsukuri.ibaraki.jp tokai.ibaraki.jp tomobe.ibaraki.jp tone.ibaraki.jp toride.ibaraki.jp tsuchiura.ibaraki.jp tsukuba.ibaraki.jp uchihara.ibaraki.jp ushiku.ibaraki.jp yachiyo.ibaraki.jp yamagata.ibaraki.jp yawara.ibaraki.jp yuki.ibaraki.jp anamizu.ishikawa.jp hakui.ishikawa.jp hakusan.ishikawa.jp kaga.ishikawa.jp kahoku.ishikawa.jp kanazawa.ishikawa.jp kawakita.ishikawa.jp komatsu.ishikawa.jp nakanoto.ishikawa.jp nanao.ishikawa.jp nomi.ishikawa.jp nonoichi.ishikawa.jp noto.ishikawa.jp shika.ishikawa.jp suzu.ishikawa.jp tsubata.ishikawa.jp tsurugi.ishikawa.jp uchinada.ishikawa.jp wajima.ishikawa.jp fudai.iwate.jp fujisawa.iwate.jp hanamaki.iwate.jp hiraizumi.iwate.jp hirono.iwate.jp ichinohe.iwate.jp ichinoseki.iwate.jp iwaizumi.iwate.jp iwate.iwate.jp joboji.iwate.jp kamaishi.iwate.jp kanegasaki.iwate.jp karumai.iwate.jp kawai.iwate.jp kitakami.iwate.jp kuji.iwate.jp kunohe.iwate.jp kuzumaki.iwate.jp miyako.iwate.jp mizusawa.iwate.jp morioka.iwate.jp ninohe.iwate.jp noda.iwate.jp ofunato.iwate.jp oshu.iwate.jp otsuchi.iwate.jp rikuzentakata.iwate.jp shiwa.iwate.jp shizukuishi.iwate.jp sumita.iwate.jp takizawa.iwate.jp tanohata.iwate.jp tono.iwate.jp yahaba.iwate.jp yamada.iwate.jp ayagawa.kagawa.jp higashikagawa.kagawa.jp kanonji.kagawa.jp kotohira.kagawa.jp manno.kagawa.jp marugame.kagawa.jp mitoyo.kagawa.jp naoshima.kagawa.jp sanuki.kagawa.jp tadotsu.kagawa.jp takamatsu.kagawa.jp tonosho.kagawa.jp uchinomi.kagawa.jp utazu.kagawa.jp zentsuji.kagawa.jp akune.kagoshima.jp amami.kagoshima.jp hioki.kagoshima.jp isa.kagoshima.jp isen.kagoshima.jp izumi.kagoshima.jp kagoshima.kagoshima.jp kanoya.kagoshima.jp kawanabe.kagoshima.jp kinko.kagoshima.jp kouyama.kagoshima.jp makurazaki.kagoshima.jp matsumoto.kagoshima.jp minamitane.kagoshima.jp nakatane.kagoshima.jp nishinoomote.kagoshima.jp satsumasendai.kagoshima.jp soo.kagoshima.jp tarumizu.kagoshima.jp yusui.kagoshima.jp aikawa.kanagawa.jp atsugi.kanagawa.jp ayase.kanagawa.jp chigasaki.kanagawa.jp ebina.kanagawa.jp fujisawa.kanagawa.jp hadano.kanagawa.jp hakone.kanagawa.jp hiratsuka.kanagawa.jp isehara.kanagawa.jp kaisei.kanagawa.jp kamakura.kanagawa.jp kiyokawa.kanagawa.jp matsuda.kanagawa.jp minamiashigara.kanagawa.jp miura.kanagawa.jp nakai.kanagawa.jp ninomiya.kanagawa.jp odawara.kanagawa.jp oi.kanagawa.jp oiso.kanagawa.jp sagamihara.kanagawa.jp samukawa.kanagawa.jp tsukui.kanagawa.jp yamakita.kanagawa.jp yamato.kanagawa.jp yokosuka.kanagawa.jp yugawara.kanagawa.jp zama.kanagawa.jp zushi.kanagawa.jp aki.kochi.jp geisei.kochi.jp hidaka.kochi.jp higashitsuno.kochi.jp ino.kochi.jp kagami.kochi.jp kami.kochi.jp kitagawa.kochi.jp kochi.kochi.jp mihara.kochi.jp motoyama.kochi.jp muroto.kochi.jp nahari.kochi.jp nakamura.kochi.jp nankoku.kochi.jp nishitosa.kochi.jp niyodogawa.kochi.jp ochi.kochi.jp okawa.kochi.jp otoyo.kochi.jp otsuki.kochi.jp sakawa.kochi.jp sukumo.kochi.jp susaki.kochi.jp tosa.kochi.jp tosashimizu.kochi.jp toyo.kochi.jp tsuno.kochi.jp umaji.kochi.jp yasuda.kochi.jp yusuhara.kochi.jp amakusa.kumamoto.jp arao.kumamoto.jp aso.kumamoto.jp choyo.kumamoto.jp gyokuto.kumamoto.jp hitoyoshi.kumamoto.jp kamiamakusa.kumamoto.jp kashima.kumamoto.jp kikuchi.kumamoto.jp kosa.kumamoto.jp kumamoto.kumamoto.jp mashiki.kumamoto.jp mifune.kumamoto.jp minamata.kumamoto.jp minamioguni.kumamoto.jp nagasu.kumamoto.jp nishihara.kumamoto.jp oguni.kumamoto.jp ozu.kumamoto.jp sumoto.kumamoto.jp takamori.kumamoto.jp uki.kumamoto.jp uto.kumamoto.jp yamaga.kumamoto.jp yamato.kumamoto.jp yatsushiro.kumamoto.jp ayabe.kyoto.jp fukuchiyama.kyoto.jp higashiyama.kyoto.jp ide.kyoto.jp ine.kyoto.jp joyo.kyoto.jp kameoka.kyoto.jp kamo.kyoto.jp kita.kyoto.jp kizu.kyoto.jp kumiyama.kyoto.jp kyotamba.kyoto.jp kyotanabe.kyoto.jp kyotango.kyoto.jp maizuru.kyoto.jp minami.kyoto.jp minamiyamashiro.kyoto.jp miyazu.kyoto.jp muko.kyoto.jp nagaokakyo.kyoto.jp nakagyo.kyoto.jp nantan.kyoto.jp oyamazaki.kyoto.jp sakyo.kyoto.jp seika.kyoto.jp tanabe.kyoto.jp uji.kyoto.jp ujitawara.kyoto.jp wazuka.kyoto.jp yamashina.kyoto.jp yawata.kyoto.jp asahi.mie.jp inabe.mie.jp ise.mie.jp kameyama.mie.jp kawagoe.mie.jp kiho.mie.jp kisosaki.mie.jp kiwa.mie.jp komono.mie.jp kumano.mie.jp kuwana.mie.jp matsusaka.mie.jp meiwa.mie.jp mihama.mie.jp minamiise.mie.jp misugi.mie.jp miyama.mie.jp nabari.mie.jp shima.mie.jp suzuka.mie.jp tado.mie.jp taiki.mie.jp taki.mie.jp tamaki.mie.jp toba.mie.jp tsu.mie.jp udono.mie.jp ureshino.mie.jp watarai.mie.jp yokkaichi.mie.jp furukawa.miyagi.jp higashimatsushima.miyagi.jp ishinomaki.miyagi.jp iwanuma.miyagi.jp kakuda.miyagi.jp kami.miyagi.jp kawasaki.miyagi.jp kesennuma.miyagi.jp marumori.miyagi.jp matsushima.miyagi.jp minamisanriku.miyagi.jp misato.miyagi.jp murata.miyagi.jp natori.miyagi.jp ogawara.miyagi.jp ohira.miyagi.jp onagawa.miyagi.jp osaki.miyagi.jp rifu.miyagi.jp semine.miyagi.jp shibata.miyagi.jp shichikashuku.miyagi.jp shikama.miyagi.jp shiogama.miyagi.jp shiroishi.miyagi.jp tagajo.miyagi.jp taiwa.miyagi.jp tome.miyagi.jp tomiya.miyagi.jp wakuya.miyagi.jp watari.miyagi.jp yamamoto.miyagi.jp zao.miyagi.jp aya.miyazaki.jp ebino.miyazaki.jp gokase.miyazaki.jp hyuga.miyazaki.jp kadogawa.miyazaki.jp kawaminami.miyazaki.jp kijo.miyazaki.jp kitagawa.miyazaki.jp kitakata.miyazaki.jp kitaura.miyazaki.jp kobayashi.miyazaki.jp kunitomi.miyazaki.jp kushima.miyazaki.jp mimata.miyazaki.jp miyakonojo.miyazaki.jp miyazaki.miyazaki.jp morotsuka.miyazaki.jp nichinan.miyazaki.jp nishimera.miyazaki.jp nobeoka.miyazaki.jp saito.miyazaki.jp shiiba.miyazaki.jp shintomi.miyazaki.jp takaharu.miyazaki.jp takanabe.miyazaki.jp takazaki.miyazaki.jp tsuno.miyazaki.jp achi.nagano.jp agematsu.nagano.jp anan.nagano.jp aoki.nagano.jp asahi.nagano.jp azumino.nagano.jp chikuhoku.nagano.jp chikuma.nagano.jp chino.nagano.jp fujimi.nagano.jp hakuba.nagano.jp hara.nagano.jp hiraya.nagano.jp iida.nagano.jp iijima.nagano.jp iiyama.nagano.jp iizuna.nagano.jp ikeda.nagano.jp ikusaka.nagano.jp ina.nagano.jp karuizawa.nagano.jp kawakami.nagano.jp kiso.nagano.jp kisofukushima.nagano.jp kitaaiki.nagano.jp komagane.nagano.jp komoro.nagano.jp matsukawa.nagano.jp matsumoto.nagano.jp miasa.nagano.jp minamiaiki.nagano.jp minamimaki.nagano.jp minamiminowa.nagano.jp minowa.nagano.jp miyada.nagano.jp miyota.nagano.jp mochizuki.nagano.jp nagano.nagano.jp nagawa.nagano.jp nagiso.nagano.jp nakagawa.nagano.jp nakano.nagano.jp nozawaonsen.nagano.jp obuse.nagano.jp ogawa.nagano.jp okaya.nagano.jp omachi.nagano.jp omi.nagano.jp ookuwa.nagano.jp ooshika.nagano.jp otaki.nagano.jp otari.nagano.jp sakae.nagano.jp sakaki.nagano.jp saku.nagano.jp sakuho.nagano.jp shimosuwa.nagano.jp shinanomachi.nagano.jp shiojiri.nagano.jp suwa.nagano.jp suzaka.nagano.jp takagi.nagano.jp takamori.nagano.jp takayama.nagano.jp tateshina.nagano.jp tatsuno.nagano.jp togakushi.nagano.jp togura.nagano.jp tomi.nagano.jp ueda.nagano.jp wada.nagano.jp yamagata.nagano.jp yamanouchi.nagano.jp yasaka.nagano.jp yasuoka.nagano.jp chijiwa.nagasaki.jp futsu.nagasaki.jp goto.nagasaki.jp hasami.nagasaki.jp hirado.nagasaki.jp iki.nagasaki.jp isahaya.nagasaki.jp kawatana.nagasaki.jp kuchinotsu.nagasaki.jp matsuura.nagasaki.jp nagasaki.nagasaki.jp obama.nagasaki.jp omura.nagasaki.jp oseto.nagasaki.jp saikai.nagasaki.jp sasebo.nagasaki.jp seihi.nagasaki.jp shimabara.nagasaki.jp shinkamigoto.nagasaki.jp togitsu.nagasaki.jp tsushima.nagasaki.jp unzen.nagasaki.jp ando.nara.jp gose.nara.jp heguri.nara.jp higashiyoshino.nara.jp ikaruga.nara.jp ikoma.nara.jp kamikitayama.nara.jp kanmaki.nara.jp kashiba.nara.jp kashihara.nara.jp katsuragi.nara.jp kawai.nara.jp kawakami.nara.jp kawanishi.nara.jp koryo.nara.jp kurotaki.nara.jp mitsue.nara.jp miyake.nara.jp nara.nara.jp nosegawa.nara.jp oji.nara.jp ouda.nara.jp oyodo.nara.jp sakurai.nara.jp sango.nara.jp shimoichi.nara.jp shimokitayama.nara.jp shinjo.nara.jp soni.nara.jp takatori.nara.jp tawaramoto.nara.jp tenkawa.nara.jp tenri.nara.jp uda.nara.jp yamatokoriyama.nara.jp yamatotakada.nara.jp yamazoe.nara.jp yoshino.nara.jp aga.niigata.jp agano.niigata.jp gosen.niigata.jp itoigawa.niigata.jp izumozaki.niigata.jp joetsu.niigata.jp kamo.niigata.jp kariwa.niigata.jp kashiwazaki.niigata.jp minamiuonuma.niigata.jp mitsuke.niigata.jp muika.niigata.jp murakami.niigata.jp myoko.niigata.jp nagaoka.niigata.jp niigata.niigata.jp ojiya.niigata.jp omi.niigata.jp sado.niigata.jp sanjo.niigata.jp seiro.niigata.jp seirou.niigata.jp sekikawa.niigata.jp shibata.niigata.jp tagami.niigata.jp tainai.niigata.jp tochio.niigata.jp tokamachi.niigata.jp tsubame.niigata.jp tsunan.niigata.jp uonuma.niigata.jp yahiko.niigata.jp yoita.niigata.jp yuzawa.niigata.jp beppu.oita.jp bungoono.oita.jp bungotakada.oita.jp hasama.oita.jp hiji.oita.jp himeshima.oita.jp hita.oita.jp kamitsue.oita.jp kokonoe.oita.jp kuju.oita.jp kunisaki.oita.jp kusu.oita.jp oita.oita.jp saiki.oita.jp taketa.oita.jp tsukumi.oita.jp usa.oita.jp usuki.oita.jp yufu.oita.jp akaiwa.okayama.jp asakuchi.okayama.jp bizen.okayama.jp hayashima.okayama.jp ibara.okayama.jp kagamino.okayama.jp kasaoka.okayama.jp kibichuo.okayama.jp kumenan.okayama.jp kurashiki.okayama.jp maniwa.okayama.jp misaki.okayama.jp nagi.okayama.jp niimi.okayama.jp nishiawakura.okayama.jp okayama.okayama.jp satosho.okayama.jp setouchi.okayama.jp shinjo.okayama.jp shoo.okayama.jp soja.okayama.jp takahashi.okayama.jp tamano.okayama.jp tsuyama.okayama.jp wake.okayama.jp yakage.okayama.jp aguni.okinawa.jp ginowan.okinawa.jp ginoza.okinawa.jp gushikami.okinawa.jp haebaru.okinawa.jp higashi.okinawa.jp hirara.okinawa.jp iheya.okinawa.jp ishigaki.okinawa.jp ishikawa.okinawa.jp itoman.okinawa.jp izena.okinawa.jp kadena.okinawa.jp kin.okinawa.jp kitadaito.okinawa.jp kitanakagusuku.okinawa.jp kumejima.okinawa.jp kunigami.okinawa.jp minamidaito.okinawa.jp motobu.okinawa.jp nago.okinawa.jp naha.okinawa.jp nakagusuku.okinawa.jp nakijin.okinawa.jp nanjo.okinawa.jp nishihara.okinawa.jp ogimi.okinawa.jp okinawa.okinawa.jp onna.okinawa.jp shimoji.okinawa.jp taketomi.okinawa.jp tarama.okinawa.jp tokashiki.okinawa.jp tomigusuku.okinawa.jp tonaki.okinawa.jp urasoe.okinawa.jp uruma.okinawa.jp yaese.okinawa.jp yomitan.okinawa.jp yonabaru.okinawa.jp yonaguni.okinawa.jp zamami.okinawa.jp abeno.osaka.jp chihayaakasaka.osaka.jp chuo.osaka.jp daito.osaka.jp fujiidera.osaka.jp habikino.osaka.jp hannan.osaka.jp higashiosaka.osaka.jp higashisumiyoshi.osaka.jp higashiyodogawa.osaka.jp hirakata.osaka.jp ibaraki.osaka.jp ikeda.osaka.jp izumi.osaka.jp izumiotsu.osaka.jp izumisano.osaka.jp kadoma.osaka.jp kaizuka.osaka.jp kanan.osaka.jp kashiwara.osaka.jp katano.osaka.jp kawachinagano.osaka.jp kishiwada.osaka.jp kita.osaka.jp kumatori.osaka.jp matsubara.osaka.jp minato.osaka.jp minoh.osaka.jp misaki.osaka.jp moriguchi.osaka.jp neyagawa.osaka.jp nishi.osaka.jp nose.osaka.jp osakasayama.osaka.jp sakai.osaka.jp sayama.osaka.jp sennan.osaka.jp settsu.osaka.jp shijonawate.osaka.jp shimamoto.osaka.jp suita.osaka.jp tadaoka.osaka.jp taishi.osaka.jp tajiri.osaka.jp takaishi.osaka.jp takatsuki.osaka.jp tondabayashi.osaka.jp toyonaka.osaka.jp toyono.osaka.jp yao.osaka.jp ariake.saga.jp arita.saga.jp fukudomi.saga.jp genkai.saga.jp hamatama.saga.jp hizen.saga.jp imari.saga.jp kamimine.saga.jp kanzaki.saga.jp karatsu.saga.jp kashima.saga.jp kitagata.saga.jp kitahata.saga.jp kiyama.saga.jp kouhoku.saga.jp kyuragi.saga.jp nishiarita.saga.jp ogi.saga.jp omachi.saga.jp ouchi.saga.jp saga.saga.jp shiroishi.saga.jp taku.saga.jp tara.saga.jp tosu.saga.jp yoshinogari.saga.jp arakawa.saitama.jp asaka.saitama.jp chichibu.saitama.jp fujimi.saitama.jp fujimino.saitama.jp fukaya.saitama.jp hanno.saitama.jp hanyu.saitama.jp hasuda.saitama.jp hatogaya.saitama.jp hatoyama.saitama.jp hidaka.saitama.jp higashichichibu.saitama.jp higashimatsuyama.saitama.jp honjo.saitama.jp ina.saitama.jp iruma.saitama.jp iwatsuki.saitama.jp kamiizumi.saitama.jp kamikawa.saitama.jp kamisato.saitama.jp kasukabe.saitama.jp kawagoe.saitama.jp kawaguchi.saitama.jp kawajima.saitama.jp kazo.saitama.jp kitamoto.saitama.jp koshigaya.saitama.jp kounosu.saitama.jp kuki.saitama.jp kumagaya.saitama.jp matsubushi.saitama.jp minano.saitama.jp misato.saitama.jp miyashiro.saitama.jp miyoshi.saitama.jp moroyama.saitama.jp nagatoro.saitama.jp namegawa.saitama.jp niiza.saitama.jp ogano.saitama.jp ogawa.saitama.jp ogose.saitama.jp okegawa.saitama.jp omiya.saitama.jp otaki.saitama.jp ranzan.saitama.jp ryokami.saitama.jp saitama.saitama.jp sakado.saitama.jp satte.saitama.jp sayama.saitama.jp shiki.saitama.jp shiraoka.saitama.jp soka.saitama.jp sugito.saitama.jp toda.saitama.jp tokigawa.saitama.jp tokorozawa.saitama.jp tsurugashima.saitama.jp urawa.saitama.jp warabi.saitama.jp yashio.saitama.jp yokoze.saitama.jp yono.saitama.jp yorii.saitama.jp yoshida.saitama.jp yoshikawa.saitama.jp yoshimi.saitama.jp aisho.shiga.jp gamo.shiga.jp higashiomi.shiga.jp hikone.shiga.jp koka.shiga.jp konan.shiga.jp kosei.shiga.jp koto.shiga.jp kusatsu.shiga.jp maibara.shiga.jp moriyama.shiga.jp nagahama.shiga.jp nishiazai.shiga.jp notogawa.shiga.jp omihachiman.shiga.jp otsu.shiga.jp ritto.shiga.jp ryuoh.shiga.jp takashima.shiga.jp takatsuki.shiga.jp torahime.shiga.jp toyosato.shiga.jp yasu.shiga.jp akagi.shimane.jp ama.shimane.jp gotsu.shimane.jp hamada.shimane.jp higashiizumo.shimane.jp hikawa.shimane.jp hikimi.shimane.jp izumo.shimane.jp kakinoki.shimane.jp masuda.shimane.jp matsue.shimane.jp misato.shimane.jp nishinoshima.shimane.jp ohda.shimane.jp okinoshima.shimane.jp okuizumo.shimane.jp shimane.shimane.jp tamayu.shimane.jp tsuwano.shimane.jp unnan.shimane.jp yakumo.shimane.jp yasugi.shimane.jp yatsuka.shimane.jp arai.shizuoka.jp atami.shizuoka.jp fuji.shizuoka.jp fujieda.shizuoka.jp fujikawa.shizuoka.jp fujinomiya.shizuoka.jp fukuroi.shizuoka.jp gotemba.shizuoka.jp haibara.shizuoka.jp hamamatsu.shizuoka.jp higashiizu.shizuoka.jp ito.shizuoka.jp iwata.shizuoka.jp izu.shizuoka.jp izunokuni.shizuoka.jp kakegawa.shizuoka.jp kannami.shizuoka.jp kawanehon.shizuoka.jp kawazu.shizuoka.jp kikugawa.shizuoka.jp kosai.shizuoka.jp makinohara.shizuoka.jp matsuzaki.shizuoka.jp minamiizu.shizuoka.jp mishima.shizuoka.jp morimachi.shizuoka.jp nishiizu.shizuoka.jp numazu.shizuoka.jp omaezaki.shizuoka.jp shimada.shizuoka.jp shimizu.shizuoka.jp shimoda.shizuoka.jp shizuoka.shizuoka.jp susono.shizuoka.jp yaizu.shizuoka.jp yoshida.shizuoka.jp ashikaga.tochigi.jp bato.tochigi.jp haga.tochigi.jp ichikai.tochigi.jp iwafune.tochigi.jp kaminokawa.tochigi.jp kanuma.tochigi.jp karasuyama.tochigi.jp kuroiso.tochigi.jp mashiko.tochigi.jp mibu.tochigi.jp moka.tochigi.jp motegi.tochigi.jp nasu.tochigi.jp nasushiobara.tochigi.jp nikko.tochigi.jp nishikata.tochigi.jp nogi.tochigi.jp ohira.tochigi.jp ohtawara.tochigi.jp oyama.tochigi.jp sakura.tochigi.jp sano.tochigi.jp shimotsuke.tochigi.jp shioya.tochigi.jp takanezawa.tochigi.jp tochigi.tochigi.jp tsuga.tochigi.jp ujiie.tochigi.jp utsunomiya.tochigi.jp yaita.tochigi.jp aizumi.tokushima.jp anan.tokushima.jp ichiba.tokushima.jp itano.tokushima.jp kainan.tokushima.jp komatsushima.tokushima.jp matsushige.tokushima.jp mima.tokushima.jp minami.tokushima.jp miyoshi.tokushima.jp mugi.tokushima.jp nakagawa.tokushima.jp naruto.tokushima.jp sanagochi.tokushima.jp shishikui.tokushima.jp tokushima.tokushima.jp wajiki.tokushima.jp adachi.tokyo.jp akiruno.tokyo.jp akishima.tokyo.jp aogashima.tokyo.jp arakawa.tokyo.jp bunkyo.tokyo.jp chiyoda.tokyo.jp chofu.tokyo.jp chuo.tokyo.jp edogawa.tokyo.jp fuchu.tokyo.jp fussa.tokyo.jp hachijo.tokyo.jp hachioji.tokyo.jp hamura.tokyo.jp higashikurume.tokyo.jp higashimurayama.tokyo.jp higashiyamato.tokyo.jp hino.tokyo.jp hinode.tokyo.jp hinohara.tokyo.jp inagi.tokyo.jp itabashi.tokyo.jp katsushika.tokyo.jp kita.tokyo.jp kiyose.tokyo.jp kodaira.tokyo.jp koganei.tokyo.jp kokubunji.tokyo.jp komae.tokyo.jp koto.tokyo.jp kouzushima.tokyo.jp kunitachi.tokyo.jp machida.tokyo.jp meguro.tokyo.jp minato.tokyo.jp mitaka.tokyo.jp mizuho.tokyo.jp musashimurayama.tokyo.jp musashino.tokyo.jp nakano.tokyo.jp nerima.tokyo.jp ogasawara.tokyo.jp okutama.tokyo.jp ome.tokyo.jp oshima.tokyo.jp ota.tokyo.jp setagaya.tokyo.jp shibuya.tokyo.jp shinagawa.tokyo.jp shinjuku.tokyo.jp suginami.tokyo.jp sumida.tokyo.jp tachikawa.tokyo.jp taito.tokyo.jp tama.tokyo.jp toshima.tokyo.jp chizu.tottori.jp hino.tottori.jp kawahara.tottori.jp koge.tottori.jp kotoura.tottori.jp misasa.tottori.jp nanbu.tottori.jp nichinan.tottori.jp sakaiminato.tottori.jp tottori.tottori.jp wakasa.tottori.jp yazu.tottori.jp yonago.tottori.jp asahi.toyama.jp fuchu.toyama.jp fukumitsu.toyama.jp funahashi.toyama.jp himi.toyama.jp imizu.toyama.jp inami.toyama.jp johana.toyama.jp kamiichi.toyama.jp kurobe.toyama.jp nakaniikawa.toyama.jp namerikawa.toyama.jp nanto.toyama.jp nyuzen.toyama.jp oyabe.toyama.jp taira.toyama.jp takaoka.toyama.jp tateyama.toyama.jp toga.toyama.jp tonami.toyama.jp toyama.toyama.jp unazuki.toyama.jp uozu.toyama.jp yamada.toyama.jp arida.wakayama.jp aridagawa.wakayama.jp gobo.wakayama.jp hashimoto.wakayama.jp hidaka.wakayama.jp hirogawa.wakayama.jp inami.wakayama.jp iwade.wakayama.jp kainan.wakayama.jp kamitonda.wakayama.jp katsuragi.wakayama.jp kimino.wakayama.jp kinokawa.wakayama.jp kitayama.wakayama.jp koya.wakayama.jp koza.wakayama.jp kozagawa.wakayama.jp kudoyama.wakayama.jp kushimoto.wakayama.jp mihama.wakayama.jp misato.wakayama.jp nachikatsuura.wakayama.jp shingu.wakayama.jp shirahama.wakayama.jp taiji.wakayama.jp tanabe.wakayama.jp wakayama.wakayama.jp yuasa.wakayama.jp yura.wakayama.jp asahi.yamagata.jp funagata.yamagata.jp higashine.yamagata.jp iide.yamagata.jp kahoku.yamagata.jp kaminoyama.yamagata.jp kaneyama.yamagata.jp kawanishi.yamagata.jp mamurogawa.yamagata.jp mikawa.yamagata.jp murayama.yamagata.jp nagai.yamagata.jp nakayama.yamagata.jp nanyo.yamagata.jp nishikawa.yamagata.jp obanazawa.yamagata.jp oe.yamagata.jp oguni.yamagata.jp ohkura.yamagata.jp oishida.yamagata.jp sagae.yamagata.jp sakata.yamagata.jp sakegawa.yamagata.jp shinjo.yamagata.jp shirataka.yamagata.jp shonai.yamagata.jp takahata.yamagata.jp tendo.yamagata.jp tozawa.yamagata.jp tsuruoka.yamagata.jp yamagata.yamagata.jp yamanobe.yamagata.jp yonezawa.yamagata.jp yuza.yamagata.jp abu.yamaguchi.jp hagi.yamaguchi.jp hikari.yamaguchi.jp hofu.yamaguchi.jp iwakuni.yamaguchi.jp kudamatsu.yamaguchi.jp mitou.yamaguchi.jp nagato.yamaguchi.jp oshima.yamaguchi.jp shimonoseki.yamaguchi.jp shunan.yamaguchi.jp tabuse.yamaguchi.jp tokuyama.yamaguchi.jp toyota.yamaguchi.jp ube.yamaguchi.jp yuu.yamaguchi.jp chuo.yamanashi.jp doshi.yamanashi.jp fuefuki.yamanashi.jp fujikawa.yamanashi.jp fujikawaguchiko.yamanashi.jp fujiyoshida.yamanashi.jp hayakawa.yamanashi.jp hokuto.yamanashi.jp ichikawamisato.yamanashi.jp kai.yamanashi.jp kofu.yamanashi.jp koshu.yamanashi.jp kosuge.yamanashi.jp minami-alps.yamanashi.jp minobu.yamanashi.jp nakamichi.yamanashi.jp nanbu.yamanashi.jp narusawa.yamanashi.jp nirasaki.yamanashi.jp nishikatsura.yamanashi.jp oshino.yamanashi.jp otsuki.yamanashi.jp showa.yamanashi.jp tabayama.yamanashi.jp tsuru.yamanashi.jp uenohara.yamanashi.jp yamanakako.yamanashi.jp yamanashi.yamanashi.jp // ke : http://www.kenic.or.ke/index.php?option=com_content&task=view&id=117&Itemid=145 *.ke // kg : http://www.domain.kg/dmn_n.html kg org.kg net.kg com.kg edu.kg gov.kg mil.kg // kh : http://www.mptc.gov.kh/dns_registration.htm *.kh // ki : http://www.ki/dns/index.html ki edu.ki biz.ki net.ki org.ki gov.ki info.ki com.ki // km : http://en.wikipedia.org/wiki/.km // http://www.domaine.km/documents/charte.doc km org.km nom.km gov.km prd.km tm.km edu.km mil.km ass.km com.km // These are only mentioned as proposed suggestions at domaine.km, but // http://en.wikipedia.org/wiki/.km says they're available for registration: coop.km asso.km presse.km medecin.km notaires.km pharmaciens.km veterinaire.km gouv.km // kn : http://en.wikipedia.org/wiki/.kn // http://www.dot.kn/domainRules.html kn net.kn org.kn edu.kn gov.kn // kp : http://www.kcce.kp/en_index.php com.kp edu.kp gov.kp org.kp rep.kp tra.kp // kr : http://en.wikipedia.org/wiki/.kr // see also: http://domain.nida.or.kr/eng/registration.jsp kr ac.kr co.kr es.kr go.kr hs.kr kg.kr mil.kr ms.kr ne.kr or.kr pe.kr re.kr sc.kr // kr geographical names busan.kr chungbuk.kr chungnam.kr daegu.kr daejeon.kr gangwon.kr gwangju.kr gyeongbuk.kr gyeonggi.kr gyeongnam.kr incheon.kr jeju.kr jeonbuk.kr jeonnam.kr seoul.kr ulsan.kr // kw : http://en.wikipedia.org/wiki/.kw *.kw // ky : http://www.icta.ky/da_ky_reg_dom.php // Confirmed by registry 2008-06-17 ky edu.ky gov.ky com.ky org.ky net.ky // kz : http://en.wikipedia.org/wiki/.kz // see also: http://www.nic.kz/rules/index.jsp kz org.kz edu.kz net.kz gov.kz mil.kz com.kz // la : http://en.wikipedia.org/wiki/.la // Submitted by registry 2008-06-10 la int.la net.la info.la edu.la gov.la per.la com.la org.la // lb : http://en.wikipedia.org/wiki/.lb // Submitted by registry 2008-06-17 com.lb edu.lb gov.lb net.lb org.lb // lc : http://en.wikipedia.org/wiki/.lc // see also: http://www.nic.lc/rules.htm lc com.lc net.lc co.lc org.lc edu.lc gov.lc // li : http://en.wikipedia.org/wiki/.li li // lk : http://www.nic.lk/seclevpr.html lk gov.lk sch.lk net.lk int.lk com.lk org.lk edu.lk ngo.lk soc.lk web.lk ltd.lk assn.lk grp.lk hotel.lk // lr : http://psg.com/dns/lr/lr.txt // Submitted by registry 2008-06-17 com.lr edu.lr gov.lr org.lr net.lr // ls : http://en.wikipedia.org/wiki/.ls ls co.ls org.ls // lt : http://en.wikipedia.org/wiki/.lt lt // gov.lt : http://www.gov.lt/index_en.php gov.lt // lu : http://www.dns.lu/en/ lu // lv : http://www.nic.lv/DNS/En/generic.php lv com.lv edu.lv gov.lv org.lv mil.lv id.lv net.lv asn.lv conf.lv // ly : http://www.nic.ly/regulations.php ly com.ly net.ly gov.ly plc.ly edu.ly sch.ly med.ly org.ly id.ly // ma : http://en.wikipedia.org/wiki/.ma // http://www.anrt.ma/fr/admin/download/upload/file_fr782.pdf ma co.ma net.ma gov.ma org.ma ac.ma press.ma // mc : http://www.nic.mc/ mc tm.mc asso.mc // md : http://en.wikipedia.org/wiki/.md md // me : http://en.wikipedia.org/wiki/.me me co.me net.me org.me edu.me ac.me gov.me its.me priv.me // mg : http://www.nic.mg/tarif.htm mg org.mg nom.mg gov.mg prd.mg tm.mg edu.mg mil.mg com.mg // mh : http://en.wikipedia.org/wiki/.mh mh // mil : http://en.wikipedia.org/wiki/.mil mil // mk : http://en.wikipedia.org/wiki/.mk // see also: http://dns.marnet.net.mk/postapka.php mk com.mk org.mk net.mk edu.mk gov.mk inf.mk name.mk // ml : http://www.gobin.info/domainname/ml-template.doc // see also: http://en.wikipedia.org/wiki/.ml ml com.ml edu.ml gouv.ml gov.ml net.ml org.ml presse.ml // mm : http://en.wikipedia.org/wiki/.mm *.mm // mn : http://en.wikipedia.org/wiki/.mn mn gov.mn edu.mn org.mn // mo : http://www.monic.net.mo/ mo com.mo net.mo org.mo edu.mo gov.mo // mobi : http://en.wikipedia.org/wiki/.mobi mobi // mp : http://www.dot.mp/ // Confirmed by registry 2008-06-17 mp // mq : http://en.wikipedia.org/wiki/.mq mq // mr : http://en.wikipedia.org/wiki/.mr mr gov.mr // ms : http://en.wikipedia.org/wiki/.ms ms // mt : https://www.nic.org.mt/dotmt/ *.mt // mu : http://en.wikipedia.org/wiki/.mu mu com.mu net.mu org.mu gov.mu ac.mu co.mu or.mu // museum : http://about.museum/naming/ // http://index.museum/ museum academy.museum agriculture.museum air.museum airguard.museum alabama.museum alaska.museum amber.museum ambulance.museum american.museum americana.museum americanantiques.museum americanart.museum amsterdam.museum and.museum annefrank.museum anthro.museum anthropology.museum antiques.museum aquarium.museum arboretum.museum archaeological.museum archaeology.museum architecture.museum art.museum artanddesign.museum artcenter.museum artdeco.museum arteducation.museum artgallery.museum arts.museum artsandcrafts.museum asmatart.museum assassination.museum assisi.museum association.museum astronomy.museum atlanta.museum austin.museum australia.museum automotive.museum aviation.museum axis.museum badajoz.museum baghdad.museum bahn.museum bale.museum baltimore.museum barcelona.museum baseball.museum basel.museum baths.museum bauern.museum beauxarts.museum beeldengeluid.museum bellevue.museum bergbau.museum berkeley.museum berlin.museum bern.museum bible.museum bilbao.museum bill.museum birdart.museum birthplace.museum bonn.museum boston.museum botanical.museum botanicalgarden.museum botanicgarden.museum botany.museum brandywinevalley.museum brasil.museum bristol.museum british.museum britishcolumbia.museum broadcast.museum brunel.museum brussel.museum brussels.museum bruxelles.museum building.museum burghof.museum bus.museum bushey.museum cadaques.museum california.museum cambridge.museum can.museum canada.museum capebreton.museum carrier.museum cartoonart.museum casadelamoneda.museum castle.museum castres.museum celtic.museum center.museum chattanooga.museum cheltenham.museum chesapeakebay.museum chicago.museum children.museum childrens.museum childrensgarden.museum chiropractic.museum chocolate.museum christiansburg.museum cincinnati.museum cinema.museum circus.museum civilisation.museum civilization.museum civilwar.museum clinton.museum clock.museum coal.museum coastaldefence.museum cody.museum coldwar.museum collection.museum colonialwilliamsburg.museum coloradoplateau.museum columbia.museum columbus.museum communication.museum communications.museum community.museum computer.museum computerhistory.museum comunicações.museum contemporary.museum contemporaryart.museum convent.museum copenhagen.museum corporation.museum correios-e-telecomunicações.museum corvette.museum costume.museum countryestate.museum county.museum crafts.museum cranbrook.museum creation.museum cultural.museum culturalcenter.museum culture.museum cyber.museum cymru.museum dali.museum dallas.museum database.museum ddr.museum decorativearts.museum delaware.museum delmenhorst.museum denmark.museum depot.museum design.museum detroit.museum dinosaur.museum discovery.museum dolls.museum donostia.museum durham.museum eastafrica.museum eastcoast.museum education.museum educational.museum egyptian.museum eisenbahn.museum elburg.museum elvendrell.museum embroidery.museum encyclopedic.museum england.museum entomology.museum environment.museum environmentalconservation.museum epilepsy.museum essex.museum estate.museum ethnology.museum exeter.museum exhibition.museum family.museum farm.museum farmequipment.museum farmers.museum farmstead.museum field.museum figueres.museum filatelia.museum film.museum fineart.museum finearts.museum finland.museum flanders.museum florida.museum force.museum fortmissoula.museum fortworth.museum foundation.museum francaise.museum frankfurt.museum franziskaner.museum freemasonry.museum freiburg.museum fribourg.museum frog.museum fundacio.museum furniture.museum gallery.museum garden.museum gateway.museum geelvinck.museum gemological.museum geology.museum georgia.museum giessen.museum glas.museum glass.museum gorge.museum grandrapids.museum graz.museum guernsey.museum halloffame.museum hamburg.museum handson.museum harvestcelebration.museum hawaii.museum health.museum heimatunduhren.museum hellas.museum helsinki.museum hembygdsforbund.museum heritage.museum histoire.museum historical.museum historicalsociety.museum historichouses.museum historisch.museum historisches.museum history.museum historyofscience.museum horology.museum house.museum humanities.museum illustration.museum imageandsound.museum indian.museum indiana.museum indianapolis.museum indianmarket.museum intelligence.museum interactive.museum iraq.museum iron.museum isleofman.museum jamison.museum jefferson.museum jerusalem.museum jewelry.museum jewish.museum jewishart.museum jfk.museum journalism.museum judaica.museum judygarland.museum juedisches.museum juif.museum karate.museum karikatur.museum kids.museum koebenhavn.museum koeln.museum kunst.museum kunstsammlung.museum kunstunddesign.museum labor.museum labour.museum lajolla.museum lancashire.museum landes.museum lans.museum läns.museum larsson.museum lewismiller.museum lincoln.museum linz.museum living.museum livinghistory.museum localhistory.museum london.museum losangeles.museum louvre.museum loyalist.museum lucerne.museum luxembourg.museum luzern.museum mad.museum madrid.museum mallorca.museum manchester.museum mansion.museum mansions.museum manx.museum marburg.museum maritime.museum maritimo.museum maryland.museum marylhurst.museum media.museum medical.museum medizinhistorisches.museum meeres.museum memorial.museum mesaverde.museum michigan.museum midatlantic.museum military.museum mill.museum miners.museum mining.museum minnesota.museum missile.museum missoula.museum modern.museum moma.museum money.museum monmouth.museum monticello.museum montreal.museum moscow.museum motorcycle.museum muenchen.museum muenster.museum mulhouse.museum muncie.museum museet.museum museumcenter.museum museumvereniging.museum music.museum national.museum nationalfirearms.museum nationalheritage.museum nativeamerican.museum naturalhistory.museum naturalhistorymuseum.museum naturalsciences.museum nature.museum naturhistorisches.museum natuurwetenschappen.museum naumburg.museum naval.museum nebraska.museum neues.museum newhampshire.museum newjersey.museum newmexico.museum newport.museum newspaper.museum newyork.museum niepce.museum norfolk.museum north.museum nrw.museum nuernberg.museum nuremberg.museum nyc.museum nyny.museum oceanographic.museum oceanographique.museum omaha.museum online.museum ontario.museum openair.museum oregon.museum oregontrail.museum otago.museum oxford.museum pacific.museum paderborn.museum palace.museum paleo.museum palmsprings.museum panama.museum paris.museum pasadena.museum pharmacy.museum philadelphia.museum philadelphiaarea.museum philately.museum phoenix.museum photography.museum pilots.museum pittsburgh.museum planetarium.museum plantation.museum plants.museum plaza.museum portal.museum portland.museum portlligat.museum posts-and-telecommunications.museum preservation.museum presidio.museum press.museum project.museum public.museum pubol.museum quebec.museum railroad.museum railway.museum research.museum resistance.museum riodejaneiro.museum rochester.museum rockart.museum roma.museum russia.museum saintlouis.museum salem.museum salvadordali.museum salzburg.museum sandiego.museum sanfrancisco.museum santabarbara.museum santacruz.museum santafe.museum saskatchewan.museum satx.museum savannahga.museum schlesisches.museum schoenbrunn.museum schokoladen.museum school.museum schweiz.museum science.museum scienceandhistory.museum scienceandindustry.museum sciencecenter.museum sciencecenters.museum science-fiction.museum sciencehistory.museum sciences.museum sciencesnaturelles.museum scotland.museum seaport.museum settlement.museum settlers.museum shell.museum sherbrooke.museum sibenik.museum silk.museum ski.museum skole.museum society.museum sologne.museum soundandvision.museum southcarolina.museum southwest.museum space.museum spy.museum square.museum stadt.museum stalbans.museum starnberg.museum state.museum stateofdelaware.museum station.museum steam.museum steiermark.museum stjohn.museum stockholm.museum stpetersburg.museum stuttgart.museum suisse.museum surgeonshall.museum surrey.museum svizzera.museum sweden.museum sydney.museum tank.museum tcm.museum technology.museum telekommunikation.museum television.museum texas.museum textile.museum theater.museum time.museum timekeeping.museum topology.museum torino.museum touch.museum town.museum transport.museum tree.museum trolley.museum trust.museum trustee.museum uhren.museum ulm.museum undersea.museum university.museum usa.museum usantiques.museum usarts.museum uscountryestate.museum usculture.museum usdecorativearts.museum usgarden.museum ushistory.museum ushuaia.museum uslivinghistory.museum utah.museum uvic.museum valley.museum vantaa.museum versailles.museum viking.museum village.museum virginia.museum virtual.museum virtuel.museum vlaanderen.museum volkenkunde.museum wales.museum wallonie.museum war.museum washingtondc.museum watchandclock.museum watch-and-clock.museum western.museum westfalen.museum whaling.museum wildlife.museum williamsburg.museum windmill.museum workshop.museum york.museum yorkshire.museum yosemite.museum youth.museum zoological.museum zoology.museum ירושלים.museum иком.museum // mv : http://en.wikipedia.org/wiki/.mv // "mv" included because, contra Wikipedia, google.mv exists. mv aero.mv biz.mv com.mv coop.mv edu.mv gov.mv info.mv int.mv mil.mv museum.mv name.mv net.mv org.mv pro.mv // mw : http://www.registrar.mw/ mw ac.mw biz.mw co.mw com.mw coop.mw edu.mw gov.mw int.mw museum.mw net.mw org.mw // mx : http://www.nic.mx/ // Submitted by registry 2008-06-19 mx com.mx org.mx gob.mx edu.mx net.mx // my : http://www.mynic.net.my/ my com.my net.my org.my gov.my edu.my mil.my name.my // mz : http://www.gobin.info/domainname/mz-template.doc *.mz !teledata.mz // na : http://www.na-nic.com.na/ // http://www.info.na/domain/ na info.na pro.na name.na school.na or.na dr.na us.na mx.na ca.na in.na cc.na tv.na ws.na mobi.na co.na com.na org.na // name : has 2nd-level tlds, but there's no list of them name // nc : http://www.cctld.nc/ nc asso.nc // ne : http://en.wikipedia.org/wiki/.ne ne // net : http://en.wikipedia.org/wiki/.net net // nf : http://en.wikipedia.org/wiki/.nf nf com.nf net.nf per.nf rec.nf web.nf arts.nf firm.nf info.nf other.nf store.nf // ng : http://psg.com/dns/ng/ // Submitted by registry 2008-06-17 ac.ng com.ng edu.ng gov.ng net.ng org.ng // ni : http://www.nic.ni/dominios.htm *.ni // nl : http://www.domain-registry.nl/ace.php/c,728,122,,,,Home.html // Confirmed by registry (with technical // reservations) 2008-06-08 nl // BV.nl will be a registry for dutch BV's (besloten vennootschap) bv.nl // no : http://www.norid.no/regelverk/index.en.html // The Norwegian registry has declined to notify us of updates. The web pages // referenced below are the official source of the data. There is also an // announce mailing list: // https://postlister.uninett.no/sympa/info/norid-diskusjon no // Norid generic domains : http://www.norid.no/regelverk/vedlegg-c.en.html fhs.no vgs.no fylkesbibl.no folkebibl.no museum.no idrett.no priv.no // Non-Norid generic domains : http://www.norid.no/regelverk/vedlegg-d.en.html mil.no stat.no dep.no kommune.no herad.no // no geographical names : http://www.norid.no/regelverk/vedlegg-b.en.html // counties aa.no ah.no bu.no fm.no hl.no hm.no jan-mayen.no mr.no nl.no nt.no of.no ol.no oslo.no rl.no sf.no st.no svalbard.no tm.no tr.no va.no vf.no // primary and lower secondary schools per county gs.aa.no gs.ah.no gs.bu.no gs.fm.no gs.hl.no gs.hm.no gs.jan-mayen.no gs.mr.no gs.nl.no gs.nt.no gs.of.no gs.ol.no gs.oslo.no gs.rl.no gs.sf.no gs.st.no gs.svalbard.no gs.tm.no gs.tr.no gs.va.no gs.vf.no // cities akrehamn.no åkrehamn.no algard.no ålgård.no arna.no brumunddal.no bryne.no bronnoysund.no brønnøysund.no drobak.no drøbak.no egersund.no fetsund.no floro.no florø.no fredrikstad.no hokksund.no honefoss.no hønefoss.no jessheim.no jorpeland.no jørpeland.no kirkenes.no kopervik.no krokstadelva.no langevag.no langevåg.no leirvik.no mjondalen.no mjøndalen.no mo-i-rana.no mosjoen.no mosjøen.no nesoddtangen.no orkanger.no osoyro.no osøyro.no raholt.no råholt.no sandnessjoen.no sandnessjøen.no skedsmokorset.no slattum.no spjelkavik.no stathelle.no stavern.no stjordalshalsen.no stjørdalshalsen.no tananger.no tranby.no vossevangen.no // communities afjord.no åfjord.no agdenes.no al.no ål.no alesund.no ålesund.no alstahaug.no alta.no áltá.no alaheadju.no álaheadju.no alvdal.no amli.no åmli.no amot.no åmot.no andebu.no andoy.no andøy.no andasuolo.no ardal.no årdal.no aremark.no arendal.no ås.no aseral.no åseral.no asker.no askim.no askvoll.no askoy.no askøy.no asnes.no åsnes.no audnedaln.no aukra.no aure.no aurland.no aurskog-holand.no aurskog-høland.no austevoll.no austrheim.no averoy.no averøy.no balestrand.no ballangen.no balat.no bálát.no balsfjord.no bahccavuotna.no báhccavuotna.no bamble.no bardu.no beardu.no beiarn.no bajddar.no bájddar.no baidar.no báidár.no berg.no bergen.no berlevag.no berlevåg.no bearalvahki.no bearalváhki.no bindal.no birkenes.no bjarkoy.no bjarkøy.no bjerkreim.no bjugn.no bodo.no bodø.no badaddja.no bådåddjå.no budejju.no bokn.no bremanger.no bronnoy.no brønnøy.no bygland.no bykle.no barum.no bærum.no bo.telemark.no bø.telemark.no bo.nordland.no bø.nordland.no bievat.no bievát.no bomlo.no bømlo.no batsfjord.no båtsfjord.no bahcavuotna.no báhcavuotna.no dovre.no drammen.no drangedal.no dyroy.no dyrøy.no donna.no dønna.no eid.no eidfjord.no eidsberg.no eidskog.no eidsvoll.no eigersund.no elverum.no enebakk.no engerdal.no etne.no etnedal.no evenes.no evenassi.no evenášši.no evje-og-hornnes.no farsund.no fauske.no fuossko.no fuoisku.no fedje.no fet.no finnoy.no finnøy.no fitjar.no fjaler.no fjell.no flakstad.no flatanger.no flekkefjord.no flesberg.no flora.no fla.no flå.no folldal.no forsand.no fosnes.no frei.no frogn.no froland.no frosta.no frana.no fræna.no froya.no frøya.no fusa.no fyresdal.no forde.no førde.no gamvik.no gangaviika.no gáŋgaviika.no gaular.no gausdal.no gildeskal.no gildeskål.no giske.no gjemnes.no gjerdrum.no gjerstad.no gjesdal.no gjovik.no gjøvik.no gloppen.no gol.no gran.no grane.no granvin.no gratangen.no grimstad.no grong.no kraanghke.no kråanghke.no grue.no gulen.no hadsel.no halden.no halsa.no hamar.no hamaroy.no habmer.no hábmer.no hapmir.no hápmir.no hammerfest.no hammarfeasta.no hámmárfeasta.no haram.no hareid.no harstad.no hasvik.no aknoluokta.no ákŋoluokta.no hattfjelldal.no aarborte.no haugesund.no hemne.no hemnes.no hemsedal.no heroy.more-og-romsdal.no herøy.møre-og-romsdal.no heroy.nordland.no herøy.nordland.no hitra.no hjartdal.no hjelmeland.no hobol.no hobøl.no hof.no hol.no hole.no holmestrand.no holtalen.no holtålen.no hornindal.no horten.no hurdal.no hurum.no hvaler.no hyllestad.no hagebostad.no hægebostad.no hoyanger.no høyanger.no hoylandet.no høylandet.no ha.no hå.no ibestad.no inderoy.no inderøy.no iveland.no jevnaker.no jondal.no jolster.no jølster.no karasjok.no karasjohka.no kárášjohka.no karlsoy.no galsa.no gálsá.no karmoy.no karmøy.no kautokeino.no guovdageaidnu.no klepp.no klabu.no klæbu.no kongsberg.no kongsvinger.no kragero.no kragerø.no kristiansand.no kristiansund.no krodsherad.no krødsherad.no kvalsund.no rahkkeravju.no ráhkkerávju.no kvam.no kvinesdal.no kvinnherad.no kviteseid.no kvitsoy.no kvitsøy.no kvafjord.no kvæfjord.no giehtavuoatna.no kvanangen.no kvænangen.no navuotna.no návuotna.no kafjord.no kåfjord.no gaivuotna.no gáivuotna.no larvik.no lavangen.no lavagis.no loabat.no loabát.no lebesby.no davvesiida.no leikanger.no leirfjord.no leka.no leksvik.no lenvik.no leangaviika.no leaŋgaviika.no lesja.no levanger.no lier.no lierne.no lillehammer.no lillesand.no lindesnes.no lindas.no lindås.no lom.no loppa.no lahppi.no láhppi.no lund.no lunner.no luroy.no lurøy.no luster.no lyngdal.no lyngen.no ivgu.no lardal.no lerdal.no lærdal.no lodingen.no lødingen.no lorenskog.no lørenskog.no loten.no løten.no malvik.no masoy.no måsøy.no muosat.no muosát.no mandal.no marker.no marnardal.no masfjorden.no meland.no meldal.no melhus.no meloy.no meløy.no meraker.no meråker.no moareke.no moåreke.no midsund.no midtre-gauldal.no modalen.no modum.no molde.no moskenes.no moss.no mosvik.no malselv.no målselv.no malatvuopmi.no málatvuopmi.no namdalseid.no aejrie.no namsos.no namsskogan.no naamesjevuemie.no nååmesjevuemie.no laakesvuemie.no nannestad.no narvik.no narviika.no naustdal.no nedre-eiker.no nes.akershus.no nes.buskerud.no nesna.no nesodden.no nesseby.no unjarga.no unjárga.no nesset.no nissedal.no nittedal.no nord-aurdal.no nord-fron.no nord-odal.no norddal.no nordkapp.no davvenjarga.no davvenjárga.no nordre-land.no nordreisa.no raisa.no ráisa.no nore-og-uvdal.no notodden.no naroy.no nærøy.no notteroy.no nøtterøy.no odda.no oksnes.no øksnes.no oppdal.no oppegard.no oppegård.no orkdal.no orland.no ørland.no orskog.no ørskog.no orsta.no ørsta.no os.hedmark.no os.hordaland.no osen.no osteroy.no osterøy.no ostre-toten.no østre-toten.no overhalla.no ovre-eiker.no øvre-eiker.no oyer.no øyer.no oygarden.no øygarden.no oystre-slidre.no øystre-slidre.no porsanger.no porsangu.no porsáŋgu.no porsgrunn.no radoy.no radøy.no rakkestad.no rana.no ruovat.no randaberg.no rauma.no rendalen.no rennebu.no rennesoy.no rennesøy.no rindal.no ringebu.no ringerike.no ringsaker.no rissa.no risor.no risør.no roan.no rollag.no rygge.no ralingen.no rælingen.no rodoy.no rødøy.no romskog.no rømskog.no roros.no røros.no rost.no røst.no royken.no røyken.no royrvik.no røyrvik.no rade.no råde.no salangen.no siellak.no saltdal.no salat.no sálát.no sálat.no samnanger.no sande.more-og-romsdal.no sande.møre-og-romsdal.no sande.vestfold.no sandefjord.no sandnes.no sandoy.no sandøy.no sarpsborg.no sauda.no sauherad.no sel.no selbu.no selje.no seljord.no sigdal.no siljan.no sirdal.no skaun.no skedsmo.no ski.no skien.no skiptvet.no skjervoy.no skjervøy.no skierva.no skiervá.no skjak.no skjåk.no skodje.no skanland.no skånland.no skanit.no skánit.no smola.no smøla.no snillfjord.no snasa.no snåsa.no snoasa.no snaase.no snåase.no sogndal.no sokndal.no sola.no solund.no songdalen.no sortland.no spydeberg.no stange.no stavanger.no steigen.no steinkjer.no stjordal.no stjørdal.no stokke.no stor-elvdal.no stord.no stordal.no storfjord.no omasvuotna.no strand.no stranda.no stryn.no sula.no suldal.no sund.no sunndal.no surnadal.no sveio.no svelvik.no sykkylven.no sogne.no søgne.no somna.no sømna.no sondre-land.no søndre-land.no sor-aurdal.no sør-aurdal.no sor-fron.no sør-fron.no sor-odal.no sør-odal.no sor-varanger.no sør-varanger.no matta-varjjat.no mátta-várjjat.no sorfold.no sørfold.no sorreisa.no sørreisa.no sorum.no sørum.no tana.no deatnu.no time.no tingvoll.no tinn.no tjeldsund.no dielddanuorri.no tjome.no tjøme.no tokke.no tolga.no torsken.no tranoy.no tranøy.no tromso.no tromsø.no tromsa.no romsa.no trondheim.no troandin.no trysil.no trana.no træna.no trogstad.no trøgstad.no tvedestrand.no tydal.no tynset.no tysfjord.no divtasvuodna.no divttasvuotna.no tysnes.no tysvar.no tysvær.no tonsberg.no tønsberg.no ullensaker.no ullensvang.no ulvik.no utsira.no vadso.no vadsø.no cahcesuolo.no čáhcesuolo.no vaksdal.no valle.no vang.no vanylven.no vardo.no vardø.no varggat.no várggát.no vefsn.no vaapste.no vega.no vegarshei.no vegårshei.no vennesla.no verdal.no verran.no vestby.no vestnes.no vestre-slidre.no vestre-toten.no vestvagoy.no vestvågøy.no vevelstad.no vik.no vikna.no vindafjord.no volda.no voss.no varoy.no værøy.no vagan.no vågan.no voagat.no vagsoy.no vågsøy.no vaga.no vågå.no valer.ostfold.no våler.østfold.no valer.hedmark.no våler.hedmark.no // np : http://www.mos.com.np/register.html *.np // nr : http://cenpac.net.nr/dns/index.html // Confirmed by registry 2008-06-17 nr biz.nr info.nr gov.nr edu.nr org.nr net.nr com.nr // nu : http://en.wikipedia.org/wiki/.nu nu // nz : http://en.wikipedia.org/wiki/.nz *.nz // om : http://en.wikipedia.org/wiki/.om *.om !mediaphone.om !nawrastelecom.om !nawras.om !omanmobile.om !omanpost.om !omantel.om !rakpetroleum.om !siemens.om !songfest.om !statecouncil.om // org : http://en.wikipedia.org/wiki/.org org // pa : http://www.nic.pa/ // Some additional second level "domains" resolve directly as hostnames, such as // pannet.pa, so we add a rule for "pa". pa ac.pa gob.pa com.pa org.pa sld.pa edu.pa net.pa ing.pa abo.pa med.pa nom.pa // pe : https://www.nic.pe/InformeFinalComision.pdf pe edu.pe gob.pe nom.pe mil.pe org.pe com.pe net.pe // pf : http://www.gobin.info/domainname/formulaire-pf.pdf pf com.pf org.pf edu.pf // pg : http://en.wikipedia.org/wiki/.pg *.pg // ph : http://www.domains.ph/FAQ2.asp // Submitted by registry 2008-06-13 ph com.ph net.ph org.ph gov.ph edu.ph ngo.ph mil.ph i.ph // pk : http://pk5.pknic.net.pk/pk5/msgNamepk.PK pk com.pk net.pk edu.pk org.pk fam.pk biz.pk web.pk gov.pk gob.pk gok.pk gon.pk gop.pk gos.pk info.pk // pl : http://www.dns.pl/english/ pl // NASK functional domains (nask.pl / dns.pl) : http://www.dns.pl/english/dns-funk.html aid.pl agro.pl atm.pl auto.pl biz.pl com.pl edu.pl gmina.pl gsm.pl info.pl mail.pl miasta.pl media.pl mil.pl net.pl nieruchomosci.pl nom.pl org.pl pc.pl powiat.pl priv.pl realestate.pl rel.pl sex.pl shop.pl sklep.pl sos.pl szkola.pl targi.pl tm.pl tourism.pl travel.pl turystyka.pl // ICM functional domains (icm.edu.pl) 6bone.pl art.pl mbone.pl // Government domains (administred by ippt.gov.pl) gov.pl uw.gov.pl um.gov.pl ug.gov.pl upow.gov.pl starostwo.gov.pl so.gov.pl sr.gov.pl po.gov.pl pa.gov.pl // other functional domains ngo.pl irc.pl usenet.pl // NASK geographical domains : http://www.dns.pl/english/dns-regiony.html augustow.pl babia-gora.pl bedzin.pl beskidy.pl bialowieza.pl bialystok.pl bielawa.pl bieszczady.pl boleslawiec.pl bydgoszcz.pl bytom.pl cieszyn.pl czeladz.pl czest.pl dlugoleka.pl elblag.pl elk.pl glogow.pl gniezno.pl gorlice.pl grajewo.pl ilawa.pl jaworzno.pl jelenia-gora.pl jgora.pl kalisz.pl kazimierz-dolny.pl karpacz.pl kartuzy.pl kaszuby.pl katowice.pl kepno.pl ketrzyn.pl klodzko.pl kobierzyce.pl kolobrzeg.pl konin.pl konskowola.pl kutno.pl lapy.pl lebork.pl legnica.pl lezajsk.pl limanowa.pl lomza.pl lowicz.pl lubin.pl lukow.pl malbork.pl malopolska.pl mazowsze.pl mazury.pl mielec.pl mielno.pl mragowo.pl naklo.pl nowaruda.pl nysa.pl olawa.pl olecko.pl olkusz.pl olsztyn.pl opoczno.pl opole.pl ostroda.pl ostroleka.pl ostrowiec.pl ostrowwlkp.pl pila.pl pisz.pl podhale.pl podlasie.pl polkowice.pl pomorze.pl pomorskie.pl prochowice.pl pruszkow.pl przeworsk.pl pulawy.pl radom.pl rawa-maz.pl rybnik.pl rzeszow.pl sanok.pl sejny.pl siedlce.pl slask.pl slupsk.pl sosnowiec.pl stalowa-wola.pl skoczow.pl starachowice.pl stargard.pl suwalki.pl swidnica.pl swiebodzin.pl swinoujscie.pl szczecin.pl szczytno.pl tarnobrzeg.pl tgory.pl turek.pl tychy.pl ustka.pl walbrzych.pl warmia.pl warszawa.pl waw.pl wegrow.pl wielun.pl wlocl.pl wloclawek.pl wodzislaw.pl wolomin.pl wroclaw.pl zachpomor.pl zagan.pl zarow.pl zgora.pl zgorzelec.pl // TASK geographical domains (www.task.gda.pl/uslugi/dns) gda.pl gdansk.pl gdynia.pl med.pl sopot.pl // other geographical domains gliwice.pl krakow.pl poznan.pl wroc.pl zakopane.pl // pm : http://www.afnic.fr/medias/documents/AFNIC-naming-policy2012.pdf pm // pn : http://www.government.pn/PnRegistry/policies.htm pn gov.pn co.pn org.pn edu.pn net.pn // post : http://en.wikipedia.org/wiki/.post post // pr : http://www.nic.pr/index.asp?f=1 pr com.pr net.pr org.pr gov.pr edu.pr isla.pr pro.pr biz.pr info.pr name.pr // these aren't mentioned on nic.pr, but on http://en.wikipedia.org/wiki/.pr est.pr prof.pr ac.pr // pro : http://www.nic.pro/support_faq.htm pro aca.pro bar.pro cpa.pro jur.pro law.pro med.pro eng.pro // ps : http://en.wikipedia.org/wiki/.ps // http://www.nic.ps/registration/policy.html#reg ps edu.ps gov.ps sec.ps plo.ps com.ps org.ps net.ps // pt : http://online.dns.pt/dns/start_dns pt net.pt gov.pt org.pt edu.pt int.pt publ.pt com.pt nome.pt // pw : http://en.wikipedia.org/wiki/.pw pw co.pw ne.pw or.pw ed.pw go.pw belau.pw // py : http://www.nic.py/pautas.html#seccion_9 // Confirmed by registry 2012-10-03 py com.py coop.py edu.py gov.py mil.py net.py org.py // qa : http://domains.qa/en/ qa com.qa edu.qa gov.qa mil.qa name.qa net.qa org.qa sch.qa // re : http://www.afnic.re/obtenir/chartes/nommage-re/annexe-descriptifs re com.re asso.re nom.re // ro : http://www.rotld.ro/ ro com.ro org.ro tm.ro nt.ro nom.ro info.ro rec.ro arts.ro firm.ro store.ro www.ro // rs : http://en.wikipedia.org/wiki/.rs rs co.rs org.rs edu.rs ac.rs gov.rs in.rs // ru : http://www.cctld.ru/ru/docs/aktiv_8.php // Industry domains ru ac.ru com.ru edu.ru int.ru net.ru org.ru pp.ru // Geographical domains adygeya.ru altai.ru amur.ru arkhangelsk.ru astrakhan.ru bashkiria.ru belgorod.ru bir.ru bryansk.ru buryatia.ru cbg.ru chel.ru chelyabinsk.ru chita.ru chukotka.ru chuvashia.ru dagestan.ru dudinka.ru e-burg.ru grozny.ru irkutsk.ru ivanovo.ru izhevsk.ru jar.ru joshkar-ola.ru kalmykia.ru kaluga.ru kamchatka.ru karelia.ru kazan.ru kchr.ru kemerovo.ru khabarovsk.ru khakassia.ru khv.ru kirov.ru koenig.ru komi.ru kostroma.ru krasnoyarsk.ru kuban.ru kurgan.ru kursk.ru lipetsk.ru magadan.ru mari.ru mari-el.ru marine.ru mordovia.ru mosreg.ru msk.ru murmansk.ru nalchik.ru nnov.ru nov.ru novosibirsk.ru nsk.ru omsk.ru orenburg.ru oryol.ru palana.ru penza.ru perm.ru pskov.ru ptz.ru rnd.ru ryazan.ru sakhalin.ru samara.ru saratov.ru simbirsk.ru smolensk.ru spb.ru stavropol.ru stv.ru surgut.ru tambov.ru tatarstan.ru tom.ru tomsk.ru tsaritsyn.ru tsk.ru tula.ru tuva.ru tver.ru tyumen.ru udm.ru udmurtia.ru ulan-ude.ru vladikavkaz.ru vladimir.ru vladivostok.ru volgograd.ru vologda.ru voronezh.ru vrn.ru vyatka.ru yakutia.ru yamal.ru yaroslavl.ru yekaterinburg.ru yuzhno-sakhalinsk.ru // More geographical domains amursk.ru baikal.ru cmw.ru fareast.ru jamal.ru kms.ru k-uralsk.ru kustanai.ru kuzbass.ru magnitka.ru mytis.ru nakhodka.ru nkz.ru norilsk.ru oskol.ru pyatigorsk.ru rubtsovsk.ru snz.ru syzran.ru vdonsk.ru zgrad.ru // State domains gov.ru mil.ru // Technical domains test.ru // rw : http://www.nic.rw/cgi-bin/policy.pl rw gov.rw net.rw edu.rw ac.rw com.rw co.rw int.rw mil.rw gouv.rw // sa : http://www.nic.net.sa/ sa com.sa net.sa org.sa gov.sa med.sa pub.sa edu.sa sch.sa // sb : http://www.sbnic.net.sb/ // Submitted by registry 2008-06-08 sb com.sb edu.sb gov.sb net.sb org.sb // sc : http://www.nic.sc/ sc com.sc gov.sc net.sc org.sc edu.sc // sd : http://www.isoc.sd/sudanic.isoc.sd/billing_pricing.htm // Submitted by registry 2008-06-17 sd com.sd net.sd org.sd edu.sd med.sd tv.sd gov.sd info.sd // se : http://en.wikipedia.org/wiki/.se // Submitted by registry 2008-06-24 se a.se ac.se b.se bd.se brand.se c.se d.se e.se f.se fh.se fhsk.se fhv.se g.se h.se i.se k.se komforb.se kommunalforbund.se komvux.se l.se lanbib.se m.se n.se naturbruksgymn.se o.se org.se p.se parti.se pp.se press.se r.se s.se sshn.se t.se tm.se u.se w.se x.se y.se z.se // sg : http://www.nic.net.sg/page/registration-policies-procedures-and-guidelines sg com.sg net.sg org.sg gov.sg edu.sg per.sg // sh : http://www.nic.sh/registrar.html sh com.sh net.sh gov.sh org.sh mil.sh // si : http://en.wikipedia.org/wiki/.si si // sj : No registrations at this time. // Submitted by registry 2008-06-16 // sk : http://en.wikipedia.org/wiki/.sk // list of 2nd level domains ? sk // sl : http://www.nic.sl // Submitted by registry 2008-06-12 sl com.sl net.sl edu.sl gov.sl org.sl // sm : http://en.wikipedia.org/wiki/.sm sm // sn : http://en.wikipedia.org/wiki/.sn sn art.sn com.sn edu.sn gouv.sn org.sn perso.sn univ.sn // so : http://www.soregistry.com/ so com.so net.so org.so // sr : http://en.wikipedia.org/wiki/.sr sr // st : http://www.nic.st/html/policyrules/ st co.st com.st consulado.st edu.st embaixada.st gov.st mil.st net.st org.st principe.st saotome.st store.st // su : http://en.wikipedia.org/wiki/.su su // sv : http://www.svnet.org.sv/svpolicy.html *.sv // sx : http://en.wikipedia.org/wiki/.sx // Confirmed by registry 2012-05-31 sx gov.sx // sy : http://en.wikipedia.org/wiki/.sy // see also: http://www.gobin.info/domainname/sy.doc sy edu.sy gov.sy net.sy mil.sy com.sy org.sy // sz : http://en.wikipedia.org/wiki/.sz // http://www.sispa.org.sz/ sz co.sz ac.sz org.sz // tc : http://en.wikipedia.org/wiki/.tc tc // td : http://en.wikipedia.org/wiki/.td td // tel: http://en.wikipedia.org/wiki/.tel // http://www.telnic.org/ tel // tf : http://en.wikipedia.org/wiki/.tf tf // tg : http://en.wikipedia.org/wiki/.tg // http://www.nic.tg/ tg // th : http://en.wikipedia.org/wiki/.th // Submitted by registry 2008-06-17 th ac.th co.th go.th in.th mi.th net.th or.th // tj : http://www.nic.tj/policy.html tj ac.tj biz.tj co.tj com.tj edu.tj go.tj gov.tj int.tj mil.tj name.tj net.tj nic.tj org.tj test.tj web.tj // tk : http://en.wikipedia.org/wiki/.tk tk // tl : http://en.wikipedia.org/wiki/.tl tl gov.tl // tm : http://www.nic.tm/local.html tm com.tm co.tm org.tm net.tm nom.tm gov.tm mil.tm edu.tm // tn : http://en.wikipedia.org/wiki/.tn // http://whois.ati.tn/ tn com.tn ens.tn fin.tn gov.tn ind.tn intl.tn nat.tn net.tn org.tn info.tn perso.tn tourism.tn edunet.tn rnrt.tn rns.tn rnu.tn mincom.tn agrinet.tn defense.tn turen.tn // to : http://en.wikipedia.org/wiki/.to // Submitted by registry 2008-06-17 to com.to gov.to net.to org.to edu.to mil.to // tr : http://en.wikipedia.org/wiki/.tr *.tr !nic.tr // Used by government in the TRNC // http://en.wikipedia.org/wiki/.nc.tr gov.nc.tr // travel : http://en.wikipedia.org/wiki/.travel travel // tt : http://www.nic.tt/ tt co.tt com.tt org.tt net.tt biz.tt info.tt pro.tt int.tt coop.tt jobs.tt mobi.tt travel.tt museum.tt aero.tt name.tt gov.tt edu.tt // tv : http://en.wikipedia.org/wiki/.tv // Not listing any 2LDs as reserved since none seem to exist in practice, // Wikipedia notwithstanding. tv // tw : http://en.wikipedia.org/wiki/.tw tw edu.tw gov.tw mil.tw com.tw net.tw org.tw idv.tw game.tw ebiz.tw club.tw 網路.tw 組織.tw 商業.tw // tz : http://www.tznic.or.tz/index.php/domains // Confirmed by registry 2013-01-22 ac.tz co.tz go.tz hotel.tz info.tz me.tz mil.tz mobi.tz ne.tz or.tz sc.tz tv.tz // ua : https://hostmaster.ua/policy/?ua // Submitted by registry 2012-04-27 ua // ua 2LD com.ua edu.ua gov.ua in.ua net.ua org.ua // ua geographic names // https://hostmaster.ua/2ld/ cherkassy.ua cherkasy.ua chernigov.ua chernihiv.ua chernivtsi.ua chernovtsy.ua ck.ua cn.ua cr.ua crimea.ua cv.ua dn.ua dnepropetrovsk.ua dnipropetrovsk.ua dominic.ua donetsk.ua dp.ua if.ua ivano-frankivsk.ua kh.ua kharkiv.ua kharkov.ua kherson.ua khmelnitskiy.ua khmelnytskyi.ua kiev.ua kirovograd.ua km.ua kr.ua krym.ua ks.ua kv.ua kyiv.ua lg.ua lt.ua lugansk.ua lutsk.ua lv.ua lviv.ua mk.ua mykolaiv.ua nikolaev.ua od.ua odesa.ua odessa.ua pl.ua poltava.ua rivne.ua rovno.ua rv.ua sb.ua sebastopol.ua sevastopol.ua sm.ua sumy.ua te.ua ternopil.ua uz.ua uzhgorod.ua vinnica.ua vinnytsia.ua vn.ua volyn.ua yalta.ua zaporizhzhe.ua zaporizhzhia.ua zhitomir.ua zhytomyr.ua zp.ua zt.ua // Private registries in .ua co.ua pp.ua // ug : https://www.registry.co.ug/ ug co.ug or.ug ac.ug sc.ug go.ug ne.ug com.ug org.ug // uk : http://en.wikipedia.org/wiki/.uk // Submitted by registry 2012-10-02 // and tweaked by us pending further consultation. *.uk *.sch.uk !bl.uk !british-library.uk !jet.uk !mod.uk !national-library-scotland.uk !nel.uk !nic.uk !nls.uk !parliament.uk // us : http://en.wikipedia.org/wiki/.us us dni.us fed.us isa.us kids.us nsn.us // us geographic names ak.us al.us ar.us as.us az.us ca.us co.us ct.us dc.us de.us fl.us ga.us gu.us hi.us ia.us id.us il.us in.us ks.us ky.us la.us ma.us md.us me.us mi.us mn.us mo.us ms.us mt.us nc.us nd.us ne.us nh.us nj.us nm.us nv.us ny.us oh.us ok.us or.us pa.us pr.us ri.us sc.us sd.us tn.us tx.us ut.us vi.us vt.us va.us wa.us wi.us wv.us wy.us // The registrar notes several more specific domains available in each state, // such as state.*.us, dst.*.us, etc., but resolution of these is somewhat // haphazard; in some states these domains resolve as addresses, while in others // only subdomains are available, or even nothing at all. We include the // most common ones where it's clear that different sites are different // entities. k12.ak.us k12.al.us k12.ar.us k12.as.us k12.az.us k12.ca.us k12.co.us k12.ct.us k12.dc.us k12.de.us k12.fl.us k12.ga.us k12.gu.us // k12.hi.us Hawaii has a state-wide DOE login: bug 614565 k12.ia.us k12.id.us k12.il.us k12.in.us k12.ks.us k12.ky.us k12.la.us k12.ma.us k12.md.us k12.me.us k12.mi.us k12.mn.us k12.mo.us k12.ms.us k12.mt.us k12.nc.us k12.nd.us k12.ne.us k12.nh.us k12.nj.us k12.nm.us k12.nv.us k12.ny.us k12.oh.us k12.ok.us k12.or.us k12.pa.us k12.pr.us k12.ri.us k12.sc.us k12.sd.us k12.tn.us k12.tx.us k12.ut.us k12.vi.us k12.vt.us k12.va.us k12.wa.us k12.wi.us k12.wv.us k12.wy.us cc.ak.us cc.al.us cc.ar.us cc.as.us cc.az.us cc.ca.us cc.co.us cc.ct.us cc.dc.us cc.de.us cc.fl.us cc.ga.us cc.gu.us cc.hi.us cc.ia.us cc.id.us cc.il.us cc.in.us cc.ks.us cc.ky.us cc.la.us cc.ma.us cc.md.us cc.me.us cc.mi.us cc.mn.us cc.mo.us cc.ms.us cc.mt.us cc.nc.us cc.nd.us cc.ne.us cc.nh.us cc.nj.us cc.nm.us cc.nv.us cc.ny.us cc.oh.us cc.ok.us cc.or.us cc.pa.us cc.pr.us cc.ri.us cc.sc.us cc.sd.us cc.tn.us cc.tx.us cc.ut.us cc.vi.us cc.vt.us cc.va.us cc.wa.us cc.wi.us cc.wv.us cc.wy.us lib.ak.us lib.al.us lib.ar.us lib.as.us lib.az.us lib.ca.us lib.co.us lib.ct.us lib.dc.us lib.de.us lib.fl.us lib.ga.us lib.gu.us lib.hi.us lib.ia.us lib.id.us lib.il.us lib.in.us lib.ks.us lib.ky.us lib.la.us lib.ma.us lib.md.us lib.me.us lib.mi.us lib.mn.us lib.mo.us lib.ms.us lib.mt.us lib.nc.us lib.nd.us lib.ne.us lib.nh.us lib.nj.us lib.nm.us lib.nv.us lib.ny.us lib.oh.us lib.ok.us lib.or.us lib.pa.us lib.pr.us lib.ri.us lib.sc.us lib.sd.us lib.tn.us lib.tx.us lib.ut.us lib.vi.us lib.vt.us lib.va.us lib.wa.us lib.wi.us lib.wv.us lib.wy.us // k12.ma.us contains school districts in Massachusetts. The 4LDs are // managed indepedently except for private (PVT), charter (CHTR) and // parochial (PAROCH) schools. Those are delegated dorectly to the // 5LD operators. pvt.k12.ma.us chtr.k12.ma.us paroch.k12.ma.us // uy : http://www.nic.org.uy/ uy com.uy edu.uy gub.uy mil.uy net.uy org.uy // uz : http://www.reg.uz/ uz co.uz com.uz net.uz org.uz // va : http://en.wikipedia.org/wiki/.va va // vc : http://en.wikipedia.org/wiki/.vc // Submitted by registry 2008-06-13 vc com.vc net.vc org.vc gov.vc mil.vc edu.vc // ve : https://registro.nic.ve/ // Confirmed by registry 2012-10-04 ve co.ve com.ve e12.ve edu.ve gov.ve info.ve mil.ve net.ve org.ve web.ve // vg : http://en.wikipedia.org/wiki/.vg vg // vi : http://www.nic.vi/newdomainform.htm // http://www.nic.vi/Domain_Rules/body_domain_rules.html indicates some other // TLDs are "reserved", such as edu.vi and gov.vi, but doesn't actually say they // are available for registration (which they do not seem to be). vi co.vi com.vi k12.vi net.vi org.vi // vn : https://www.dot.vn/vnnic/vnnic/domainregistration.jsp vn com.vn net.vn org.vn edu.vn gov.vn int.vn ac.vn biz.vn info.vn name.vn pro.vn health.vn // vu : http://en.wikipedia.org/wiki/.vu // list of 2nd level tlds ? vu // wf : http://www.afnic.fr/medias/documents/AFNIC-naming-policy2012.pdf wf // ws : http://en.wikipedia.org/wiki/.ws // http://samoanic.ws/index.dhtml ws com.ws net.ws org.ws gov.ws edu.ws // yt : http://www.afnic.fr/medias/documents/AFNIC-naming-policy2012.pdf yt // IDN ccTLDs // Please sort by ISO 3166 ccTLD, then punicode string // when submitting patches and follow this format: // ("" ) : // [optional sponsoring org] // // xn--mgbaam7a8h ("Emerat" Arabic) : AE // http://nic.ae/english/arabicdomain/rules.jsp امارات // xn--54b7fta0cc ("Bangla" Bangla) : BD বাংলা // xn--fiqs8s ("China" Chinese-Han-Simplified <.Zhonggou>) : CN // CNNIC // http://cnnic.cn/html/Dir/2005/10/11/3218.htm 中国 // xn--fiqz9s ("China" Chinese-Han-Traditional <.Zhonggou>) : CN // CNNIC // http://cnnic.cn/html/Dir/2005/10/11/3218.htm 中國 // xn--lgbbat1ad8j ("Algeria / Al Jazair" Arabic) : DZ الجزائر // xn--wgbh1c ("Egypt" Arabic .masr) : EG // http://www.dotmasr.eg/ مصر // xn--node ("ge" Georgian (Mkhedruli)) : GE გე // xn--j6w193g ("Hong Kong" Chinese-Han) : HK // https://www2.hkirc.hk/register/rules.jsp 香港 // xn--h2brj9c ("Bharat" Devanagari) : IN // India भारत // xn--mgbbh1a71e ("Bharat" Arabic) : IN // India بھارت // xn--fpcrj9c3d ("Bharat" Telugu) : IN // India భారత్ // xn--gecrj9c ("Bharat" Gujarati) : IN // India ભારત // xn--s9brj9c ("Bharat" Gurmukhi) : IN // India ਭਾਰਤ // xn--45brj9c ("Bharat" Bengali) : IN // India ভারত // xn--xkc2dl3a5ee0h ("India" Tamil) : IN // India இந்தியா // xn--mgba3a4f16a ("Iran" Persian) : IR ایران // xn--mgba3a4fra ("Iran" Arabic) : IR ايران // xn--mgbayh7gpa ("al-Ordon" Arabic) : JO // National Information Technology Center (NITC) // Royal Scientific Society, Al-Jubeiha الاردن // xn--3e0b707e ("Republic of Korea" Hangul) : KR 한국 // xn--fzc2c9e2c ("Lanka" Sinhalese-Sinhala) : LK // http://nic.lk ලංකා // xn--xkc2al3hye2a ("Ilangai" Tamil) : LK // http://nic.lk இலங்கை // xn--mgbc0a9azcg ("Morocco / al-Maghrib" Arabic) : MA المغرب // xn--mgb9awbf ("Oman" Arabic) : OM عمان // xn--ygbi2ammx ("Falasteen" Arabic) : PS // The Palestinian National Internet Naming Authority (PNINA) // http://www.pnina.ps فلسطين // xn--90a3ac ("srb" Cyrillic) : RS срб // xn--p1ai ("rf" Russian-Cyrillic) : RU // http://www.cctld.ru/en/docs/rulesrf.php рф // xn--wgbl6a ("Qatar" Arabic) : QA // http://www.ict.gov.qa/ قطر // xn--mgberp4a5d4ar ("AlSaudiah" Arabic) : SA // http://www.nic.net.sa/ السعودية // xn--mgberp4a5d4a87g ("AlSaudiah" Arabic) variant : SA السعودیة // xn--mgbqly7c0a67fbc ("AlSaudiah" Arabic) variant : SA السعودیۃ // xn--mgbqly7cvafr ("AlSaudiah" Arabic) variant : SA السعوديه // xn--ogbpf8fl ("Syria" Arabic) : SY سورية // xn--mgbtf8fl ("Syria" Arabic) variant : SY سوريا // xn--yfro4i67o Singapore ("Singapore" Chinese-Han) : SG 新加坡 // xn--clchc0ea0b2g2a9gcd ("Singapore" Tamil) : SG சிங்கப்பூர் // xn--o3cw4h ("Thai" Thai) : TH // http://www.thnic.co.th ไทย // xn--pgbs0dh ("Tunis") : TN // http://nic.tn تونس // xn--kpry57d ("Taiwan" Chinese-Han-Traditional) : TW // http://www.twnic.net/english/dn/dn_07a.htm 台灣 // xn--kprw13d ("Taiwan" Chinese-Han-Simplified) : TW // http://www.twnic.net/english/dn/dn_07a.htm 台湾 // xn--nnx388a ("Taiwan") variant : TW 臺灣 // xn--j1amh ("ukr" Cyrillic) : UA укр // xn--mgb2ddes ("AlYemen" Arabic) : YE اليمن // xxx : http://icmregistry.com xxx // ye : http://www.y.net.ye/services/domain_name.htm *.ye // za : http://www.zadna.org.za/slds.html *.za // zm : http://en.wikipedia.org/wiki/.zm *.zm // zw : http://en.wikipedia.org/wiki/.zw *.zw // ===END ICANN DOMAINS=== // ===BEGIN PRIVATE DOMAINS=== // Amazon CloudFront : https://aws.amazon.com/cloudfront/ // Requested by Donavan Miller 2013-03-22 cloudfront.net // Amazon Elastic Load Balancing : https://aws.amazon.com/elasticloadbalancing/ // Requested by Scott Vidmar 2013-03-27 elb.amazonaws.com // Amazon S3 : https://aws.amazon.com/s3/ // Requested by Courtney Eckhardt 2013-03-22 s3.amazonaws.com s3-us-west-2.amazonaws.com s3-us-west-1.amazonaws.com s3-eu-west-1.amazonaws.com s3-ap-southeast-1.amazonaws.com s3-ap-southeast-2.amazonaws.com s3-ap-northeast-1.amazonaws.com s3-sa-east-1.amazonaws.com s3-us-gov-west-1.amazonaws.com s3-fips-us-gov-west-1.amazonaws.com s3-website-us-east-1.amazonaws.com s3-website-us-west-2.amazonaws.com s3-website-us-west-1.amazonaws.com s3-website-eu-west-1.amazonaws.com s3-website-ap-southeast-1.amazonaws.com s3-website-ap-southeast-2.amazonaws.com s3-website-ap-northeast-1.amazonaws.com s3-website-sa-east-1.amazonaws.com s3-website-us-gov-west-1.amazonaws.com // BetaInABox // Requested by adrian@betainabox.com 2012-09-13 betainabox.com // CentralNic : http://www.centralnic.com/names/domains // Requested by registry 2012-09-27 ae.org ar.com br.com cn.com com.de de.com eu.com gb.com gb.net gr.com hu.com hu.net jp.net jpn.com kr.com no.com qc.com ru.com sa.com se.com se.net uk.com uk.net us.com us.org uy.com za.com // c.la : http://www.c.la/ c.la // co.ca : http://registry.co.ca/ co.ca // CoDNS B.V. co.nl co.no // DreamHost : http://www.dreamhost.com/ // Requested by Andrew Farmer 2012-10-02 dreamhosters.com // DynDNS.com : http://www.dyndns.com/services/dns/dyndns/ dyndns-at-home.com dyndns-at-work.com dyndns-blog.com dyndns-free.com dyndns-home.com dyndns-ip.com dyndns-mail.com dyndns-office.com dyndns-pics.com dyndns-remote.com dyndns-server.com dyndns-web.com dyndns-wiki.com dyndns-work.com dyndns.biz dyndns.info dyndns.org dyndns.tv at-band-camp.net ath.cx barrel-of-knowledge.info barrell-of-knowledge.info better-than.tv blogdns.com blogdns.net blogdns.org blogsite.org boldlygoingnowhere.org broke-it.net buyshouses.net cechire.com dnsalias.com dnsalias.net dnsalias.org dnsdojo.com dnsdojo.net dnsdojo.org does-it.net doesntexist.com doesntexist.org dontexist.com dontexist.net dontexist.org doomdns.com doomdns.org dvrdns.org dyn-o-saur.com dynalias.com dynalias.net dynalias.org dynathome.net dyndns.ws endofinternet.net endofinternet.org endoftheinternet.org est-a-la-maison.com est-a-la-masion.com est-le-patron.com est-mon-blogueur.com for-better.biz for-more.biz for-our.info for-some.biz for-the.biz forgot.her.name forgot.his.name from-ak.com from-al.com from-ar.com from-az.net from-ca.com from-co.net from-ct.com from-dc.com from-de.com from-fl.com from-ga.com from-hi.com from-ia.com from-id.com from-il.com from-in.com from-ks.com from-ky.com from-la.net from-ma.com from-md.com from-me.org from-mi.com from-mn.com from-mo.com from-ms.com from-mt.com from-nc.com from-nd.com from-ne.com from-nh.com from-nj.com from-nm.com from-nv.com from-ny.net from-oh.com from-ok.com from-or.com from-pa.com from-pr.com from-ri.com from-sc.com from-sd.com from-tn.com from-tx.com from-ut.com from-va.com from-vt.com from-wa.com from-wi.com from-wv.com from-wy.com ftpaccess.cc fuettertdasnetz.de game-host.org game-server.cc getmyip.com gets-it.net go.dyndns.org gotdns.com gotdns.org groks-the.info groks-this.info ham-radio-op.net here-for-more.info hobby-site.com hobby-site.org home.dyndns.org homedns.org homeftp.net homeftp.org homeip.net homelinux.com homelinux.net homelinux.org homeunix.com homeunix.net homeunix.org iamallama.com in-the-band.net is-a-anarchist.com is-a-blogger.com is-a-bookkeeper.com is-a-bruinsfan.org is-a-bulls-fan.com is-a-candidate.org is-a-caterer.com is-a-celticsfan.org is-a-chef.com is-a-chef.net is-a-chef.org is-a-conservative.com is-a-cpa.com is-a-cubicle-slave.com is-a-democrat.com is-a-designer.com is-a-doctor.com is-a-financialadvisor.com is-a-geek.com is-a-geek.net is-a-geek.org is-a-green.com is-a-guru.com is-a-hard-worker.com is-a-hunter.com is-a-knight.org is-a-landscaper.com is-a-lawyer.com is-a-liberal.com is-a-libertarian.com is-a-linux-user.org is-a-llama.com is-a-musician.com is-a-nascarfan.com is-a-nurse.com is-a-painter.com is-a-patsfan.org is-a-personaltrainer.com is-a-photographer.com is-a-player.com is-a-republican.com is-a-rockstar.com is-a-socialist.com is-a-soxfan.org is-a-student.com is-a-teacher.com is-a-techie.com is-a-therapist.com is-an-accountant.com is-an-actor.com is-an-actress.com is-an-anarchist.com is-an-artist.com is-an-engineer.com is-an-entertainer.com is-by.us is-certified.com is-found.org is-gone.com is-into-anime.com is-into-cars.com is-into-cartoons.com is-into-games.com is-leet.com is-lost.org is-not-certified.com is-saved.org is-slick.com is-uberleet.com is-very-bad.org is-very-evil.org is-very-good.org is-very-nice.org is-very-sweet.org is-with-theband.com isa-geek.com isa-geek.net isa-geek.org isa-hockeynut.com issmarterthanyou.com isteingeek.de istmein.de kicks-ass.net kicks-ass.org knowsitall.info land-4-sale.us lebtimnetz.de leitungsen.de likes-pie.com likescandy.com merseine.nu mine.nu misconfused.org mypets.ws myphotos.cc neat-url.com office-on-the.net on-the-web.tv podzone.net podzone.org readmyblog.org saves-the-whales.com scrapper-site.net scrapping.cc selfip.biz selfip.com selfip.info selfip.net selfip.org sells-for-less.com sells-for-u.com sells-it.net sellsyourhome.org servebbs.com servebbs.net servebbs.org serveftp.net serveftp.org servegame.org shacknet.nu simple-url.com space-to-rent.com stuff-4-sale.org stuff-4-sale.us teaches-yoga.com thruhere.net traeumtgerade.de webhop.biz webhop.info webhop.net webhop.org worse-than.tv writesthisblog.com // Google, Inc. // Requested by Eduardo Vela 2012-10-24 appspot.com blogspot.be blogspot.bj blogspot.ca blogspot.cf blogspot.ch blogspot.co.at blogspot.co.il blogspot.co.nz blogspot.co.uk blogspot.com blogspot.com.ar blogspot.com.au blogspot.com.br blogspot.com.es blogspot.cv blogspot.cz blogspot.de blogspot.dk blogspot.fi blogspot.fr blogspot.gr blogspot.hk blogspot.hu blogspot.ie blogspot.in blogspot.it blogspot.jp blogspot.kr blogspot.mr blogspot.mx blogspot.nl blogspot.no blogspot.pt blogspot.re blogspot.ro blogspot.se blogspot.sg blogspot.sk blogspot.td blogspot.tw codespot.com googleapis.com googlecode.com // iki.fi // Requested by Hannu Aronsson 2009-11-05 iki.fi // info.at : http://www.info.at/ biz.at info.at // Michau Enterprises Limited : http://www.co.pl/ co.pl // NYC.mn : http://www.information.nyc.mn // Requested by Matthew Brown 2013-03-11 nyc.mn // Opera Software, A.S.A. // Requested by Yngve Pettersen 2009-11-26 operaunite.com // Red Hat, Inc. OpenShift : https://openshift.redhat.com/ // Requested by Tim Kramer 2012-10-24 rhcloud.com // priv.at : http://www.nic.priv.at/ // Requested by registry 2008-06-09 priv.at // ZaNiC : http://www.za.net/ // Requested by registry 2009-10-03 za.net za.org // ===END PRIVATE DOMAINS=== qpsmtpd-0.94/config.sample/rcpthosts000066400000000000000000000000121240247602400176310ustar00rootroot00000000000000localhost qpsmtpd-0.94/config.sample/relayclients000066400000000000000000000006631240247602400203120ustar00rootroot00000000000000# used by plugins/relay # IPv4 format is IP, or IP part with trailing dot # e.g. "127.0.0.1", or "192.168." 127.0.0.1 # leading/trailing whitespace is ignored 192.0. # # IPv6 formats can be compressed or expanded, may include a prefixlen, # and can end on any nibble boundary. Nibble boundaries must be expressed # in expanded format. (RFC 3849 example) 2001:0DB8 2001:DB8::1 2001:DB8::1/32 2001:0DB8:0000:0000:0000:0000:0000:0001 qpsmtpd-0.94/config.sample/rhsbl_zones000066400000000000000000000001571240247602400201420ustar00rootroot00000000000000dsn.rfc-ignorant.org does not accept bounces. This violates RFC 821/2505/2821 http://www.rfc-ignorant.org/ qpsmtpd-0.94/config.sample/size_threshold000066400000000000000000000002401240247602400206310ustar00rootroot00000000000000# Messages below the size below will be stored in memory and not spooled. # Without this file, the default is 0 bytes, i.e. all messages will be spooled. 10000 qpsmtpd-0.94/config.sample/smtpauth-checkpassword000066400000000000000000000000511240247602400223060ustar00rootroot00000000000000/usr/local/vpopmail/bin/vchkpw /bin/true qpsmtpd-0.94/config.sample/tls_before_auth000066400000000000000000000001041240247602400207470ustar00rootroot00000000000000# change the next line to 0 if you want to offer AUTH without TLS 1 qpsmtpd-0.94/config.sample/tls_ciphers000066400000000000000000000006621240247602400201320ustar00rootroot00000000000000# Override default security using suitable string from available ciphers at # L # See plugins/tls for details. # # HIGH is a reasonable default that should satisfy most installations HIGH:!SSLv2 # # if you have legacy clients that require less secure connections, # consider using this less secure, but PCI compliant setting: #DEFAULT:!ADH:!LOW:!EXP:!SSLv2:+HIGH:+MEDIUM qpsmtpd-0.94/docs/000077500000000000000000000000001240247602400140675ustar00rootroot00000000000000qpsmtpd-0.94/docs/advanced.pod000066400000000000000000000054531240247602400163470ustar00rootroot00000000000000# # This file is best read with ``perldoc advanced.pod'' # ### # Conventions: # plugin names: F, F # constants: I # smtp commands, answers: B, B<250 Queued!> # # Notes: # * due to restrictions of some POD parsers, no C<<$object->method()>> # are allowed, use C<$object-Emethod()> # =head1 Advanced Playground =head2 Discarding messages If you want to make the client think a message has been regularily accepted, but in real you delete it or send it to F, ..., use something like the following plugin and load it before your default queue plugin. sub hook_queue { my ($self, $transaction) = @_; if ($transaction->notes('discard_mail')) { my $msg_id = $transaction->header->get('Message-Id') || ''; $msg_id =~ s/[\r\n].*//s; return(OK, "Queued! $msg_id"); } return(DECLINED); } =head2 Changing return values This is an example how to use the C method. The B plugin wraps the B plugin. The B plugin checks the F and F config files for domains, which we accept mail for. If not found it tells the client that relaying is not allowed. Clients which are marked as C are excluded from this rule. This plugin counts the number of unsuccessfull relaying attempts and drops the connection if too many were made. The optional parameter I configures this plugin to drop the connection after I unsuccessful relaying attempts. Set to C<0> to disable, default is C<5>. Note: Do not load both (B and B). This plugin should be configured to run I, like B. use Qpsmtpd::DSN; sub init { my ($self, $qp, @args) = @_; die "too many arguments" if @args > 1; $self->{_count_relay_max} = defined $args[0] ? $args[0] : 5; $self->isa_plugin("rcpt_ok"); } sub hook_rcpt { my ($self, $transaction, $recipient) = @_; my ($rc, @msg) = $self->SUPER::hook_rcpt($transaction, $recipient); return ($rc, @msg) unless (($rc == DENY) and $self->{_count_relay_max}); my $count = ($self->connection->notes('count_relay_attempts') || 0) + 1; $self->connection->notes('count_relay_attempts', $count); return ($rc, @msg) unless ($count > $self->{_count_relay_max}); return Qpsmtpd::DSN->relaying_denied(DENY_DISCONNECT, "Too many relaying attempts"); } =head2 Results of other hooks B just copied from README.plugins If we're in a transaction, the results of a callback are stored in $self->transaction->notes( $code->{name})->{"hook_$hook"}->{return} If we're in a connection, store things in the connection notes instead. B: does the above (regarding connection notes) work? =cut # vim: ts=2 sw=2 expandtab qpsmtpd-0.94/docs/authentication.pod000066400000000000000000000207401240247602400176150ustar00rootroot00000000000000# # read this with 'perldoc authentication.pod' ... # =head1 NAME Authentication framework for qpsmtpd =head1 DESCRIPTION Provides support for SMTP AUTH within qpsmtpd transactions, see L L for more details. =head1 USAGE This code is automatically loaded by Qpsmtpd::SMTP only if a plugin providing one of the defined L is loaded. The only time this can happen is if the client process employs the EHLO command to initiate the SMTP session. If the client uses HELO, the AUTH command is not available and this module isn't even loaded. =head2 Plugin Design An authentication plugin can bind to one or more auth hooks or bind to all of them at once. See L for more details. All plugins must provide two functions: =over 4 =item * init() This is the standard function which is called by qpsmtpd for any plugin listed in config/plugins. Typically, an auth plugin should register at least one hook, like this: sub init { my ($self, $qp) = @_; $self->register_hook("auth", "authfunction"); } where in this case "auth" means this plugin expects to support any of the defined authentication methods. =item * authfunction() The plugin must provide an authentication function which is part of the register_hook call. That function will receive the following six parameters when called: =over 4 =item $self A Qpsmtpd::Plugin object, which can be used, for example, to emit log entries or to send responses to the remote SMTP client. =item $transaction A Qpsmtpd::Transaction object which can be used to examine information about the current SMTP session like the remote IP address. =item $mechanism The lower-case name of the authentication mechanism requested by the client; either "plain", "login", or "cram-md5". =item $user Whatever the remote SMTP client sent to identify the user (may be bare name or fully qualified e-mail address). =item $clearPassword If the particular authentication method supports unencrypted passwords (currently PLAIN and LOGIN), which will be the plaintext password sent by the remote SMTP client. =item $hashPassword An encrypted form of the remote user's password, using the MD-5 algorithm (see also the $ticket parameter). =item $ticket This is the cryptographic challenge which was sent to the client as part of a CRAM-MD5 transaction. Since the MD-5 algorithm is one-way, the same $ticket value must be used on the backend to compare with the encrypted password sent in $hashPassword. =back =back Plugins should perform whatever checking they want and then return one of the following values (taken from Qpsmtpd::Constants): =over 4 =item OK If the authentication has succeeded, the plugin can return this value and all subsequently registered hooks will be skipped. =item DECLINED If the authentication has failed, but any additional plugins should be run, this value will be returned. If none of the registered plugins succeed, the overall authentication will fail. Normally an auth plugin should return this value for all cases which do not succeed (so that another auth plugin can have a chance to authenticate the user). =item DENY If the authentication has failed, and the plugin wishes this to short circuit any further testing, it should return this value. For example, a plugin could register the L hook and immediately fail any connection which is not trusted (e.g. not in the same network). Another reason to return DENY over DECLINED would be if the user name matched an existing account but the password failed to match. This would make a dictionary-based attack much harder to accomplish. See the included auth_vpopmail_sql plugin for how this might be accomplished. By returning DENY, no further authentication attempts will be made using the current method and data. A remote SMTP client is free to attempt a second auth method if the first one fails. =back Plugins may also return an optional message with the return code, e.g. return (DENY, "If you forgot your password, contact your admin"); and this will be appended to whatever response is sent to the remote SMTP client. There is no guarantee that the end user will see this information, though, since some prominent MTA's (produced by M$oft) I hide this information under the default configuration. This message will be logged locally, if appropriate, based on the configured log level. =head1 Auth Hooks The currently defined authentication methods are: =over 4 =item * auth-plain Any plugin which registers an auth-plain hook will engage in a plaintext prompted negotiation. This is the least secure authentication method since both the user name and password are visible in plaintext. Most SMTP clients will preferentially choose a more secure method if it is advertised by the server. =item * auth-login A slightly more secure method where the username and password are Base-64 encoded before sending. This is still an insecure method, since it is trivial to decode the Base-64 data. Again, it will not normally be chosen by SMTP clients unless a more secure method is not available (or if it fails). =item * auth-cram-md5 A cryptographically secure authentication method which employs a one-way hashing function to transmit the secret information without significant risk between the client and server. The server provides a challenge key L<$ticket>, which the client uses to encrypt the user's password. Then both user name and password are concatenated and Base-64 encoded before transmission. This hook must normally have access to the user's plaintext password, since there is no way to extract that information from the transmitted data. Since the CRAM-MD5 scheme requires that the server send the challenge L<$ticket> before knowing what user is attempting to log in, there is no way to use any existing MD5-encrypted password (like is frequently used with MySQL). =item * auth A catch-all hook which requires that the plugin support all three preceeding authentication methods. Any plugins registering the auth hook will be run only after all other plugins registered for the specific authentication method which was requested. This allows you to move from more specific plugins to more general plugins (e.g. local accounts first vs replicated accounts with expensive network access later). =back =head2 Multiple Hook Behavior If more than one hook is registered for a given authentication method, then they will be tried in the order that they appear in the config/plugins file unless one of the plugins returns DENY, which will immediately cease all authentication attempts for this transaction. In addition, all plugins that are registered for a specific auth hook will be tried before any plugins which are registered for the general auth hook. =head1 VPOPMAIL There are 4 authentication (smtp-auth) plugins that can be used with vpopmail. =over 4 =item auth_vpopmaild If you aren't sure which one to use, then use auth_vpopmaild. It supports the PLAIN and LOGIN authentication methods, doesn't require the qpsmtpd process to run with special permissions, and can authenticate against vpopmail running on another host. It does require the vpopmaild server to be running. =item auth_vpopmail The next best solution is auth_vpopmail. It requires the p5-vpopmail perl module and it compiles against libvpopmail.a. There are two catches. The qpsmtpd daemon must run as the vpopmail user, and you must be running v0.09 or higher for CRAM-MD5 support. The released version is 0.08 but my CRAM-MD5 patch has been added to the developers repo: http://github.com/sscanlon/vpopmail =item auth_vpopmail_sql If you are using the MySQL backend for vpopmail, then this module can be used for smtp-auth. It supports LOGIN, PLAIN, and CRAM-MD5. However, it does not work with some vpopmail features such as alias domains, service restrictions, nor does it update vpopmail's last_auth information. =item auth_checkpassword The auth_checkpassword is a generic authentication module that will work with any DJB style checkpassword program, including ~vpopmail/bin/vchkpw. It only supports PLAIN and LOGIN auth methods. =back =head1 AUTHOR John Peacock Matt Simerson (added VPOPMAIL) =head1 COPYRIGHT AND LICENSE Copyright (c) 2004-2006 John Peacock Portions based on original code by Ask Bjoern Hansen and Guillaume Filion This plugin is licensed under the same terms as the qpsmtpd package itself. Please see the LICENSE file included with qpsmtpd for details. =cut qpsmtpd-0.94/docs/config.pod000066400000000000000000000140521240247602400160420ustar00rootroot00000000000000 =head1 Qpsmtpd configuration The default way of setting config values is placing files with the name of the config variable in the config directory F, like qmail's F directory. NB: F (or F<$ENV{QMAIL}/control>) is used if a file does not exist in C. The location of the C directory can be set via the I environment variable and defaults to the current working directory. Any empty line or lines starting with C<#> are ignored. You may use a plugin which hooks the C hook to store the settings in some other way. See L and L for more info on this. Some settings still have to go in files, because they are loaded before any plugin can return something via the C hook: C, C, C and of course C. B =head2 Core settings These settings are used by the qpsmtpd core. Any other setting is (hopefully) documented by the corresponding plugin. Some settings of important plugins are shown below in L. =over 4 =item plugins The main config file, where all used plugins and their arguments are listed. =item me Sets the hostname which is used all over the place: in the greeting message, the Iheader, ... Default is whatever Sys::Hostname's hostname() returns. =item plugin_dirs Where to search for plugins (one directory per line), defaults to F<./plugins>. =item logging Sets the primary logging destination, see F. Format is the same as it's used for the F config file. B only the first non empty line is used (lines starting with C<#> are counted as empty). =item loglevel This is not used anymore, I if no F plugin is in use. Use a logging plugin. =item databytes Maximum size a message may be. Without this setting, there is no limit on the size. Should be something less than the backend MTA has set as it's maximum message size (if there is one). =item size_threshold When a message is greater than the size given in this config file, it will be spooled to disk. You probably want to enable spooling to disk for most virus scanner plugins and F. =item smtpgreeting Override the default SMTP greeting with this string. =item spool_dir Where temporary files are stored, defaults to F<~/tmp/>. =item spool_perms Permissions of the I, default is C<0700>. You probably have to change the defaults for some scanners (e.g. the F plugin). =item timeout =item timeoutsmtpd Set the timeout for the clients, C is the qmail smtpd control file, C the qpsmtpd file. Default is 1200 seconds. =item tls_before_auth If set to a true value, clients will have to initiate an SSL secured connection before any auth succeeds, defaults to C<0>. =back =head2 Plugin settings files =over 4 =item rcpthosts, morercpthosts Plugin: I Domains listed in these files will be accepted as valid local domains, anything else is rejected with a C message. If an entry in the C file starts with a C<.>, mails to anything ending with this string will be accepted, e.g.: example.com .example.com will accept mails for C and C. The C file is just checked for exact (case insensitive) matches. =item hosts_allow Plugin: F. Don't use this config file. The plugin itself is required to set the maximum number of concurrent connections. This config setting should only be used for some extremly rude clients: if list is too big it will slow down accepting new connections. =item relayclients =item morerelayclients Plugin: F Allow relaying for hosts listed in this file. The C file accepts IPs and CIDR entries. The C file accepts IPs and C like C<192.168.2.> (note the trailing dot!). With the given example any host which IP starts with C<192.168.2.> may relay via us. =item dnsbl_zones Plugin: F This file specifies the RBL zones list, used by the dnsbl plugin. Ihe IP address of each connecting host will be checked against each zone given. A few sample DNSBLs are listed in the sample config file, but you should evaluate the efficacy and listing policies of a DNSBL before using it. See also C and C in the documentation of the C plugin =item resolvable_fromhost Plugin: F Reject sender addresses where the MX is unresolvable, i.e. a boolean value is the only value in this file. If the MX resolves to something, reject the sender address if it resolves to something listed in the F config file. The I expects IP addresses or CIDR (i.e. C values) one per line, IPv4 only currenlty. =back =head2 Plugin settings arguments These are arguments that can be set on the config/plugins line, after the name of the plugin. These config options are available to all plugins. =over 4 =item loglevel Adjust the quantity of logging for the plugin. See docs/logging.pod =item reject plugin reject [ 0 | 1 | naughty ] Should the plugin reject mail? The special 'naughty' case will mark the connection as a naughty. Most plugins skip processing naughty connections. Filtering plugins can learn from them. Naughty connections are terminated up by the B plugin. Plugins that use $self->get_reject() or $self->get_reject_type() will automatically honor this setting. =item reject_type plugin reject_type [ perm | temp | disconnect | temp_disconnect ] Default: perm Values with temp in the name return a 4xx code and the others return a 5xx code. The I argument and the corresponding get_reject_type() method provides a standard way for plugins to automatically return the selected rejection type, as chosen by the config setting, the plugin author, or the get_reject_type() method. Plugins that are updated to use the $self->get_reject() or $self->get_reject_type() methods will automatically honor this setting. =back =cut qpsmtpd-0.94/docs/development.pod000066400000000000000000000105621240247602400171210ustar00rootroot00000000000000 =head1 Developing Qpsmtpd =head2 Mailing List All qpsmtpd development happens on the qpsmtpd mailing list. Subscribe by sending mail to qpsmtpd-subscribe@perl.org =head2 Git We use git for version control. Ask owns the master repository at git://github.com/smtpd/qpsmtpd.git We suggest using github to host your repository -- it makes your changes easily accessible for pulling into the master. After you create a github account, go to http://github.com/smtpd/qpsmtpd/tree/master and click on the "fork" button to get your own repository. =head3 Making a working Copy git clone git@github.com:username/qpsmtpd.git qpsmtpd will check out your copy into a directory called qpsmtpd =head3 Making a branch for your change As a general rule, you'll be better off if you do your changes on a branch - preferably a branch per unrelated change. You can use the C command to see which branch you are on. The easiest way to make a new branch is git checkout -b topic/my-great-change This will create a new branch with the name "topic/my-great-change" (and your current commit as the starting point). =head3 Committing a change Edit the appropriate files, and be sure to run the test suite. emacs lib/Qpsmtpd.pm # for example perl Makefile.PL make test When you're ready to check it in... git add lib/Qpsmtpd.pm # to let git know you changed the file git add --patch plugin/tls # interactive choose which changes to add git diff --cached # review changes added git commit # describe the commit git log -p # review your commit a last time git push origin # to send to github =head3 Commit Descriptions Though not required, it's a good idea to begin the commit message with a single short (less than 50 character) line summarizing the change, followed by a blank line and then a more thorough description. Tools that turn commits into email, for example, use the first line on the Subject: line and the rest of the commit in the body. (From: L) =head3 Submit patches by mail The best way to submit patches to the project is to send them to the mailing list for review. Use the C command to generate patches ready to be mailed. For example: git format-patch HEAD~3 will put each of the last three changes in files ready to be mailed with the C tool (it might be a good idea to send them to yourself first as a test). Sending patches to the mailing list is the most effective way to submit changes, although it helps if you at the same time also commit them to a git repository (for example on github). =head3 Merging changes back in from the master repository Tell git about the master repository. We're going to call it 'smtpd' for now, but you could call it anything you want. You only have to do this once. git remote add smtpd git://github.com/smtpd/qpsmtpd.git Pull in data from all remote branches git remote update Forward-port local commits to the updated upstream head git rebase smtpd/master If you have a change that conflicts with an upstream change (git will let you know) you have two options. Manually fix the conflict and then do git add some/file git commit Or if the conflicting upstream commit did the same logical change then you might want to just skip the local change: git rebase --skip Be sure to decide whether you're going to skip before you merge, or you might get yourself into an odd situation. Conflicts happen because upstream committers may make minor tweaks to your change before applying it. =head3 Throwing away changes If you get your working copy into a state you don't like, you can always revert to the last commit: git reset --hard HEAD Or throw away your most recent commit: git reset --hard HEAD^ If you make a mistake with this, git is pretty good about keeping your commits around even as you merge, rebase and reset away. This log of your git changes is called with "git reflog". =head3 Applying other peoples changes If you get a change in an email with the patch, one easy way to apply other peoples changes is to use C. That will go ahead and commit the change. To modify it, you can use C. If the changes are in a repository, you can add that repository with "git remote add" and then either merge them in with "git merge" or pick just the relevant commits with "git cherry-pick". qpsmtpd-0.94/docs/hooks.pod000066400000000000000000000515151240247602400157250ustar00rootroot00000000000000# # This file is best read with ``perldoc plugins.pod'' # ### # Conventions: # plugin names: F, F # constants: I # smtp commands, answers: B, B<250 Queued!> # # Notes: # * due to restrictions of some POD parsers, no C<<$object->method()>> # are allowed, use C<$object-Emethod()> # =head1 SMTP hooks This section covers the hooks, which are run in a normal SMTP connection. The order of these hooks is like you will (probably) see them, while a mail is received. Every hook receives a C object of the currently running plugin as the first argument. A C object is the second argument of the current transaction in the most hooks, exceptions are noted in the description of the hook. If you need examples how the hook can be used, see the source of the plugins, which are given as example plugins. B: for some hooks (post-fork, post-connection, disconnect, deny, ok) the return values are ignored. This does B mean you can return anything you want. It just means the return value is discarded and you can not disconnect a client with I. The rule to return I to run the next plugin for this hook (or return I / I to stop processing) still applies. =head2 hook_pre_connection Called by a controlling process (e.g. forkserver or prefork) after accepting the remote server, but before beginning a new instance (or handing the connection to the worker process). Useful for load-management and rereading large config files at some frequency less than once per session. This hook is available in the F, F and F flavours. =cut NOT FOR: apache, -server and inetd/pperl =pod B You should not use this hook to do major work and / or use lookup methods which (I) take some time, like DNS lookups. This will slow down B incoming connections, no other connection will be accepted while this hook is running! Arguments this hook receives are (B: currently no C<%args> for F): my ($self,$transaction,%args) = @_; # %args is: # %args = ( remote_ip => inet_ntoa($iaddr), # remote_port => $port, # local_ip => inet_ntoa($laddr), # local_port => $lport, # max_conn_ip => $MAXCONNIP, # child_addrs => [values %childstatus], # ); B the C<$transaction> is of course C at this time. Allowed return codes are =over 4 =item DENY / DENY_DISCONNECT returns a B<550> to the client and ends the connection =item DENYSOFT / DENYSOFT_DISCONNECT returns a B<451> to the client and ends the connection =back Anything else is ignored. Example plugins are F and F. =head2 hook_connect It is called at the start of a connection before the greeting is sent to the connecting client. Arguments for this hook are my $self = shift; B in fact you get passed two more arguments, which are C at this early stage of the connection, so ignore them. Allowed return codes are =over 4 =item OK Stop processing plugins, give the default response =item DECLINED Process the next plugin =item DONE Stop processing plugins and dont give the default response, i.e. the plugin gave the response =item DENY Return hard failure code and disconnect =item DENYSOFT Return soft failure code and disconnect =back Example plugin for this hook is the F plugin. =head2 hook_helo / hook_ehlo It is called after the client sent B (hook_ehlo) or B (hook_helo) Allowed return codes are =over 4 =item DENY Return a 550 code =item DENYSOFT Return a B<450> code =item DENY_DISCONNECT / DENYSOFT_DISCONNECT as above but with disconnect =item DONE Qpsmtpd wont do anything, the plugin sent the message =item DECLINED Qpsmtpd will send the standard B/B answer, of course only if all plugins hooking I return I. =back Arguments of this hook are my ($self, $transaction, $host) = @_; # $host: the name the client sent in the # (EH|HE)LO line B C<$transaction> is C at this point. =head2 hook_mail_pre After the B line sent by the client is broken into pieces by the C, this hook recieves the results. This hook may be used to pre-accept adresses without the surrounding IE> (by adding them) or addresses like Iuser@example.com.E> or Iuser@example.com E> by removing the trailing I<"."> / C<" ">. Expected return values are I and an address which must be parseable by Cparse()> on success or any other constant to indicate failure. Arguments are my ($self, $transaction, $addr) = @_; =head2 hook_mail Called right after the envelope sender line is parsed (the B command). The plugin gets passed a C object, which means the parsing and verifying the syntax of the address (and just the syntax, no other checks) is already done. Default is to allow the sender address. The remaining arguments are the extensions defined in RFC 1869 (if sent by the client). B According to the SMTP protocol, you can not reject an invalid sender until after the B stage (except for protocol errors, i.e. syntax errors in address). So store it in an C<$transaction-Enote()> and process it later in an rcpt hook. Allowed return codes are =over 4 =item OK sender allowed =item DENY Return a hard failure code =item DENYSOFT Return a soft failure code =item DENY_DISCONNECT / DENYSOFT_DISCONNECT as above but with disconnect =item DECLINED next plugin (if any) =item DONE skip further processing, plugin sent response =back Arguments for this hook are my ($self,$transaction, $sender, %args) = @_; # $sender: an Qpsmtpd::Address object for # sender of the message Example plugins for the C are F and F. =head2 hook_rcpt_pre See C, s/MAIL FROM:/RCPT TO:/. =head2 hook_rcpt This hook is called after the client sent an I command (after parsing the line). The given argument is parsed by C, then this hook is called. Default is to deny the mail with a soft error code. The remaining arguments are the extensions defined in RFC 1869 (if sent by the client). Allowed return codes =over 4 =item OK recipient allowed =item DENY Return a hard failure code, for example for an I message. =item DENYSOFT Return a soft failure code, for example if the connect to a user lookup database failed =item DENY_DISCONNECT / DENYSOFT_DISCONNECT as above but with disconnect =item DONE skip further processing, plugin sent response =back Arguments are my ($self, $transaction, $recipient, %args) = @_; # $rcpt = Qpsmtpd::Address object with # the given recipient address Example plugin is F. =head2 hook_data After the client sent the B command, before any data of the message was sent, this hook is called. B This hook, like B, B, B, B, is an endpoint of a pipelined command group (see RFC 1854) and may be used to detect ``early talkers''. Since svn revision 758 the F plugin may be configured to check at this hook for ``early talkers''. Allowed return codes are =over 4 =item DENY Return a hard failure code =item DENYSOFT Return a soft failure code =item DENY_DISCONNECT / DENYSOFT_DISCONNECT as above but with disconnect =item DONE Plugin took care of receiving data and calling the queue (not recommended) B The only real use for I is implementing other ways of receiving the message, than the default... for example the CHUNKING SMTP extension (RFC 1869, 1830/3030) ... a plugin for this exists at http://svn.perl.org/qpsmtpd/contrib/vetinari/experimental/chunking, but it was never tested ``in the wild''. =back Arguments: my ($self, $transaction) = @_; Example plugin is F. =head2 hook_received_line If you wish to provide your own Received header line, do it here. You can use or discard any of the given arguments (see below). Allowed return codes: =over 4 =item OK, $string use this string for the Received header. =item anything else use the default Received header =back Arguments are my ($self, $transaction, $smtp, $auth, $sslinfo) = @_; # $smtp - the SMTP type used (e.g. "SMTP" or "ESMTP"). # $auth - the Auth header additionals. # $sslinfo - information about SSL for the header. =head2 data_headers_end This hook fires after all header lines of the message data has been received. Defaults to doing nothing, just continue processing. At this step, the sender is not waiting for a reply, but we can try and prevent him from sending the entire message by disconnecting immediately. (Although it is likely the packets are already in flight due to buffering and pipelining). B BE CAREFUL! If you drop the connection legal MTAs will retry again and again, spammers will probably not. This is not RFC compliant and can lead to an unpredictable mess. Use with caution. B This hook does not currently work in async mode. Why this hook may be useful for you, see L, ff. Allowed return codes: =over 4 =item DENY_DISCONNECT Return B<554 Message denied> and disconnect =item DENYSOFT_DISCONNECT Return B<421 Message denied temporarily> and disconnect =item DECLINED Do nothing =back Arguments: my ($self, $transaction) = @_; B check arguments =head2 hook_data_post The C hook is called after the client sent the final C<.\r\n> of a message, before the mail is sent to the queue. Allowed return codes are =over 4 =item DENY Return a hard failure code =item DENYSOFT Return a soft failure code =item DENY_DISCONNECT / DENYSOFT_DISCONNECT as above but with disconnect =item DONE skip further processing (message will not be queued), plugin gave the response. B just returning I from a special queue plugin does (nearly) the same (i.e. dropping the mail to F) and you don't have to send the response on your own. If you want the mail to be queued, you have to queue it manually! =back Arguments: my ($self, $transaction) = @_; Example plugins: F, F =head2 hook_queue_pre This hook is run, just before the mail is queued to the ``backend''. You may modify the in-process transaction object (e.g. adding headers) or add something like a footer to the mail (the latter is not recommended). Allowed return codes are =over 4 =item DONE no queuing is done =item OK / DECLINED queue the mail =back =head2 hook_queue When all C hooks accepted the message, this hook is called. It is used to queue the message to the ``backend''. Allowed return codes: =over 4 =item DONE skip further processing (plugin gave response code) =item OK Return success message, i.e. tell the client the message was queued (this may be used to drop the message silently). =item DENY Return hard failure code =item DENYSOFT Return soft failure code, i.e. if disk full or other temporary queuing problems =back Arguments: my ($self, $transaction) = @_; Example plugins: all F plugins =head2 hook_queue_post This hook is called always after C. If the return code is B I, a message (all remaining return values) with level I is written to the log. Arguments are my $self = shift; B C<$transaction> is not valid at this point, therefore not mentioned. =head2 hook_reset_transaction This hook will be called several times. At the beginning of a transaction (i.e. when the client sends a B command the first time), after queueing the mail and every time a client sends a B command. Arguments are my ($self, $transaction) = @_; B don't rely on C<$transaction> being valid at this point. =head2 hook_quit After the client sent a B command, this hook is called (before the C). Allowed return codes =over 4 =item DONE plugin sent response =item DECLINED next plugin and / or qpsmtpd sends response =back Arguments: the only argument is C<$self> =cut ### XXX: FIXME pass the rest of the line to this hook? =pod Expample plugin is the F plugin. =head2 hook_disconnect This hook will be called from several places: After a plugin returned I, before connection is disconnected or after the client sent the B command, AFTER the quit hook and ONLY if no plugin hooking C returned I. All return values are ignored, arguments are just C<$self> Example plugin is F =head2 hook_post_connection This is the counter part of the C hook, it is called directly before the connection is finished, for example, just before the qpsmtpd-forkserver instance exits or if the client drops the connection without notice (without a B). This hook is not called if the qpsmtpd instance is killed. =cut FIXME: we should run this hook on a ``SIGHUP'' or some other signal? =pod The only argument is C<$self> and all return codes are ignored, it would be too late anyway :-). Example: F =head1 Parsing Hooks Before the line from the client is parsed by Cparse()> with the built in parser, these hooks are called. They can be used to supply a parsing function for the line, which will be used instead of the built in parser. The hook must return two arguments, the first is (currently) ignored, the second argument must be a (CODE) reference to a sub routine. This sub routine receives three arguments: =over 4 =item $self the plugin object =item $cmd the command (i.e. the first word of the line) sent by the client =item $line the line sent by the client without the first word =back Expected return values from this sub are I and a reason which is sent to the client or I and the C<$line> broken into pieces according to the syntax rules for the command. B, the C hook was never implemented,...> =head2 hook_helo_parse / hook_ehlo_parse The provided sub routine must return two or more values. The first is discarded, the second is the hostname (sent by the client as argument to the B / B command). All other values are passed to the helo / ehlo hook. This hook may be used to change the hostname the client sent... not recommended, but if your local policy says only to accept I hosts with FQDNs and you have a legal client which can not be changed to send his FQDN, this is the right place. =head2 hook_mail_parse / hook_rcpt_parse The provided sub routine must return two or more values. The first is either I to indicate that parsing of the line was successfull or anything else to bail out with I<501 Syntax error in command>. In case of failure the second argument is used as the error message for the client. If parsing was successfull, the second argument is the sender's / recipient's address (this may be without the surrounding I> and I>, don't add them here, use the C / C methods for this). All other arguments are sent to the C hook as B / B parameters (see RFC 1869 I for more info). Note that the mail and rcpt hooks expect a list of key/value pairs as the last arguments. =head2 hook_auth_parse B =head1 Special hooks Now some special hooks follow. Some of these hooks are some internal hooks, which may be used to alter the logging or retrieving config values from other sources (other than flat files) like SQL databases. =head2 hook_logging This hook is called when a log message is written, for example in a plugin it fires if someone calls C<$self-Elog($level, $msg);>. Allowed return codes are =over 4 =item DECLINED next logging plugin =item OK (not I, as some might expect!) ok, plugin logged the message =back Arguments are my ($self, $transaction, $trace, $hook, $plugin, @log) = @_; # $trace: level of message, for example # LOGWARN, LOGDEBUG, ... # $hook: the hook in/for which this logging # was called # $plugin: the plugin calling this hook # @log: the log message B C<$transaction> may be C, depending when / where this hook is called. It's probably best not to try acessing it. All F plugins can be used as example plugins. =head2 hook_deny This hook is called after a plugin returned I, I, I or I. All return codes are ignored, arguments are my ($self, $transaction, $prev_plugin, $return, $return_text) = @_; B C<$transaction> may be C, depending when / where this hook is called. It's probably best not to try acessing it. Example plugin for this hook is F. =head2 hook_ok The counter part of C, it is called after a plugin B return I, I, I or I. All return codes are ignored, arguments are my ( $self, $transaction, $prev_plugin, $return, $return_text ) = @_; B C<$transaction> may be C, depending when / where this hook is called. It's probably best not to try acessing it. =head2 hook_config Called when a config file is requested, for example in a plugin it fires if someone calls Cqp-Econfig($cfg_name);>. Allowed return codes are =over 4 =item DECLINED plugin didn't find the requested value =item OK requested values as C<@list>, example: return (OK, @{$config{$value}}) if exists $config{$value}; return (DECLINED); =back Arguments: my ($self,$transaction,$value) = @_; # $value: the requested config item(s) B C<$transaction> may be C, depending when / where this hook is called. It's probably best not to try acessing it. Example plugin is F from the qpsmtpd distribution. =head2 hook_unrecognized_command This is called if the client sent a command unknown to the core of qpsmtpd. This can be used to implement new SMTP commands or just count the number of unknown commands from the client, see below for examples. Allowed return codes: =over 4 =item DENY_DISCONNECT Return B<521> and disconnect the client =item DENY Return B<500> =item DONE Qpsmtpd wont do anything; the plugin responded, this is what you want to return, if you are implementing new commands =item Anything else... Return B<500 Unrecognized command> =back Arguments: my ($self, $transaction, $cmd, @args) = @_; # $cmd = the first "word" of the line # sent by the client # @args = all the other "words" of the # line sent by the client # "word(s)": white space split() line B C<$transaction> may be C, depending when / where this hook is called. It's probably best not to try acessing it. Example plugin is F. =head2 hook_help This hook triggers if a client sends the B command, allowed return codes are: =over 4 =item DONE Plugin gave the answer. =item DENY The client will get a C message, probably not what you want, better use $self->qp->respond(502, "Not implemented."); return DONE; =back Anything else will be send as help answer. Arguments are my ($self, $transaction, @args) = @_; with C<@args> being the arguments from the client's command. =head2 hook_vrfy If the client sents the B command, this hook is called. Default is to return a message telling the user to just try sending the message. Allowed return codes: =over 4 =item OK Recipient Exists =item DENY Return a hard failure code =item DONE Return nothing and move on =item Anything Else... Return a B<252> =back Arguments are: my ($self) = shift; =cut FIXME: this sould be changed in Qpsmtpd::SMTP to pass the rest of the line as arguments to the hook =pod =head2 hook_noop If the client sents the B command, this hook is called. Default is to return C<250 OK>. Allowed return codes are: =over 4 =item DONE Plugin gave the answer =item DENY_DISCONNECT Return error code and disconnect client =item DENY Return error code. =item Anything Else... Give the default answer of B<250 OK>. =back Arguments are my ($self,$transaction,@args) = @_; =head2 hook_post_fork B This hook is only available in qpsmtpd-async. It is called while starting qpsmtpd-async. You can run more than one instance of qpsmtpd-async (one per CPU probably). This hook is called after forking one instance. Arguments: my $self = shift; The return values of this hook are discarded. =head1 Authentication hooks =cut B auth_parse #=head2 auth B #=head2 auth-plain B #=head2 auth-login B #=head2 auth-cram-md5 B =pod See F. =cut # vim: ts=2 sw=2 expandtab qpsmtpd-0.94/docs/logging.pod000066400000000000000000000200541240247602400162220ustar00rootroot00000000000000# # read this with 'perldoc docs/logging.pod' # =head1 qpsmtpd logging; user documentation Qpsmtpd has a modular logging system. Here's a few things you need to know: * The built-in logging prints log messages to STDERR. * A variety of logging plugins is included, each with its own behavior. * When a logging plugin is enabled, the built-in logging is disabled. * plugins/logging/warn mimics the built-in logging. * Multiple logging plugins can be enabled simultaneously. Read the POD within each logging plugin (perldoc plugins/logging/B) to learn if it tickles your fancy. =head2 enabling plugins To enable logging plugins, edit the file I and uncomment the entries for the plugins you wish to use. =head2 logging level The 'master switch' for loglevel is I. Qpsmtpd and active plugins will output all messages that are less than or equal to the value specified. The log levels correspond to syslog levels: LOGDEBUG = 7 LOGINFO = 6 LOGNOTICE = 5 LOGWARN = 4 LOGERROR = 3 LOGCRIT = 2 LOGALERT = 1 LOGEMERG = 0 LOGRADAR = 0 Level 6, LOGINFO, is the level at which most servers should start logging. At level 6, each plugin should log one and occasionally two entries that summarize their activity. Here's a few sample lines: (connect) ident::geoip: SA, Saudi Arabia (connect) ident::p0f: Windows 7 or 8 (connect) earlytalker: pass: remote host said nothing spontaneous (data_post) domainkeys: skip: unsigned (data_post) spamassassin: pass, Spam, 21.7 < 100 (data_post) dspam: fail: agree, Spam, 1.00 c 552 we agree, no spam please (#5.6.1) Three plugins fired during the SMTP connection phase and 3 more ran during the data_post phase. Each plugin emitted one entry stating their findings. If you aren't processing the logs, you can save some disk I/O by reducing the loglevel, so that the only messages logged are ones that indicate a human should be taking some corrective action. =head2 log location If qpsmtpd is started using the distributed run file (cd ~smtpd; ./run), then you will see the log entries printed to your terminal. This solution works great for initial setup and testing and is the simplest case. A typical way to run qpsmtpd is as a supervised process with daemontools. If daemontools is already set up, setting up qpsmtpd may be as simple as: C If svcscan is running, the symlink will be detected and tcpserver will run the 'run' files in the ./ and ./log directories. Any log entries emitted will get handled per the instructions in log/run. The default location specified in log/run is log/main/current. =head2 plugin loglevel Most plugins support a loglevel argument after their config/plugins entry. The value can be a whole number (N) or a relative number (+/-N), where N is a whole number from 0-7. See the descriptions of each below. C C ATTN plugin authors: To support loglevel in your plugin, you must store the loglevel settings from the plugins/config entry $self->{_args}{loglevel}. A simple and recommended example is as follows: sub register { my ( $self, $qp ) = (shift, shift); $self->log(LOGERROR, "Bad arguments") if @_ % 2; $self->{_args} = { @_ }; } =head3 whole number If loglevel is a whole number, then all log activity in the plugin is logged at that level, regardless of the level the plugin author selected. This can be easily understood with a couple examples: The master loglevel is set at 6 (INFO). The mail admin sets a plugin loglevel to 7 (DEBUG). No messages from that plugin are emitted because DEBUG log entries are not <= 6 (INFO). The master loglevel is 6 (INFO) and the plugin loglevel is set to 5 or 6. All log entries will be logged because 5 is <= 6. This behavior is very useful to plugin authors. While testing and monitoring a plugin, they can set the level of their plugin to log everything. To return to 'normal' logging, they just update their config/plugins entry. =head3 relative Relative loglevel arguments adjust the loglevel of each logging call within a plugin. A value of I would make every logging entry one level less severe, where a value of I would make every logging entry one level more severe. For example, if a plugin has a loglevel setting of -1 and that same plugin logged a LOGDEBUG, it would instead be a LOGINFO message. Relative values makes it easy to control the verbosity and/or severity of individual plugins. =head1 qpsmtpd logging system; developer documentation Qpsmtpd now (as of 0.30-dev) supports a plugable logging architecture, so that different logging plugins can be supported. See the example logging plugins in plugins/logging, specifically the L and L files for examples of how to write your own logging plugins. =head1 plugin authors While plugins can log anything they like, a few logging conventions in use: =over 4 =item * at LOGINFO, log a single entry summarizing their disposition =item * log messages are prefixed with keywords: pass, fail, skip, error =over 4 =item pass: tests were run and the message passed =item fail: tests were run and the message failed =item fail, tolerated: tests run, msg failed, reject disabled =item skip: tests were not run =item error: tried to run tests but failure(s) encountered =item info: additional info, not to be used for plugin summary =back =item * when tests fail and reject is disabled, use the 'fail, tolerated' prefix =back When these conventions are adhered to, the logs/summarize tool outputs each message as a single row, with a small x showing failed tests and a large X for failed tests that caused message rejection. =head1 Internal support for pluggable logging Any code in the core can call C<$self->log()> and those log lines will be dispatched to each of the registered logging plugins. When C is called from a plugin, the plugin and hook names are automatically included in the parameters passed the logging hooks. All plugins which register for the logging hook should expect the following parameters to be passed: $self, $transaction, $trace, $hook, $plugin, @log where those terms are: =over 4 =item C<$self> The object which was used to call the log() method; this can be any object within the system, since the core code will automatically load logging plugins on behalf of any object. =item C<$transaction> This is the current SMTP transaction (defined as everything that happens between HELO/EHLO and QUIT/RSET). If you want to defer outputting certain log lines, you can store them in the transaction object, but you will need to bind the C hook in order to retrieve that information before it is discarded when the transaction is closed (see the L plugin for an example of doing this). =item C<$trace> This is the log level (as shown in config.sample/loglevel) that the caller asserted when calling log(). If you want to output the textural representation (e.g. C) of this in your log messages, you can use the log_level() function exported by Qpsmtpd::Constants (which is automatically available to all plugins). =item C<$hook> This is the hook that is currently being executed. If log() is called by any core code (i.e. not as part of a hook), this term will be C. =item C<$plugin> This is the plugin name that executed the log(). Like C<$hook>, if part of the core code calls log(), this wil be C. See L for a way to prevent logging your own plugin's log entries from within that plugin (the system will not infinitely recurse in any case). =item C<@log> The remaining arguments are as passed by the caller, which may be a single term or may be a list of values. It is usually sufficient to call C to deal with these terms, but it is possible that some plugin might pass additional arguments with signficance. =back Note: if you register a handler for certain hooks, e.g. C, there may be additional terms passed between C<$self> and C<$transaction>. See L for and example. qpsmtpd-0.94/docs/plugins.pod000066400000000000000000000270571240247602400162670ustar00rootroot00000000000000# # This file is best read with ``perldoc plugins.pod'' # ### # Conventions: # plugin names: F, F # constants: I # smtp commands, answers: B, B<250 Queued!> # # Notes: # * due to restrictions of some POD parsers, no C<<$object->method()>> # are allowed, use C<$object-Emethod()> # =head1 Introduction Plugins are the heart of qpsmtpd. The core implements only basic SMTP protocol functionality. No useful function can be done by qpsmtpd without loading plugins. Plugins are loaded on startup where each of them register their interest in various I provided by the qpsmtpd core engine. At least one plugin B allow or deny the B command to enable receiving mail. The F plugin is the standard plugin for this. Other plugins provide extra functionality related to this; for example the F plugin. =head2 Loading Plugins The list of plugins to load are configured in the I configuration file. One plugin per line, empty lines and lines starting with I<#> are ignored. The order they are loaded is the same as given in this config file. This is also the order the registered I are run. The plugins are loaded from the F directory or from a subdirectory of it. If a plugin should be loaded from such a subdirectory, the directory must also be given, like the F in the example below. Alternate plugin directories may be given in the F config file, one directory per line, these will be searched first before using the builtin fallback of F relative to the qpsmtpd root directory. It may be necessary, that the F must be used (if you're using F, for example). Some plugins may be configured by passing arguments in the F config file. A plugin can be loaded two or more times with different arguments by adding I<:N> to the plugin filename, with I being a number, usually starting at I<0>. Another method to load a plugin is to create a valid perl module, drop this module in perl's C<@INC> path and give the name of this module as plugin name. The only restriction to this is, that the module name B contain I<::>, e.g. C would be ok, C not. Appending of I<:0>, I<:1>, ... does not work with module plugins. check_relay virus/clamdscan spamassassin reject_threshold 7 my_rcpt_check example.com my_rcpt_check:0 example.org My::Plugin =head1 Anatomy of a plugin A plugin has at least one method, which inherits from the C object. The first argument for this method is always the plugin object itself (and usually called C<$self>). The most simple plugin has one method with a predefined name which just returns one constant. # plugin temp_disable_connection sub hook_connect { return(DENYSOFT, "Sorry, server is temporarily unavailable."); } While this is a valid plugin, it is not very useful except for rare circumstances. So let us see what happens when a plugin is loaded. =head2 Initialisation After the plugin is loaded the C method of the plugin is called, if present. The arguments passed to C are =over 4 =item $self the current plugin object, usually called C<$self> =item $qp the Qpsmtpd object, usually called C<$qp>. =item @args the values following the plugin name in the F config, split by white space. These arguments can be used to configure the plugin with default and/or static config settings, like database paths, timeouts, ... =back This is mainly used for inheriting from other plugins, but may be used to do the same as in C. The next step is to register the hooks the plugin provides. Any method which is named C is automagically added. Plugins should be written using standard named hook subroutines. This allows them to be overloaded and extended easily. Because some of the callback names have characters invalid in subroutine names , they must be translated. The current translation routine is C, see L for more info. If you choose not to use the default naming convention, you need to register the hooks in your plugin in the C method (see below) with the C call on the plugin object. sub register { my ($self, $qp, @args) = @_; $self->register_hook("mail", "mail_handler"); $self->register_hook("rcpt", "rcpt_handler"); } sub mail_handler { ... } sub rcpt_handler { ... } The C method is called last. It receives the same arguments as C. There is no restriction, what you can do in C, but creating database connections and reuse them later in the process may not be a good idea. This initialisation happens before any C is done. Therefore the file handle will be shared by all qpsmtpd processes and the database will probably be confused if several different queries arrive on the same file handle at the same time (and you may get the wrong answer, if any). This is also true for F and the pperl flavours, but not for F started by (x)inetd or tcpserver. In short: don't do it if you want to write portable plugins. =head2 Hook - Subroutine translations As mentioned above, the hook name needs to be translated to a valid perl C name. This is done like ($sub = $hook) =~ s/\W/_/g; $sub = "hook_$sub"; Some examples follow, for a complete list of available (documented ;-)) hooks (method names), use something like $ perl -lne 'print if s/^=head2\s+(hook_\S+)/$1/' docs/plugins.pod All valid hooks are defined in F, C. =head3 Translation table hook method ---------- ------------ config hook_config queue hook_queue data hook_data data_post hook_data_post quit hook_quit rcpt hook_rcpt mail hook_mail ehlo hook_ehlo helo hook_helo auth hook_auth auth-plain hook_auth_plain auth-login hook_auth_login auth-cram-md5 hook_auth_cram_md5 connect hook_connect reset_transaction hook_reset_transaction unrecognized_command hook_unrecognized_command =head2 Inheritance Inheriting methods from other plugins is an advanced topic. You can alter arguments for the underlying plugin, prepare something for the I plugin or skip a hook with this. Instead of modifying C<@ISA> directly in your plugin, use the C method from the C subroutine. # rcpt_ok_child sub init { my ($self, $qp, @args) = @_; $self->isa_plugin("rcpt_ok"); } sub hook_rcpt { my ($self, $transaction, $recipient) = @_; # do something special here... $self->SUPER::hook_rcpt($transaction, $recipient); } See also chapter C and F in SVN. =head2 Config files Most of the existing plugins fetch their configuration data from files in the F sub directory. This data is read at runtime and may be changed without restarting qpsmtpd. B<(FIXME: caching?!)> The contents of the files can be fetched via @lines = $self->qp->config("my_config"); All empty lines and lines starting with C<#> are ignored. If you don't want to read your data from files, but from a database you can still use this syntax and write another plugin hooking the C hook. =head2 Logging Log messages can be written to the log file (or STDERR if you use the F plugin) with $self->log($loglevel, $logmessage); The log level is one of (from low to high priority) =over 4 =item * LOGDEBUG =item * LOGINFO =item * LOGNOTICE =item * LOGWARN =item * LOGERROR =item * LOGCRIT =item * LOGALERT =item * LOGEMERG =back While debugging your plugins, set your plugins loglevel to LOGDEBUG. This will log every logging statement within your plugin. For more information about logging, see F. =head2 Information about the current plugin Each plugin inherits the public methods from C. =over 4 =item plugin_name() Returns the name of the currently running plugin =item hook_name() Returns the name of the running hook =item auth_user() Returns the name of the user the client is authed as (if authentication is used, of course) =item auth_mechanism() Returns the auth mechanism if authentication is used =item connection() Returns the C object associated with the current connection =item transaction() Returns the C object associated with the current transaction =back =head2 Temporary Files The temporary file and directory functions can be used for plugin specific workfiles and will automatically be deleted at the end of the current transaction. =over 4 =item temp_file() Returns a unique name of a file located in the default spool directory, but does not open that file (i.e. it is the name not a file handle). =item temp_dir() Returns the name of a unique directory located in the default spool directory, after creating the directory with 0700 rights. If you need a directory with different rights (say for an antivirus daemon), you will need to use the base function C<$self-Eqp-Etemp_dir()>, which takes a single parameter for the permissions requested (see L for details). A directory created like this will not be deleted when the transaction is ended. =item spool_dir() Returns the configured system-wide spool directory. =back =head2 Connection and Transaction Notes Both may be used to share notes across plugins and/or hooks. The only real difference is their life time. The connection notes start when a new connection is made and end, when the connection ends. This can, for example, be used to count the number of none SMTP commands. The plugin which uses this is the F plugin from the qpsmtpd core distribution. The transaction note starts after the B command and are just valid for the current transaction, see below in the I hook when the transaction ends. =head1 Return codes Each plugin must return an allowed constant for the hook and (usually) optionally a ``message'' for the client. Generally all plugins for a hook are processed until one returns something other than I. Plugins are run in the order they are listed in the F configuration file. The return constants are defined in C and have the following meanings: =over 4 =item DECLINED Plugin declined work; proceed as usual. This return code is I unless noted otherwise. =item OK Action allowed. =item DENY Action denied. =item DENYSOFT Action denied; return a temporary rejection code (say B<450> instead of B<550>). =item DENY_DISCONNECT Action denied; return a permanent rejection code and disconnect the client. Use this for "rude" clients. Note that you're not supposed to do this according to the SMTP specs, but bad clients don't listen sometimes. =item DENYSOFT_DISCONNECT Action denied; return a temporary rejection code and disconnect the client. See note above about SMTP specs. =item DONE Finishing processing of the request. Usually used when the plugin sent the response to the client. =item YIELD Only used in F, see F =back =cut # vim: ts=2 sw=2 expandtab qpsmtpd-0.94/docs/writing.pod000066400000000000000000000167721240247602400162730ustar00rootroot00000000000000# # This file is best read with ``perldoc writing.pod'' # ### # Conventions: # plugin names: F, F # constants: I # smtp commands, answers: B, B<250 Queued!> # # Notes: # * due to restrictions of some POD parsers, no C<<$object->method()>> # are allowed, use C<$object-Emethod()> # =head1 Writing your own plugins This is a walk through a new queue plugin, which queues the mail to a (remote) QMQP-Server. First step is to pull in the necessary modules use IO::Socket; use Text::Netstring qw( netstring_encode netstring_decode netstring_verify netstring_read ); We know, we need a server to send the mails to. This will be the same for every mail, so we can use arguments to the plugin to configure this server (and port). Inserting this static config is done in C: sub register { my ($self, $qp, @args) = @_; die "No QMQP server specified in qmqp-forward config" unless @args; $self->{_qmqp_timeout} = 120; if ($args[0] =~ /^([\.\w_-]+)$/) { $self->{_qmqp_server} = $1; } else { die "Bad data in qmqp server: $args[0]"; } $self->{_qmqp_port} = 628; if (@args > 1 and $args[1] =~ /^(\d+)$/) { $self->{_qmqp_port} = $1; } $self->log(LOGWARN, "WARNING: Ignoring additional arguments.") if (@args > 2); } We're going to write a queue plugin, so we need to hook to the I hook. sub hook_queue { my ($self, $transaction) = @_; $self->log(LOGINFO, "forwarding to $self->{_qmqp_server}:" ."$self->{_qmqp_port}"); The first step is to open a connection to the remote server. my $sock = IO::Socket::INET->new( PeerAddr => $self->{_qmqp_server}, PeerPort => $self->{_qmqp_port}, Timeout => $self->{_qmqp_timeout}, Proto => 'tcp') or $self->log(LOGERROR, "Failed to connect to " ."$self->{_qmqp_server}:" ."$self->{_qmqp_port}: $!"), return(DECLINED); $sock->autoflush(1); =over 4 =item * The client starts with a safe 8-bit text message. It encodes the message as the byte string C. (The last line is usually, but not necessarily, empty.) The client then encodes this byte string as a netstring. The client also encodes the envelope sender address as a netstring, and encodes each envelope recipient address as a netstring. The client concatenates all these netstrings, encodes the concatenation as a netstring, and sends the result. (from L) =back The first idea is to build the package we send, in the order described in the paragraph above: my $message = $transaction->header->as_string; $transaction->body_resetpos; while (my $line = $transaction->body_getline) { $message .= $line; } $message = netstring_encode($message); $message .= netstring_encode($transaction->sender->address); for ($transaction->recipients) { push @rcpt, $_->address; } $message .= join "", netstring_encode(@rcpt); print $sock netstring_encode($message) or do { my $err = $!; $self->_disconnect($sock); return(DECLINED, "Failed to print to socket: $err"); }; This would mean, we have to hold the full message in memory... Not good for large messages, and probably even slower (for large messages). Luckily it's easy to build a netstring without the help of the C module if you know the size of the string (for more info about netstrings see L). We start with the sender and recipient addresses: my ($addrs, $headers, @rcpt); $addrs = netstring_encode($transaction->sender->address); for ($transaction->recipients) { push @rcpt, $_->address; } $addrs .= join "", netstring_encode(@rcpt); Ok, we got the sender and the recipients, now let's see what size the message is. $headers = $transaction->header->as_string; my $msglen = length($headers) + $transaction->body_length; We've got everything we need. Now build the netstrings for the full package and the message. First the beginning of the netstring of the full package # (+ 2: the ":" and "," of the message's netstring) print $sock ($msglen + length($msglen) + 2 + length($addrs)) .":" ."$msglen:$headers" ### beginning of messages netstring or do { my $err = $!; $self->_disconnect($sock); return(DECLINED, "Failed to print to socket: $err"); }; Go to beginning of the body $transaction->body_resetpos; If the message is spooled to disk, read the message in blocks and write them to the server if ($transaction->body_fh) { my $buff; my $size = read $transaction->body_fh, $buff, 4096; unless (defined $size) { my $err = $!; $self->_disconnect($sock); return(DECLINED, "Failed to read from body_fh: $err"); } while ($size) { print $sock $buff or do { my $err = $!; $self->_disconnect($sock); return(DECLINED, "Failed to print to socket: $err"); }; $size = read $transaction->body_fh, $buff, 4096; unless (defined $size) { my $err = $!; $self->_disconnect($sock); return(DECLINED, "Failed to read from body_fh: $err"); } } } Else we have to read it line by line ... else { while (my $line = $transaction->body_getline) { print $sock $line or do { my $err = $!; $self->_disconnect($sock); return(DECLINED, "Failed to print to socket: $err"); }; } } Message is at the server, now finish the package. print $sock "," # end of messages netstring .$addrs # sender + recpients ."," # end of netstring of # the full package or do { my $err = $!; $self->_disconnect($sock); return(DECLINED, "Failed to print to socket: $err"); }; We're done. Now let's see what the remote qmqpd says... =over 4 =item * (continued from L:) The server's response is a nonempty string of 8-bit bytes, encoded as a netstring. The first byte of the string is either K, Z, or D. K means that the message has been accepted for delivery to all envelope recipients. This is morally equivalent to the 250 response to DATA in SMTP; it is subject to the reliability requirements of RFC 1123, section 5.3.3. Z means temporary failure; the client should try again later. D means permanent failure. Note that there is only one response for the entire message; the server cannot accept some recipients while rejecting others. =back my $answer = netstring_read($sock); $self->_disconnect($sock); if (defined $answer and netstring_verify($answer)) { $answer = netstring_decode($answer); $answer =~ s/^K// and return(OK, "Queued! $answer"); $answer =~ s/^Z// and return(DENYSOFT, "Deferred: $answer"); $answer =~ s/^D// and return(DENY, "Denied: $answer"); } If this is the only F plugin, the client will get a 451 temp error: return(DECLINED, "Protocol error"); } sub _disconnect { my ($self,$sock) = @_; if (defined $sock) { eval { close $sock; }; undef $sock; } } =cut # vim: ts=2 sw=2 expandtab qpsmtpd-0.94/lib/000077500000000000000000000000001240247602400137055ustar00rootroot00000000000000qpsmtpd-0.94/lib/Apache/000077500000000000000000000000001240247602400150665ustar00rootroot00000000000000qpsmtpd-0.94/lib/Apache/Qpsmtpd.pm000066400000000000000000000153731240247602400170650ustar00rootroot00000000000000package Apache::Qpsmtpd; use 5.006001; use strict; use warnings FATAL => 'all'; use Apache2::ServerUtil (); use Apache2::Connection (); use Apache2::Const -compile => qw(OK MODE_GETLINE); use APR::Const -compile => qw(SO_NONBLOCK EOF SUCCESS); use APR::Error (); use APR::Brigade (); use APR::Bucket (); use APR::Socket (); use Apache2::Filter (); use ModPerl::Util (); our $VERSION = '0.02'; sub handler { my Apache2::Connection $c = shift; $c->client_socket->opt_set(APR::Const::SO_NONBLOCK => 0); die "\$ENV{QPSMTPD_CONFIG} must be given" unless $ENV{QPSMTPD_CONFIG}; my $qpsmtpd = Qpsmtpd::Apache->new(); $qpsmtpd->start_connection( ip => $c->remote_ip, host => $c->remote_host, info => undef, conn => $c, ); $qpsmtpd->run($c); $qpsmtpd->run_hooks("post-connection"); $qpsmtpd->connection->reset; return Apache2::Const::OK; } package Qpsmtpd::Apache; use Qpsmtpd::Constants; use base qw(Qpsmtpd::SMTP); my %cdir_memo; sub config_dir { my ($self, $config) = @_; if (exists $cdir_memo{$config}) { return $cdir_memo{$config}; } if (uc($ENV{QPSMTPD_CONFIG}) eq 'USE-VIRTUAL-DOMAINS') { my $cdir = $self->{conn}->base_server->dir_config("qpsmtpd.config_dir"); $cdir =~ /^(.*)$/; # detaint my $configdir = $1 if -e "$1/$config"; $cdir_memo{$config} = $configdir; } else { shift; $cdir_memo{$config} = $self->SUPER::config_dir(@_); } return $cdir_memo{$config}; } sub start_connection { my $self = shift; my %opts = @_; $self->{conn} = $opts{conn}; $self->{conn} ->client_socket->timeout_set($self->config('timeout') * 1_000_000); $self->{bb_in} = APR::Brigade->new($self->{conn}->pool, $self->{conn}->bucket_alloc); $self->{bb_out} = APR::Brigade->new($self->{conn}->pool, $self->{conn}->bucket_alloc); my $remote_host = $opts{host} || ($opts{ip} ? "[$opts{ip}]" : "[noip!]"); my $remote_info = $opts{info} ? "$opts{info}\@$remote_host" : $remote_host; my $remote_ip = $opts{ip}; $self->log(LOGNOTICE, "Connection from $remote_info [$remote_ip]"); $self->SUPER::connection->start( remote_info => $remote_info, remote_ip => $remote_ip, remote_host => $remote_host, local_ip => $opts{conn}->local_ip, @_ ); } sub config { my $self = shift; my ($param, $type) = @_; if (!$type) { my $opt = $self->{conn}->base_server->dir_config("qpsmtpd.$param"); return $opt if defined($opt); } return $self->SUPER::config(@_); } sub run { my $self = shift; # should be somewhere in Qpsmtpd.pm and not here... $self->load_plugins; my $rc = $self->start_conversation; return if $rc != DONE; # this should really be the loop and read_input should just # get one line; I think $self->read_input(); } sub getline { my $self = shift; my $c = $self->{conn} || die "Cannot getline without a conn"; return if $c->aborted; my $bb = $self->{bb_in}; while (1) { my $rc = $c->input_filters->get_brigade($bb, Apache2::Const::MODE_GETLINE); return if $rc == APR::Const::EOF; die APR::Error::strerror($rc) unless $rc == APR::Const::SUCCESS; next unless $bb->flatten(my $data); $bb->cleanup; return $data; } return ''; } sub read_input { my $self = shift; my $c = $self->{conn}; while (defined(my $data = $self->getline)) { $data =~ s/\r?\n$//s; # advanced chomp $self->connection->notes('original_string', $data); $self->log(LOGDEBUG, "dispatching $data"); defined $self->dispatch(split / +/, $data, 2) or $self->respond(502, "command unrecognized: '$data'"); last if $self->{_quitting}; } } sub respond { my ($self, $code, @messages) = @_; my $c = $self->{conn}; while (my $msg = shift @messages) { my $bb = $self->{bb_out}; my $line = $code . (@messages ? "-" : " ") . $msg; $self->log(LOGDEBUG, $line); my $bucket = APR::Bucket->new(($c->bucket_alloc), "$line\r\n"); $bb->insert_tail($bucket); $c->output_filters->fflush($bb); # $bucket->remove; $bb->cleanup; } return 1; } sub disconnect { my $self = shift; $self->SUPER::disconnect(@_); $self->{_quitting} = 1; $self->{conn}->client_socket->close(); } 1; __END__ =head1 NAME Apache::Qpsmtpd - a mod_perl-2 connection handler for qpsmtpd =head1 SYNOPSIS Listen 0.0.0.0:25 smtp AcceptFilter smtp none ## "smtp" and the AcceptFilter are required for Linux, FreeBSD ## with apache >= 2.1.5, for others it doesn't hurt. See also ## http://httpd.apache.org/docs/2.2/mod/core.html#acceptfilter ## and http://httpd.apache.org/docs/2.2/mod/mpm_common.html#listen LoadModule perl_module modules/mod_perl.so use lib qw( /path/to/qpsmtpd/lib ); use Apache::Qpsmtpd; $ENV{QPSMTPD_CONFIG} = "/path/to/qpsmtpd/config"; PerlModule Apache::Qpsmtpd PerlProcessConnectionHandler Apache::Qpsmtpd # can specify this in config/plugin_dirs if you wish: PerlSetVar qpsmtpd.plugin_dirs /path/to/qpsmtpd/plugins PerlSetVar qpsmtpd.loglevel 4 Using multiple instances of Qpsmtpd on the same server is also possible by setting: $ENV{QPSMTPD_CONFIG} = "USE-VIRTUAL-DOMAINS"; Then in the VirtualHost of each config define the configuration directory: PerlSetVar qpsmtpd.config_dir /path/to/qpsmtpd/config Several different configurations can be running on the same server. =head1 DESCRIPTION This module implements a mod_perl/apache 2.0 connection handler that turns Apache into an SMTP server using Qpsmtpd. It also allows you to set single-valued config options (such as I, as seen above) using C in F. This module should be considered beta software as it is not yet widely tested. However it is currently the fastest way to run Qpsmtpd, so if performance is important to you then consider this module. =head1 BUGS Probably a few. Make sure you test your plugins carefully. The Apache scoreboard (/server-status/) mostly works and shows connections, but could do with some enhancements specific to SMTP. =head1 AUTHOR Matt Sergeant, Some credit goes to for Apache::SMTP which gave me the inspiration to do this. added the virtual host support. =cut qpsmtpd-0.94/lib/Danga/000077500000000000000000000000001240247602400147175ustar00rootroot00000000000000qpsmtpd-0.94/lib/Danga/Client.pm000066400000000000000000000142041240247602400164740ustar00rootroot00000000000000# $Id: Client.pm,v 1.8 2005/02/14 22:06:38 msergeant Exp $ package Danga::Client; use base 'Danga::TimeoutSocket'; use fields qw( line pause_count read_bytes data_bytes callback get_chunks reader_object ); use Time::HiRes (); use bytes; # 30 seconds max timeout! sub max_idle_time { 30 } sub max_connect_time { 1200 } sub new { my Danga::Client $self = shift; $self = fields::new($self) unless ref $self; $self->SUPER::new(@_); $self->reset_for_next_message; return $self; } sub reset_for_next_message { my Danga::Client $self = shift; $self->{line} = ''; $self->{pause_count} = 0; $self->{read_bytes} = 0; $self->{callback} = undef; $self->{reader_object} = undef; $self->{data_bytes} = ''; $self->{get_chunks} = 0; return $self; } sub get_bytes { my Danga::Client $self = shift; my ($bytes, $callback) = @_; if ($self->{callback}) { die "get_bytes/get_chunks currently in progress!"; } $self->{read_bytes} = $bytes; $self->{data_bytes} = $self->{line}; $self->{read_bytes} -= length($self->{data_bytes}); $self->{line} = ''; if ($self->{read_bytes} <= 0) { if ($self->{read_bytes} < 0) { $self->{line} = substr( $self->{data_bytes}, $self->{read_bytes}, # negative offset 0 - $self->{read_bytes}, # to end of str "" ); # truncate that substr } $callback->($self->{data_bytes}); return; } $self->{callback} = $callback; } sub process_chunk { my Danga::Client $self = shift; my $callback = shift; my $last_crlf = rindex($self->{line}, "\r\n"); if ($last_crlf != -1) { if ($last_crlf + 2 == length($self->{line})) { my $data = $self->{line}; $self->{line} = ''; $callback->($data); } else { my $data = substr($self->{line}, 0, $last_crlf + 2); $self->{line} = substr($self->{line}, $last_crlf + 2); $callback->($data); } } } sub get_chunks { my Danga::Client $self = shift; my ($bytes, $callback) = @_; if ($self->{callback}) { die "get_bytes/get_chunks currently in progress!"; } $self->{read_bytes} = $bytes; $self->process_chunk($callback) if length($self->{line}); $self->{callback} = $callback; $self->{get_chunks} = 1; } sub end_get_chunks { my Danga::Client $self = shift; my $remaining = shift; $self->{callback} = undef; $self->{get_chunks} = 0; if (defined($remaining)) { $self->process_read_buf(\$remaining); } } sub set_reader_object { my Danga::Client $self = shift; $self->{reader_object} = shift; } sub event_read { my Danga::Client $self = shift; if (my $obj = $self->{reader_object}) { $self->{reader_object} = undef; $obj->event_read($self); } elsif ($self->{callback}) { $self->{alive_time} = time; if ($self->{get_chunks}) { my $bref = $self->read($self->{read_bytes}); return $self->close($!) unless defined $bref; $self->{line} .= $$bref; $self->process_chunk($self->{callback}) if length($self->{line}); return; } if ($self->{read_bytes} > 0) { my $bref = $self->read($self->{read_bytes}); return $self->close($!) unless defined $bref; $self->{read_bytes} -= length($$bref); $self->{data_bytes} .= $$bref; } if ($self->{read_bytes} <= 0) { # print "Erk, read too much!\n" if $self->{read_bytes} < 0; my $cb = $self->{callback}; $self->{callback} = undef; $cb->($self->{data_bytes}); } } else { my $bref = $self->read(8192); return $self->close($!) unless defined $bref; $self->process_read_buf($bref); } } sub process_read_buf { my Danga::Client $self = shift; my $bref = shift; $self->{line} .= $$bref; return if $self->{pause_count} || $self->{closed}; if ($self->{line} =~ s/^(.*?\n)//) { my $line = $1; $self->{alive_time} = time; my $resp = $self->process_line($line); if ($::DEBUG > 1 and $resp) { print "$$:" . ($self + 0) . "S: $_\n" for split(/\n/, $resp); } $self->write($resp) if $resp; # $self->watch_read(0) if $self->{pause_count}; return if $self->{pause_count} || $self->{closed}; # read more in a timer, to give other clients a look in $self->AddTimer( 0, sub { if (length($self->{line}) && !$self->paused) { $self->process_read_buf(\"") ; # " for bad syntax highlighters } } ); } } sub has_data { my Danga::Client $self = shift; return length($self->{line}) ? 1 : 0; } sub clear_data { my Danga::Client $self = shift; $self->{line} = ''; } sub paused { my Danga::Client $self = shift; return 1 if $self->{pause_count}; return 1 if $self->{closed}; return 0; } sub pause_read { my Danga::Client $self = shift; $self->{pause_count}++; # $self->watch_read(0); } sub continue_read { my Danga::Client $self = shift; $self->{pause_count}--; if ($self->{pause_count} <= 0) { $self->{pause_count} = 0; $self->AddTimer( 0, sub { if (length($self->{line}) && !$self->paused) { $self->process_read_buf(\"") ; # " for bad syntax highlighters } } ); } } sub process_line { my Danga::Client $self = shift; return ''; } sub close { my Danga::Client $self = shift; print "closing @_\n" if $::DEBUG; $self->SUPER::close(@_); } sub event_err { my Danga::Client $self = shift; $self->close("Error") } sub event_hup { my Danga::Client $self = shift; $self->close("Disconnect (HUP)"); } 1; qpsmtpd-0.94/lib/Danga/TimeoutSocket.pm000066400000000000000000000031501240247602400200530ustar00rootroot00000000000000# $Id: TimeoutSocket.pm,v 1.2 2005/02/02 20:44:35 msergeant Exp $ package Danga::TimeoutSocket; use base 'Danga::Socket'; use fields qw(alive_time create_time); our $last_cleanup = 0; Danga::Socket->AddTimer(15, \&_do_cleanup); sub new { my Danga::TimeoutSocket $self = shift; my $sock = shift; $self = fields::new($self) unless ref($self); $self->SUPER::new($sock); my $now = time; $self->{alive_time} = $self->{create_time} = $now; return $self; } # overload these in a subclass sub max_idle_time { 0 } sub max_connect_time { 0 } sub Reset { Danga::Socket->Reset; Danga::Socket->AddTimer(15, \&_do_cleanup); } sub _do_cleanup { my $now = time; Danga::Socket->AddTimer(15, \&_do_cleanup); my $sf = __PACKAGE__->get_sock_ref; my %max_age; # classname -> max age (0 means forever) my %max_connect; # classname -> max connect time my @to_close; while (my $k = each %$sf) { my Danga::TimeoutSocket $v = $sf->{$k}; my $ref = ref $v; next unless $v->isa('Danga::TimeoutSocket'); unless (defined $max_age{$ref}) { $max_age{$ref} = $ref->max_idle_time || 0; $max_connect{$ref} = $ref->max_connect_time || 0; } if (my $t = $max_connect{$ref}) { if ($v->{create_time} < $now - $t) { push @to_close, $v; next; } } if (my $t = $max_age{$ref}) { if ($v->{alive_time} < $now - $t) { push @to_close, $v; } } } $_->close("Timeout") foreach @to_close; } 1; qpsmtpd-0.94/lib/Qpsmtpd.pm000066400000000000000000000500401240247602400156720ustar00rootroot00000000000000package Qpsmtpd; use strict; use vars qw($VERSION $TraceLevel $Spool_dir $Size_threshold); use Sys::Hostname; use Qpsmtpd::Constants; #use DashProfiler; $VERSION = "0.94"; my $git; if (-e ".git") { local $ENV{PATH} = "/usr/bin:/usr/local/bin:/opt/local/bin/"; $git = `git describe`; $git && chomp $git; } my $hooks = {}; my %defaults = ( me => hostname, timeout => 1200, ); my $_config_cache = {}; my %config_dir_memo; #DashProfiler->add_profile("qpsmtpd"); #my $SAMPLER = DashProfiler->prepare("qpsmtpd"); my $LOGGING_LOADED = 0; sub _restart { my $self = shift; my %args = @_; if ($args{restart}) { # reset all global vars to defaults $self->clear_config_cache; $hooks = {}; $LOGGING_LOADED = 0; %config_dir_memo = (); $TraceLevel = LOGWARN; $Spool_dir = undef; $Size_threshold = undef; } } sub DESTROY { #warn $_ for DashProfiler->profile_as_text("qpsmtpd"); } sub version { $VERSION . ($git ? "/$git" : "") } sub TRACE_LEVEL { $TraceLevel }; # leave for plugin compatibility sub hooks { $hooks; } sub load_logging { # need to do this differently than other plugins so as to # not trigger logging activity return if $LOGGING_LOADED; my $self = shift; return if $hooks->{"logging"}; my $configdir = $self->config_dir("logging"); my $configfile = "$configdir/logging"; my @loggers = $self->_config_from_file($configfile, 'logging'); $configdir = $self->config_dir('plugin_dirs'); $configfile = "$configdir/plugin_dirs"; my @plugin_dirs = $self->_config_from_file($configfile, 'plugin_dirs'); unless (@plugin_dirs) { my ($name) = ($0 =~ m!(.*?)/([^/]+)$!); @plugin_dirs = ("$name/plugins"); } my @loaded; for my $logger (@loggers) { push @loaded, $self->_load_plugin($logger, @plugin_dirs); } foreach my $logger (@loaded) { $self->log(LOGINFO, "Loaded $logger"); } $configdir = $self->config_dir("loglevel"); $configfile = "$configdir/loglevel"; $TraceLevel = $self->_config_from_file($configfile, 'loglevel'); unless (defined($TraceLevel) and $TraceLevel =~ /^\d+$/) { $TraceLevel = LOGWARN; # Default if no loglevel file found. } $LOGGING_LOADED = 1; return @loggers; } sub trace_level { my $self = shift; return $TraceLevel; } sub init_logger { # needed for compatibility purposes shift->trace_level(); } sub log { my ($self, $trace, @log) = @_; $self->varlog($trace, join(" ", @log)); } sub varlog { my ($self, $trace) = (shift, shift); my ($hook, $plugin, @log); if ($#_ == 0) { # log itself (@log) = @_; } elsif ($#_ == 1) { # plus the hook ($hook, @log) = @_; } else { # called from plugin ($hook, $plugin, @log) = @_; } $self->load_logging; # in case we don't have this loaded yet my ($rc) = $self->run_hooks_no_respond("logging", $trace, $hook, $plugin, @log) or return; return if $rc == DECLINED || $rc == OK; # plugin success return if $trace > $TraceLevel; # no logging plugins registered, fall back to STDERR my $prefix = defined $plugin && defined $hook ? " ($hook) $plugin:" : defined $plugin ? " $plugin:" : defined $hook ? " ($hook) running plugin:" : ''; warn join(' ', $$ . $prefix, @log), "\n"; } sub clear_config_cache { $_config_cache = {}; } # # method to get the configuration. It just calls get_qmail_config by # default, but it could be overwritten to look configuration up in a # database or whatever. # sub config { my ($self, $c, $type) = @_; $self->log(LOGDEBUG, "in config($c)"); # first try the cache # XXX - is this always the right thing to do? what if a config hook # can return different values on subsequent calls? if ($_config_cache->{$c}) { $self->log(LOGDEBUG, "config($c) returning (@{$_config_cache->{$c}}) from cache"); return wantarray ? @{$_config_cache->{$c}} : $_config_cache->{$c}->[0]; } # then run the hooks my ($rc, @config) = $self->run_hooks_no_respond("config", $c); $self->log(LOGDEBUG, "config($c): hook returned ($rc, @config) "); if ($rc == OK) { $self->log(LOGDEBUG, "setting _config_cache for $c to [@config] from hooks and returning it" ); $_config_cache->{$c} = \@config; return wantarray ? @{$_config_cache->{$c}} : $_config_cache->{$c}->[0]; } # and then get_qmail_config @config = $self->get_qmail_config($c, $type); if (@config) { $self->log(LOGDEBUG, "setting _config_cache for $c to [@config] from get_qmail_config and returning it" ); $_config_cache->{$c} = \@config; return wantarray ? @{$_config_cache->{$c}} : $_config_cache->{$c}->[0]; } # finally we use the default if there is any: if (exists($defaults{$c})) { $self->log(LOGDEBUG, "setting _config_cache for $c to @{[$defaults{$c}]} from defaults and returning it" ); $_config_cache->{$c} = [$defaults{$c}]; return wantarray ? @{$_config_cache->{$c}} : $_config_cache->{$c}->[0]; } return; } sub config_dir { my ($self, $config) = @_; if (exists $config_dir_memo{$config}) { return $config_dir_memo{$config}; } my $configdir = ($ENV{QMAIL} || '/var/qmail') . '/control'; my ($path) = ($ENV{PROCESS} ? $ENV{PROCESS} : $0) =~ m!(.*?)/([^/]+)$!; $configdir = "$path/config" if (-e "$path/config/$config"); if (exists $ENV{QPSMTPD_CONFIG}) { $ENV{QPSMTPD_CONFIG} =~ /^(.*)$/; # detaint $configdir = $1 if -e "$1/$config"; } return $config_dir_memo{$config} = $configdir; } sub plugin_dirs { my $self = shift; my @plugin_dirs = $self->config('plugin_dirs'); unless (@plugin_dirs) { my ($path) = ($ENV{PROCESS} ? $ENV{PROCESS} : $0) =~ m!(.*?)/([^/]+)$!; @plugin_dirs = ("$path/plugins"); } return @plugin_dirs; } sub get_qmail_config { my ($self, $config, $type) = @_; $self->log(LOGDEBUG, "trying to get config for $config"); my $configdir = $self->config_dir($config); my $configfile = "$configdir/$config"; # CDB config support really should be moved to a plugin if ($type and $type eq "map") { unless (-e $configfile . ".cdb") { $_config_cache->{$config} ||= []; return +{}; } eval { require CDB_File }; if ($@) { $self->log(LOGERROR, "No CDB Support! Did NOT read $configfile.cdb, could not load CDB_File module: $@" ); return +{}; } my %h; unless (tie(%h, 'CDB_File', "$configfile.cdb")) { $self->log(LOGERROR, "tie of $configfile.cdb failed: $!"); return +{}; } # We explicitly don't cache cdb entries. The assumption is that # the data is in a CDB file in the first place because there's # lots of data and the cache hit ratio would be low. return \%h; } return $self->_config_from_file($configfile, $config); } sub _config_from_file { my ($self, $configfile, $config, $visited) = @_; unless (-e $configfile) { $_config_cache->{$config} ||= []; return; } $visited ||= []; push @{$visited}, $configfile; open CF, "<$configfile" or warn "$$ could not open configfile $configfile: $!" and return; my @config = ; chomp @config; @config = grep { length($_) and $_ !~ m/^\s*#/ and $_ =~ m/\S/ } map { s/^\s+//; s/\s+$//; $_; } # trim leading/trailing whitespace @config; close CF; my $pos = 0; while ($pos < @config) { # recursively pursue an $include reference, if found. An inclusion which # begins with a leading slash is interpreted as a path to a file and will # supercede the usual config path resolution. Otherwise, the normal # config_dir() lookup is employed (the location in which the inclusion # appeared receives no special precedence; possibly it should, but it'd # be complicated beyond justifiability for so simple a config system. if ($config[$pos] =~ /^\s*\$include\s+(\S+)\s*$/) { my ($includedir, $inclusion) = ('', $1); splice @config, $pos, 1; # remove the $include line if ($inclusion !~ /^\//) { $includedir = $self->config_dir($inclusion); $inclusion = "$includedir/$inclusion"; } if (grep($_ eq $inclusion, @{$visited})) { $self->log(LOGERROR, "Circular \$include reference in config $config:"); $self->log(LOGERROR, "From $visited->[0]:"); $self->log(LOGERROR, " includes $_") for (@{$visited}[1 .. $#{$visited}], $inclusion); return wantarray ? () : undef; } push @{$visited}, $inclusion; for my $inc ($self->expand_inclusion_($inclusion, $configfile)) { my @insertion = $self->_config_from_file($inc, $config, $visited); splice @config, $pos, 0, @insertion; # insert the inclusion $pos += @insertion; } } else { $pos++; } } $_config_cache->{$config} = \@config; return wantarray ? @config : $config[0]; } sub expand_inclusion_ { my $self = shift; my $inclusion = shift; my $context = shift; my @includes; if (-d $inclusion) { $self->log(LOGDEBUG, "inclusion of directory $inclusion from $context"); if (opendir(INCD, $inclusion)) { @includes = map { "$inclusion/$_" } (grep { -f "$inclusion/$_" and !/^\./ } sort readdir INCD); closedir INCD; } else { $self->log(LOGERROR, "Couldn't open directory $inclusion," . " referenced from $context ($!)" ); } } else { $self->log(LOGDEBUG, "inclusion of file $inclusion from $context"); @includes = ($inclusion); } return @includes; } sub load_plugins { my $self = shift; my @plugins = $self->config('plugins'); my @loaded; if ($hooks->{queue}) { #$self->log(LOGWARN, "Plugins already loaded"); return @plugins; } for my $plugin_line (@plugins) { my $this_plugin = $self->_load_plugin($plugin_line, $self->plugin_dirs); push @loaded, $this_plugin if $this_plugin; } return @loaded; } sub _load_plugin { my $self = shift; my ($plugin_line, @plugin_dirs) = @_; # untaint the config data before passing it to plugins my ($safe_line) = $plugin_line =~ /^([ -~]+)$/ # all ascii printable or die "unsafe characters in config line: $plugin_line\n"; my ($plugin, @args) = split /\s+/, $safe_line; if ($plugin =~ m/::/) { return $self->_load_package_plugin($plugin, $safe_line, \@args); }; # regular plugins/$plugin plugin my $plugin_name = $plugin; $plugin =~ s/:\d+$//; # after this point, only used for filename # Escape everything into valid perl identifiers $plugin_name =~ s/([^A-Za-z0-9_\/])/sprintf("_%2x",unpack("C",$1))/eg; # second pass cares for slashes and words starting with a digit $plugin_name =~ s{ (/+) # directory (\d?) # package's first character }[ "::" . (length $2 ? sprintf("_%2x",unpack("C",$2)) : "") ]egx; my $package = "Qpsmtpd::Plugin::$plugin_name"; # don't reload plugins if they are already loaded unless (defined &{"${package}::plugin_name"}) { PLUGIN_DIR: for my $dir (@plugin_dirs) { if (-e "$dir/$plugin") { Qpsmtpd::Plugin->compile($plugin_name, $package, "$dir/$plugin", $self->{_test_mode}, $plugin); $self->log(LOGDEBUG, "Loading $safe_line from $dir/$plugin") unless $safe_line =~ /logging/; last PLUGIN_DIR; } } die "Plugin $plugin_name not found in our plugin dirs (", join(", ", @plugin_dirs), ")" unless defined &{"${package}::plugin_name"}; } my $plug = $package->new(); $plug->_register($self, @args); return $plug; } sub _load_package_plugin { my ($self, $plugin, $plugin_line, $args) = @_; # "full" package plugin (My::Plugin) my $package = $plugin; $package =~ s/[^_a-z0-9:]+//gi; my $eval = qq[require $package;\n] . qq[sub ${plugin}::plugin_name { '$plugin' }]; $eval =~ m/(.*)/s; $eval = $1; eval $eval; die "Failed loading $package - eval $@" if $@; $self->log(LOGDEBUG, "Loading $package ($plugin_line)") unless $plugin_line =~ /logging/; my $plug = $package->new(); $plug->_register($self, @$args); return $plug; }; sub transaction { return {}; } # base class implements empty transaction sub run_hooks { my ($self, $hook) = (shift, shift); if ($hooks->{$hook}) { my @r; my @local_hooks = @{$hooks->{$hook}}; $self->{_continuation} = [$hook, [@_], @local_hooks]; return $self->run_continuation(); } return $self->hook_responder($hook, [0, ''], [@_]); } sub run_hooks_no_respond { my ($self, $hook) = (shift, shift); if ($hooks->{$hook}) { my @r; for my $code (@{$hooks->{$hook}}) { eval { (@r) = $code->{code}->($self, $self->transaction, @_); }; $@ and warn("FATAL PLUGIN ERROR [" . $code->{name} . "]: ", $@) and next; if ($r[0] == YIELD) { die "YIELD not valid from $hook hook"; } last unless $r[0] == DECLINED; } $r[0] = DECLINED if not defined $r[0]; return @r; } return (0, ''); } sub continue_read { } # subclassed in -async sub pause_read { die "Continuations only work in qpsmtpd-async" } sub run_continuation { my $self = shift; #my $t1 = $SAMPLER->("run_hooks", undef, 1); die "No continuation in progress" unless $self->{_continuation}; $self->continue_read(); my $todo = $self->{_continuation}; $self->{_continuation} = undef; my $hook = shift @$todo || die "No hook in the continuation"; my $args = shift @$todo || die "No hook args in the continuation"; my @r; while (@$todo) { my $code = shift @$todo; #my $t2 = $SAMPLER->($hook . "_" . $code->{name}, undef, 1); #warn("Got sampler called: ${hook}_$code->{name}\n"); $self->varlog(LOGDEBUG, $hook, $code->{name}); my $tran = $self->transaction; eval { (@r) = $code->{code}->($self, $tran, @$args); }; $@ and $self->log(LOGCRIT, "FATAL PLUGIN ERROR [" . $code->{name} . "]: ", $@) and next; !defined $r[0] and $self->log(LOGERROR, "plugin " . $code->{name} . " running the $hook hook returned undef!" ) and next; # note this is wrong as $tran is always true in the # current code... if ($tran) { my $tnotes = $tran->notes($code->{name}); $tnotes->{"hook_$hook"}->{'return'} = $r[0] if (!defined $tnotes || ref $tnotes eq "HASH"); } else { my $cnotes = $self->connection->notes($code->{name}); $cnotes->{"hook_$hook"}->{'return'} = $r[0] if (!defined $cnotes || ref $cnotes eq "HASH"); } if ($r[0] == YIELD) { $self->pause_read(); $self->{_continuation} = [$hook, $args, @$todo]; return @r; } elsif ( $r[0] == DENY or $r[0] == DENYSOFT or $r[0] == DENY_DISCONNECT or $r[0] == DENYSOFT_DISCONNECT) { $r[1] = "" if not defined $r[1]; $self->log(LOGDEBUG, "Plugin " . $code->{name} . ", hook $hook returned " . return_code($r[0]) . ", $r[1]" ); $self->run_hooks_no_respond("deny", $code->{name}, $r[0], $r[1]) unless ($hook eq "deny"); } else { $r[1] = "" if not defined $r[1]; $self->log(LOGDEBUG, "Plugin " . $code->{name} . ", hook $hook returned " . return_code($r[0]) . ", $r[1]" ); $self->run_hooks_no_respond("ok", $code->{name}, $r[0], $r[1]) unless ($hook eq "ok"); } last unless $r[0] == DECLINED; } $r[0] = DECLINED if not defined $r[0]; # hook_*_parse() may return a CODE ref.. # ... which breaks when splitting as string: @r = map { split /\n/ } @r unless (ref($r[1]) eq "CODE"); return $self->hook_responder($hook, \@r, $args); } sub hook_responder { my ($self, $hook, $msg, $args) = @_; #my $t1 = $SAMPLER->("hook_responder", undef, 1); my $code = shift @$msg; my $responder = $hook . '_respond'; if (my $meth = $self->can($responder)) { return $meth->($self, $code, $msg, $args); } return $code, @$msg; } sub _register_hook { my $self = shift; my ($hook, $code, $unshift) = @_; if ($unshift) { unshift @{$hooks->{$hook}}, $code; } else { push @{$hooks->{$hook}}, $code; } } sub spool_dir { my $self = shift; unless ($Spool_dir) { # first time through $self->log(LOGDEBUG, "Initializing spool_dir"); $Spool_dir = $self->config('spool_dir') || Qpsmtpd::Utils::tildeexp('~/tmp/'); $Spool_dir .= "/" unless ($Spool_dir =~ m!/$!); $Spool_dir =~ /^(.+)$/ or die "spool_dir not configured properly"; $Spool_dir = $1; # cleanse the taint my $Spool_perms = $self->config('spool_perms') || '0700'; if (!-d $Spool_dir) { # create it if it doesn't exist mkdir($Spool_dir, oct($Spool_perms)) or die "Could not create spool_dir $Spool_dir: $!"; } # Make sure the spool dir has appropriate rights $self->log(LOGWARN, "Permissions on spool_dir $Spool_dir are not $Spool_perms") unless ((stat $Spool_dir)[2] & 07777) == oct($Spool_perms); } return $Spool_dir; } # For unique filenames. We write to a local tmp dir so we don't need # to make them unpredictable. my $transaction_counter = 0; sub temp_file { my $self = shift; my $filename = $self->spool_dir() . join(":", time, $$, $transaction_counter++); return $filename; } sub temp_dir { my $self = shift; my $mask = shift || 0700; my $dirname = $self->temp_file(); -d $dirname or mkdir($dirname, $mask) or die "Could not create temporary directory $dirname: $!"; return $dirname; } sub size_threshold { my $self = shift; unless (defined $Size_threshold) { $Size_threshold = $self->config('size_threshold') || 0; $self->log(LOGDEBUG, "size_threshold set to $Size_threshold"); } return $Size_threshold; } sub authenticated { my $self = shift; return (defined $self->{_auth} ? $self->{_auth} : ""); } sub auth_user { my $self = shift; return (defined $self->{_auth_user} ? $self->{_auth_user} : ""); } sub auth_mechanism { my $self = shift; return (defined $self->{_auth_mechanism} ? $self->{_auth_mechanism} : ""); } 1; __END__ =head1 NAME Qpsmtpd - base class for the qpsmtpd mail server =head1 DESCRIPTION This is the base class for the qpsmtpd mail server. See L and the I file for more information. =head1 COPYRIGHT Copyright 2001-2012 Ask Bjørn Hansen, Develooper LLC. See the LICENSE file for more information. =cut qpsmtpd-0.94/lib/Qpsmtpd/000077500000000000000000000000001240247602400153355ustar00rootroot00000000000000qpsmtpd-0.94/lib/Qpsmtpd/Address.pm000066400000000000000000000246731240247602400172740ustar00rootroot00000000000000#!/usr/bin/perl -w package Qpsmtpd::Address; use strict; =head1 NAME Qpsmtpd::Address - Lightweight E-Mail address objects =head1 DESCRIPTION Based originally on cut and paste from Mail::Address and including every jot and tittle from RFC-2821/2822 on what is a legal e-mail address for use during the SMTP transaction. =head1 USAGE my $rcpt = Qpsmtpd::Address->new(''); The objects created can be used as is, since they automatically stringify to a standard form, and they have an overloaded comparison for easy testing of values. =head1 METHODS =cut use overload ( '""' => \&format, 'cmp' => \&_addr_cmp, ); =head2 new() Can be called two ways: =over 4 =item * Qpsmtpd::Address->new('') The normal mode of operation is to pass the entire contents of the RCPT TO: command from the SMTP transaction. The value will be fully parsed via the L method, using the full RFC 2821 rules. =item * Qpsmtpd::Address->new("user", "host") If the caller has already split the address from the domain/host, this mode will not L the input values. This is not recommended in cases of user-generated input for that reason. This can be used to generate Qpsmtpd::Address objects for accounts like "" or indeed for the bounce address "<>". =back The resulting objects can be stored in arrays or used in plugins to test for equality (like in badmailfrom). =cut sub new { my ($class, $user, $host) = @_; my $self = {}; if ($user =~ /^<(.*)>$/) { ($user, $host) = $class->canonify($user); return undef unless defined $user; } elsif (not defined $host) { my $address = $user; ($user, $host) = $address =~ m/(.*)(?:\@(.*))/; } $self->{_user} = $user; $self->{_host} = $host; return bless $self, $class; } # Definition of an address ("path") from RFC 2821: # # Path = "<" [ A-d-l ":" ] Mailbox ">" # # A-d-l = At-domain *( "," A-d-l ) # ; Note that this form, the so-called "source route", # ; MUST BE accepted, SHOULD NOT be generated, and SHOULD be # ; ignored. # # At-domain = "@" domain # # Mailbox = Local-part "@" Domain # # Local-part = Dot-string / Quoted-string # ; MAY be case-sensitive # # Dot-string = Atom *("." Atom) # # Atom = 1*atext # # Quoted-string = DQUOTE *qcontent DQUOTE # # Domain = (sub-domain 1*("." sub-domain)) / address-literal # sub-domain = Let-dig [Ldh-str] # # address-literal = "[" IPv4-address-literal / # IPv6-address-literal / # General-address-literal "]" # # IPv4-address-literal = Snum 3("." Snum) # IPv6-address-literal = "IPv6:" IPv6-addr # General-address-literal = Standardized-tag ":" 1*dcontent # Standardized-tag = Ldh-str # ; MUST be specified in a standards-track RFC # ; and registered with IANA # # Snum = 1*3DIGIT ; representing a decimal integer # ; value in the range 0 through 255 # Let-dig = ALPHA / DIGIT # Ldh-str = *( ALPHA / DIGIT / "-" ) Let-dig # # IPv6-addr = IPv6-full / IPv6-comp / IPv6v4-full / IPv6v4-comp # IPv6-hex = 1*4HEXDIG # IPv6-full = IPv6-hex 7(":" IPv6-hex) # IPv6-comp = [IPv6-hex *5(":" IPv6-hex)] "::" [IPv6-hex *5(":" # IPv6-hex)] # ; The "::" represents at least 2 16-bit groups of zeros # ; No more than 6 groups in addition to the "::" may be # ; present # IPv6v4-full = IPv6-hex 5(":" IPv6-hex) ":" IPv4-address-literal # IPv6v4-comp = [IPv6-hex *3(":" IPv6-hex)] "::" # [IPv6-hex *3(":" IPv6-hex) ":"] IPv4-address-literal # ; The "::" represents at least 2 16-bit groups of zeros # ; No more than 4 groups in addition to the "::" and # ; IPv4-address-literal may be present # # # # atext and qcontent are not defined in RFC 2821. # From RFC 2822: # # atext = ALPHA / DIGIT / ; Any character except controls, # "!" / "#" / ; SP, and specials. # "$" / "%" / ; Used for atoms # "&" / "'" / # "*" / "+" / # "-" / "/" / # "=" / "?" / # "^" / "_" / # "`" / "{" / # "|" / "}" / # "~" # qtext = NO-WS-CTL / ; Non white space controls # # %d33 / ; The rest of the US-ASCII # %d35-91 / ; characters not including "\" # %d93-126 ; or the quote character # # qcontent = qtext / quoted-pair # # NO-WS-CTL = %d1-8 / ; US-ASCII control characters # %d11 / ; that do not include the # %d12 / ; carriage return, line feed, # %d14-31 / ; and white space characters # %d127 # # quoted-pair = ("\" text) / obs-qp # # text = %d1-9 / ; Characters excluding CR and LF # %d11 / # %d12 / # %d14-127 / # obs-text # # # (We ignore all obs forms) =head2 canonify() Primarily an internal method, it is used only on the path portion of an e-mail message, as defined in RFC-2821 (this is the part inside the angle brackets and does not include the "human readable" portion of an address). It returns a list of (local-part, domain). =cut # address components are defined as package variables so that they can # be overriden (in hook_pre_connection, for example) if people have # different needs. our $atom_expr = '[a-zA-Z0-9!#%&*+=?^_`{|}~\$\x27\x2D\/]+'; our $address_literal_expr = '(?:\[(?:\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3}|IPv6:[0-9A-Fa-f:.]+)\])'; our $subdomain_expr = '(?:[a-zA-Z0-9](?:[-a-zA-Z0-9]*[a-zA-Z0-9])?)'; our $domain_expr; our $qtext_expr = '[\x01-\x08\x0B\x0C\x0E-\x1F\x21\x23-\x5B\x5D-\x7F]'; our $text_expr = '[\x01-\x09\x0B\x0C\x0E-\x7F]'; sub canonify { my ($dummy, $path) = @_; # strip delimiters return undef unless ($path =~ /^<(.*)>$/); $path = $1; my $domain = $domain_expr ? $domain_expr : "$subdomain_expr(?:\.$subdomain_expr)*"; # it is possible for $address_literal_expr to be empty, if a site # doesn't want to allow them $domain = "(?:$address_literal_expr|$domain)" if !$domain_expr and $address_literal_expr; # strip source route $path =~ s/^\@$domain(?:,\@$domain)*://; # empty path is ok return "" if $path eq ""; # bare postmaster is permissible, perl RFC-2821 (4.5.1) return ("postmaster", undef) if $path =~ m/^postmaster$/i; my ($localpart, $domainpart) = ($path =~ /^(.*)\@($domain)$/); return (undef) unless defined $localpart; if ($localpart =~ /^$atom_expr(\.$atom_expr)*/) { # simple case, we are done return ($localpart, $domainpart); } if ($localpart =~ /^"(($qtext_expr|\\$text_expr)*)"$/) { $localpart = $1; $localpart =~ s/\\($text_expr)/$1/g; return ($localpart, $domainpart); } return (undef); } =head2 parse() Retained as a compatibility method, it is completely equivalent to new() called with a single parameter. =cut sub parse { # retain for compatibility only return shift->new(shift); } =head2 address() Can be used to reset the value of an existing Q::A object, in which case it takes a parameter with or without the angle brackets. Returns the stringified representation of the address. NOTE: does not escape any of the characters that need escaping, nor does it include the surrounding angle brackets. For that purpose, see L. =cut sub address { my ($self, $val) = @_; if (defined($val)) { $val = "<$val>" unless $val =~ /^<.+>$/; my ($user, $host) = $self->canonify($val); $self->{_user} = $user; $self->{_host} = $host; } return (defined $self->{_user} ? $self->{_user} : '') . (defined $self->{_host} ? '@' . $self->{_host} : ''); } =head2 format() Returns the canonical stringified representation of the address. It does escape any characters requiring it (per RFC-2821/2822) and it does include the surrounding angle brackets. It is also the default stringification operator, so the following are equivalent: print $rcpt->format(); print $rcpt; =cut sub format { my ($self) = @_; my $qchar = '[^a-zA-Z0-9!#\$\%\&\x27\*\+\x2D\/=\?\^_`{\|}~.]'; return '<>' unless defined $self->{_user}; if ((my $user = $self->{_user}) =~ s/($qchar)/\\$1/g) { return qq(<"$user") . (defined $self->{_host} ? '@' . $self->{_host} : '') . ">"; } return "<" . $self->address() . ">"; } =head2 user([$user]) Returns the "localpart" of the address, per RFC-2821, or the portion before the '@' sign. If called with one parameter, the localpart is set and the new value is returned. =cut sub user { my ($self, $user) = @_; $self->{_user} = $user if defined $user; return $self->{_user}; } =head2 host([$host]) Returns the "domain" part of the address, per RFC-2821, or the portion after the '@' sign. If called with one parameter, the domain is set and the new value is returned. =cut sub host { my ($self, $host) = @_; $self->{_host} = $host if defined $host; return $self->{_host}; } =head2 notes($key[,$value]) Get or set a note on the address. This is a piece of data that you wish to attach to the address and read somewhere else. For example you can use this to pass data between plugins. =cut sub notes { my ($self, $key) = (shift, shift); # Check for any additional arguments passed by the caller -- including undef return $self->{_notes}->{$key} unless @_; return $self->{_notes}->{$key} = shift; } sub _addr_cmp { require UNIVERSAL; my ($left, $right, $swap) = @_; my $class = ref($left); unless (UNIVERSAL::isa($right, $class)) { $right = $class->new($right); } #invert the address so we can sort by domain then user ($left = join('=', reverse(split(/@/, $left->format)))) =~ tr/[<>]//d; ($right = join('=', reverse(split(/@/, $right->format)))) =~ tr/[<>]//d; if ($swap) { ($right, $left) = ($left, $right); } return ($left cmp $right); } =head1 COPYRIGHT Copyright 2004-2005 Peter J. Holzer. See the LICENSE file for more information. =cut 1; qpsmtpd-0.94/lib/Qpsmtpd/Auth.pm000066400000000000000000000145371240247602400166060ustar00rootroot00000000000000package Qpsmtpd::Auth; # See the documentation in 'perldoc docs/authentication.pod' use strict; use warnings; use Qpsmtpd::Constants; use Digest::HMAC_MD5 qw(hmac_md5_hex); use MIME::Base64; sub e64 { my ($arg) = @_; my $res = encode_base64($arg); chomp($res); return ($res); } sub SASL { # $DB::single = 1; my ($session, $mechanism, $prekey) = @_; my ($user, $passClear, $passHash, $ticket, $loginas); if ($mechanism eq 'plain') { ($loginas, $user, $passClear) = get_auth_details_plain($session, $prekey); return DECLINED if !$user || !$passClear; } elsif ($mechanism eq 'login') { ($user, $passClear) = get_auth_details_login($session, $prekey); return DECLINED if !$user || !$passClear; } elsif ($mechanism eq 'cram-md5') { ($ticket, $user, $passHash) = get_auth_details_cram_md5($session); return DECLINED if !$user || !$passHash; } else { #this error is now caught in SMTP.pm's sub auth $session->respond(500, "Internal server error"); return DECLINED; } # try running the specific hooks first my ($rc, $msg) = $session->run_hooks("auth-$mechanism", $mechanism, $user, $passClear, $passHash, $ticket); # try running the polymorphous hooks next if (!$rc || $rc == DECLINED) { ($rc, $msg) = $session->run_hooks("auth", $mechanism, $user, $passClear, $passHash, $ticket); } if ($rc == OK) { $msg = uc($mechanism) . " authentication successful for $user" . ($msg ? " - $msg" : ''); $session->respond(235, $msg); $session->connection->relay_client(1); if ($session->connection->notes('naughty')) { $session->log(LOGINFO, "auth success cleared naughty"); $session->connection->notes('naughty', 0); } $session->log(LOGDEBUG, $msg); # already logged by $session->respond $session->{_auth_user} = $user; $session->{_auth_mechanism} = $mechanism; s/[\r\n].*//s for ($session->{_auth_user}, $session->{_auth_mechanism}); return OK; } else { $msg = uc($mechanism) . " authentication failed for $user" . ($msg ? " - $msg" : ''); $session->respond(535, $msg); $session->log(LOGDEBUG, $msg); # already logged by $session->respond return DENY; } } sub get_auth_details_plain { my ($session, $prekey) = @_; if (!$prekey) { $session->respond(334, ' '); $prekey = ; } my ($loginas, $user, $passClear) = split /\x0/, decode_base64($prekey); if (!$user) { if ($loginas) { $session->respond(535, "Authentication invalid ($loginas)"); } else { $session->respond(535, "Authentication invalid"); } return; } # Authorization ID must not be different from Authentication ID if ($loginas ne '' && $loginas ne $user) { $session->respond(535, "Authentication invalid for $user"); return; } return ($loginas, $user, $passClear); } sub get_auth_details_login { my ($session, $prekey) = @_; my $user; if ($prekey) { $user = decode_base64($prekey); } else { $user = get_base64_response($session, 'Username:') or return; } my $passClear = get_base64_response($session, 'Password:') or return; return ($user, $passClear); } sub get_auth_details_cram_md5 { my ($session, $ticket) = @_; if (!$ticket) { # ticket is only passed in during testing # rand() is not cryptographic, but we only need to generate a globally # unique number. The rand() is there in case the user logs in more than # once in the same second, or if the clock is skewed. $ticket = sprintf('<%x.%x@%s>', rand(1000000), time(), $session->config('me')); } # send the base64 encoded ticket $session->respond(334, encode_base64($ticket, '')); my $line = ; if ($line eq '*') { $session->respond(501, "Authentication canceled"); return; } my ($user, $passHash) = split(/ /, decode_base64($line)); unless ($user && $passHash) { $session->respond(504, "Invalid authentication string"); return; } $session->{auth}{ticket} = $ticket; return ($ticket, $user, $passHash); } sub get_base64_response { my ($session, $question) = @_; $session->respond(334, e64($question)); my $answer = decode_base64(); if ($answer eq '*') { $session->respond(501, "Authentication canceled"); return; } return $answer; } sub validate_password { my ($self, %a) = @_; my ($pkg, $file, $line) = caller(); $file = (split /\//, $file)[-1]; # strip off the path my $src_clear = $a{src_clear}; my $src_crypt = $a{src_crypt}; my $attempt_clear = $a{attempt_clear}; my $attempt_hash = $a{attempt_hash}; my $method = $a{method} or die "missing method"; my $ticket = $a{ticket} || $self->{auth}{ticket}; my $deny = $a{deny} || DENY; if (!$src_crypt && !$src_clear) { $self->log(LOGINFO, "fail: missing password"); return ($deny, "$file - no such user"); } if (!$src_clear && $method =~ /CRAM-MD5/i) { $self->log(LOGINFO, "skip: cram-md5 not supported w/o clear pass"); return (DECLINED, $file); } if (defined $attempt_clear) { if ($src_clear && $src_clear eq $attempt_clear) { $self->log(LOGINFO, "pass: clear match"); return (OK, $file); } if ($src_crypt && $src_crypt eq crypt($attempt_clear, $src_crypt)) { $self->log(LOGINFO, "pass: crypt match"); return (OK, $file); } } if (defined $attempt_hash && $src_clear) { if (!$ticket) { $self->log(LOGERROR, "skip: missing ticket"); return (DECLINED, $file); } if ($attempt_hash eq hmac_md5_hex($ticket, $src_clear)) { $self->log(LOGINFO, "pass: hash match"); return (OK, $file); } } $self->log(LOGINFO, "fail: wrong password"); return ($deny, "$file - wrong password"); } # tag: qpsmtpd plugin that sets RELAYCLIENT when the user authenticates 1; qpsmtpd-0.94/lib/Qpsmtpd/Command.pm000066400000000000000000000125661240247602400172630ustar00rootroot00000000000000package Qpsmtpd::Command; =head1 NAME Qpsmtpd::Command - parse arguments to SMTP commands =head1 DESCRIPTION B provides just one public sub routine: B. This sub expects two or three arguments. The first is the name of the SMTP command (such as I, I, ...). The second must be the remaining of the line the client sent. If no third argument is given (or it's not a reference to a CODE) it parses the line according to RFC 1869 (SMTP Service Extensions) for the I and I commands and splitting by spaces (" ") for all other. Any module can supply it's own parsing routine by returning a sub routine reference from a hook_*_parse. This sub will be called with I<$self>, I<$cmd> and I<$line>. On successfull parsing it MUST return B (the constant from I) success as first argument and a list of values, which will be the arguments to the hook for this command. If parsing failed, the second returned value (if any) will be returned to the client as error message. =head1 EXAMPLE Inside a plugin sub hook_unrecognized_command_parse { my ($self, $transaction, $cmd) = @_; return (OK, \&bdat_parser) if ($cmd eq 'bdat'); } sub bdat_parser { my ($self,$cmd,$line) = @_; # .. do something with $line... return (DENY, "Invalid arguments") if $some_reason_why_there_is_a_syntax_error; return (OK, @args); } sub hook_unrecognized_command { my ($self, $transaction, $cmd, @args) = @_; return (DECLINED) if ($self->qp->connection->hello eq 'helo'); return (DECLINED) unless ($cmd eq 'bdat'); .... } =cut use strict; use Qpsmtpd::Constants; use vars qw(@ISA); @ISA = qw(Qpsmtpd::SMTP); sub parse { my ($me, $cmd, $line, $sub) = @_; return (OK) unless defined $line; # trivial case my $self = {}; bless $self, $me; $cmd = lc $cmd; if ($sub and (ref($sub) eq 'CODE')) { my @ret = eval { $sub->($self, $cmd, $line); }; if ($@) { $self->log(LOGERROR, "Failed to parse command [$cmd]: $@"); return (DENY, $line, ()); } ## my @log = @ret; ## for (@log) { ## $_ ||= ""; ## } ## $self->log(LOGDEBUG, "parse($cmd) => [".join("], [", @log)."]"); return @ret; } my $parse = "parse_$cmd"; if ($self->can($parse)) { # print "CMD=$cmd,line=$line\n"; my @out = eval { $self->$parse($cmd, $line); }; if ($@) { $self->log(LOGERROR, "$parse($cmd,$line) failed: $@"); return (DENY, "Failed to parse line"); } return @out; } return (OK, split(/ +/, $line)); # default :) } sub parse_rcpt { my ($self, $cmd, $line) = @_; return (DENY, "Syntax error in command") unless $line =~ s/^to:\s*//i; return &_get_mail_params($cmd, $line); } sub parse_mail { my ($self, $cmd, $line) = @_; return (DENY, "Syntax error in command") unless $line =~ s/^from:\s*//i; return &_get_mail_params($cmd, $line); } ### RFC 1869: ## 6. MAIL FROM and RCPT TO Parameters ## [...] ## ## esmtp-cmd ::= inner-esmtp-cmd [SP esmtp-parameters] CR LF ## esmtp-parameters ::= esmtp-parameter *(SP esmtp-parameter) ## esmtp-parameter ::= esmtp-keyword ["=" esmtp-value] ## esmtp-keyword ::= (ALPHA / DIGIT) *(ALPHA / DIGIT / "-") ## ## ; syntax and values depend on esmtp-keyword ## esmtp-value ::= 1* like # MAIL FROM: user=name@example.net # or RCPT TO: postmaster # let's see if $line contains nothing and use the first value as address: if ($line) { # parameter syntax error, i.e. not all of the arguments were # stripped by the while() loop: return (DENY, "Syntax error in parameters") if ($line =~ /\@.*\s/); return (OK, $line, @params); } $line = shift @params; if ($cmd eq "mail") { return (OK, "<>") unless $line; # 'MAIL FROM:' --> 'MAIL FROM:<>' return (DENY, "Syntax error in parameters") if ($line =~ /\@.*\s/); # parameter syntax error } else { if ($line =~ /\@/) { return (DENY, "Syntax error in parameters") if ($line =~ /\@.*\s/); } else { # XXX: what about 'abuse' in Qpsmtpd::Address? return (DENY, "Syntax error in parameters") if $line =~ /\s/; return (DENY, "Syntax error in address") unless ($line =~ /^(postmaster|abuse)$/i); } } ## XXX: No: let this do a plugin, so it's not up to us to decide ## if we require <> around an address :-) ## unless ($line =~ /^<.*>$/) { $line = "<".$line.">"; } return (OK, $line, @params); } 1; qpsmtpd-0.94/lib/Qpsmtpd/ConfigServer.pm000066400000000000000000000167601240247602400203010ustar00rootroot00000000000000package Qpsmtpd::ConfigServer; use base ('Danga::Client'); use Qpsmtpd::Constants; use strict; use fields qw( _auth _commands _config_cache _connection _transaction _test_mode _extras other_fds ); my $PROMPT = "Enter command: "; sub new { my Qpsmtpd::ConfigServer $self = shift; $self = fields::new($self) unless ref $self; $self->SUPER::new(@_); $self->write($PROMPT); return $self; } sub max_idle_time { 3600 } # one hour sub process_line { my $self = shift; my $line = shift || return; if ($::DEBUG > 1) { print "$$:" . ($self + 0) . "C($self->{mode}): $line"; } local $SIG{ALRM} = sub { my ($pkg, $file, $line) = caller(); die "ALARM: $pkg, $file, $line"; }; my $prev = alarm(2); # must process a command in < 2 seconds my $resp = eval { $self->_process_line($line) }; alarm($prev); if ($@) { print STDERR "Error: $@\n"; } return $resp || ''; } sub respond { my $self = shift; my (@messages) = @_; while (my $msg = shift @messages) { $self->write("$msg\r\n"); } return; } sub fault { my $self = shift; my ($msg) = shift || "program fault - command not performed"; print STDERR "$0 [$$]: $msg ($!)\n"; $self->respond("Error - " . $msg); return $PROMPT; } sub _process_line { my $self = shift; my $line = shift; $line =~ s/\r?\n//; my ($cmd, @params) = split(/ +/, $line); my $meth = "cmd_" . lc($cmd); if (my $lookup = $self->can($meth)) { my $resp = eval { $lookup->($self, @params); }; if ($@) { my $error = $@; chomp($error); Qpsmtpd->log(LOGERROR, "Command Error: $error"); return $self->fault("command '$cmd' failed unexpectedly"); } return "$resp\n$PROMPT"; } else { # No such method - i.e. unrecognized command return $self->fault("command '$cmd' unrecognised"); } } my %helptext = ( help => "HELP [CMD] - Get help on all commands or a specific command", status => "STATUS - Returns status information about current connections", list => "LIST [LIMIT] - List the connections, specify limit or negative limit to shrink list", kill => "KILL (\$IP | \$REF) - Disconnect all connections from \$IP or connection reference \$REF", pause => "PAUSE - Stop accepting new connections", continue => "CONTINUE - Resume accepting connections", reload => "RELOAD - Reload all plugins and config", quit => "QUIT - Exit the config server", ); sub cmd_help { my $self = shift; my ($subcmd) = @_; $subcmd ||= 'help'; $subcmd = lc($subcmd); if ($subcmd eq 'help') { my $txt = join("\n", map { substr($_, 0, index($_, "-")) } sort values(%helptext)); return "Available Commands:\n\n$txt\n"; } my $txt = $helptext{$subcmd} || "Unrecognised help option. Try 'help' for a full list."; return "$txt\n"; } sub cmd_quit { my $self = shift; $self->close; } sub cmd_shutdown { exit; } sub cmd_pause { my $self = shift; my $other_fds = $self->OtherFds; $self->{other_fds} = {%$other_fds}; %$other_fds = (); return "PAUSED"; } sub cmd_continue { my $self = shift; my $other_fds = $self->{other_fds}; $self->OtherFds(%$other_fds); %$other_fds = (); return "UNPAUSED"; } sub cmd_status { my $self = shift; # Status should show: # - Total time running # - Total number of mails received # - Total number of mails rejected (5xx) # - Total number of mails tempfailed (5xx) # - Avg number of mails/minute # - Number of current connections # - Number of outstanding DNS queries my $output = "Current Status as of " . gmtime() . " GMT\n\n"; if (defined &Qpsmtpd::Plugin::stats::get_stats) { # Stats plugin is loaded $output .= Qpsmtpd::Plugin::stats->get_stats; } my $descriptors = Danga::Socket->DescriptorMap; my $current_connections = 0; my $current_dns = 0; foreach my $fd (keys %$descriptors) { my $pob = $descriptors->{$fd}; if ($pob->isa("Qpsmtpd::PollServer")) { $current_connections++; } elsif ($pob->isa("ParaDNS::Resolver")) { $current_dns = $pob->pending; } } $output .= "Curr Connections: $current_connections / $::MAXconn\n" . "Curr DNS Queries: $current_dns"; return $output; } sub cmd_list { my $self = shift; my ($count) = @_; my $descriptors = Danga::Socket->DescriptorMap; my $list = "Current" . ($count ? (($count > 0) ? " Oldest $count" : " Newest " . -$count) : "") . " Connections: \n\n"; my @all; foreach my $fd (keys %$descriptors) { my $pob = $descriptors->{$fd}; if ($pob->isa("Qpsmtpd::PollServer")) { next unless $pob->connection->remote_ip; # haven't even started yet push @all, [ $pob + 0, $pob->connection->remote_ip, $pob->connection->remote_host, $pob->uptime ]; } } @all = sort { $a->[3] <=> $b->[3] } @all; if ($count) { if ($count > 0) { @all = @all[$#all - ($count - 1) .. $#all]; } else { @all = @all[0 .. (abs($count) - 1)]; } } foreach my $item (@all) { $list .= sprintf("%x : %s [%s] Connected %0.2fs\n", map { defined() ? $_ : '' } @$item); } return $list; } sub cmd_kill { my $self = shift; my ($match) = @_; return "SYNTAX: KILL (\$IP | \$REF)\n" unless $match; my $descriptors = Danga::Socket->DescriptorMap; my $killed = 0; my $is_ip = (index($match, '.') >= 0); foreach my $fd (keys %$descriptors) { my $pob = $descriptors->{$fd}; if ($pob->isa("Qpsmtpd::PollServer")) { if ($is_ip) { next unless $pob->connection->remote_ip; # haven't even started yet if ($pob->connection->remote_ip eq $match) { $pob->write( "550 Your connection has been killed by an administrator\r\n"); $pob->disconnect; $killed++; } } else { # match by ID if ($pob + 0 == hex($match)) { $pob->write( "550 Your connection has been killed by an administrator\r\n"); $pob->disconnect; $killed++; } } } } return "Killed $killed connection" . ($killed > 1 ? "s" : "") . "\n"; } sub cmd_dump { my $self = shift; my ($ref) = @_; return "SYNTAX: DUMP \$REF\n" unless $ref; require Data::Dumper; $Data::Dumper::Indent = 1; my $descriptors = Danga::Socket->DescriptorMap; foreach my $fd (keys %$descriptors) { my $pob = $descriptors->{$fd}; if ($pob->isa("Qpsmtpd::PollServer")) { if ($pob + 0 == hex($ref)) { return Data::Dumper::Dumper($pob); } } } return "Unable to find the connection: $ref. Try the LIST command\n"; } 1; __END__ =head1 NAME Qpsmtpd::ConfigServer - a configuration server for qpsmtpd =head1 DESCRIPTION When qpsmtpd runs in multiplex mode it also provides a config server that you can connect to. This allows you to view current connection statistics and other gumph that you probably don't care about. =cut qpsmtpd-0.94/lib/Qpsmtpd/Connection.pm000066400000000000000000000115611240247602400177760ustar00rootroot00000000000000package Qpsmtpd::Connection; use strict; # All of these parameters depend only on the physical connection, # i.e. not on anything sent from the remote machine. Hence, they # are an appropriate set to use for either start() or clone(). Do # not add parameters here unless they also meet that criteria. my @parameters = qw( remote_host remote_ip remote_info remote_port local_ip local_port relay_client ); sub new { my $proto = shift; my $class = ref($proto) || $proto; my $self = {}; bless($self, $class); } sub start { my $self = shift; $self = $self->new(@_) unless ref $self; my %args = @_; foreach my $f (@parameters) { $self->$f($args{$f}) if $args{$f}; } return $self; } sub clone { my $self = shift; my %args = @_; my $new = $self->new(); foreach my $f (@parameters) { $new->$f($self->$f()) if $self->$f(); } $new->{_notes} = $self->{_notes} if defined $self->{_notes}; # reset the old connection object like it's done at the end of a connection # to prevent leaks (like prefork/tls problem with the old SSL file handle # still around) $self->reset unless $args{no_reset}; # should we generate a new id here? return $new; } sub remote_host { my $self = shift; @_ and $self->{_remote_host} = shift; $self->{_remote_host}; } sub remote_ip { my $self = shift; @_ and $self->{_remote_ip} = shift; $self->{_remote_ip}; } sub remote_port { my $self = shift; @_ and $self->{_remote_port} = shift; $self->{_remote_port}; } sub local_ip { my $self = shift; @_ and $self->{_local_ip} = shift; $self->{_local_ip}; } sub local_port { my $self = shift; @_ and $self->{_local_port} = shift; $self->{_local_port}; } sub remote_info { my $self = shift; @_ and $self->{_remote_info} = shift; $self->{_remote_info}; } sub relay_client { my $self = shift; @_ and $self->{_relay_client} = shift; $self->{_relay_client}; } sub hello { my $self = shift; @_ and $self->{_hello} = shift; $self->{_hello}; } sub hello_host { my $self = shift; @_ and $self->{_hello_host} = shift; $self->{_hello_host}; } sub notes { my ($self, $key) = (shift, shift); # Check for any additional arguments passed by the caller -- including undef return $self->{_notes}->{$key} unless @_; return $self->{_notes}->{$key} = shift; } sub reset { my $self = shift; $self->{_notes} = undef; $self = $self->new; } 1; __END__ =head1 NAME Qpsmtpd::Connection - A single SMTP connection =head1 SYNOPSIS my $rdns = $qp->connection->remote_host; my $ip = $qp->connection->remote_ip; =head1 DESCRIPTION This class contains details about an individual SMTP connection. A connection lasts the lifetime of a TCP connection to the SMTP server. See also L which is a class containing details about an individual SMTP transaction. A transaction lasts from C to the end of the C marker, or a C command, whichever comes first, whereas a connection lasts until the client disconnects. =head1 API These API docs assume you already have a connection object. See the source code if you need to construct one. You can access the connection object via the C object's C<< $qp->connection >> method. =head2 new ( ) Instantiates a new Qpsmtpd::Connection object. =head2 start ( %args ) Initializes the connection object with %args attribute data. =head2 remote_host( ) The remote host connecting to the server as looked up via reverse dns. =head2 remote_ip( ) The remote IP address of the connecting host. =head2 remote_port( ) The remote port. =head2 remote_info( ) If your server does an ident lookup on the remote host, this is the identity of the remote client. =head2 local_ip( ) The local ip. =head2 local_port( ) The local port. =head2 hello( ) Either C<"helo"> or C<"ehlo"> depending on how the remote client greeted your server. NOTE: This field is empty during the helo or ehlo hooks, it is only set after a successful return from those hooks. =head2 hello_host( ) The host name specified in the C or C command. NOTE: This field is empty during the helo or ehlo hooks, it is only set after a successful return from those hooks. =head2 notes($key [, $value]) Get or set a note on the connection. This is a piece of data that you wish to attach to the connection and read somewhere else. For example you can use this to pass data between plugins. =head2 clone([%args]) Returns a copy of the Qpsmtpd::Connection object. The optional args parameter may contain: =over 4 =item no_reset (1|0) If true, do not reset the original connection object, the author has to care about that: only the cloned connection object is reset at the end of the connection =back =cut =head2 relay_client( ) True if the client is allowed to relay messages. =cut qpsmtpd-0.94/lib/Qpsmtpd/Constants.pm000066400000000000000000000052431240247602400176530ustar00rootroot00000000000000package Qpsmtpd::Constants; use strict; require Exporter; # log levels my %log_levels = ( LOGDEBUG => 7, LOGINFO => 6, LOGNOTICE => 5, LOGWARN => 4, LOGERROR => 3, LOGCRIT => 2, LOGALERT => 1, LOGEMERG => 0, LOGRADAR => 0, ); # return codes my %return_codes = ( OK => 900, DENY => 901, # 550 DENYSOFT => 902, # 450 DENYHARD => 903, # 550 + disconnect (deprecated in 0.29) DENY_DISCONNECT => 903, # 550 + disconnect DENYSOFT_DISCONNECT => 904, # 450 + disconnect DECLINED => 909, DONE => 910, CONTINUATION => 911, # deprecated - use YIELD YIELD => 911, ); use vars qw(@ISA @EXPORT); @ISA = qw(Exporter); @EXPORT = (keys(%return_codes), keys(%log_levels), "return_code", "log_level"); foreach (keys %return_codes) { eval "use constant $_ => " . $return_codes{$_}; } foreach (keys %log_levels) { eval "use constant $_ => " . $log_levels{$_}; } sub return_code { my $test = shift; if ($test =~ /^\d+$/) { # need to return the textural form foreach (keys %return_codes) { return $_ if $return_codes{$_} =~ /$test/; } } else { # just return the numeric value return $return_codes{$test}; } } sub log_level { my $test = shift; if ($test =~ /^\d+$/) { # need to return the textural form foreach (keys %log_levels) { return $_ if $log_levels{$_} =~ /$test/; } } else { # just return the numeric value return $log_levels{$test}; } } 1; =head1 NAME Qpsmtpd::Constants - Constants for plugins to use =head1 CONSTANTS See L for hook specific information on applicable constants. Constants available: =over 4 =item C Return this only from the queue phase to indicate the mail was queued successfully. =item C Returning this from a hook causes a 5xx error (hard failure) to be returned to the connecting client. =item C Returning this from a hook causes a 4xx error (temporary failure - try again later) to be returned to the connecting client. =item C Returning this from a hook implies success, but tells qpsmtpd to go on to the next plugin. =item C Returning this from a hook implies success, but tells qpsmtpd to skip any remaining plugins for this phase. =back =cut qpsmtpd-0.94/lib/Qpsmtpd/DSN.pm000066400000000000000000000321241240247602400163210ustar00rootroot00000000000000# # Enhanced Mail System Status Codes - RFC 1893 # package Qpsmtpd::DSN; use strict; use Qpsmtpd::Constants; =head1 NAME Qpsmtpd::DSN - Enhanced Mail System Status Codes - RFC 1893 =head1 DESCRIPTION The B implements the I from RFC 1893. =head1 USAGE Any B plugin can access these status codes. All sub routines are used the same way: use Qpsmtpd::DSN; ...; return Qpsmtpd::DSN->relaying_denied(); or return Qpsmtpd::DSN->relaying_denied("Relaying from $ip denied"); or return Qpsmtpd::DSN->relaying_denied(DENY,"Relaying from $ip denied"); If no status message was given, it will use the predefined one from the RFC. If the first argument is numeric, it will use this as a return code, else the default return code is used. See below which default return code is used in the different functions. The first example will return I<(DENY, "Relaying denied");> the others I<(DENY, "Relaying from $ip denied");> which will be returned to qpsmtpd. In those sub routines which don't start with I I've added a default message which describes the status better than the RFC message. =cut my @rfc1893 = ( [ "Other or Undefined Status", # x.0.x ], [ "Other address status.", # x.1.0 "Bad destination mailbox address.", # x.1.1 "Bad destination system address.", # x.1.2 "Bad destination mailbox address syntax.", # x.1.3 "Destination mailbox address ambiguous.", # x.1.4 "Destination address valid.", # x.1.5 "Destination mailbox has moved, No forwarding address.", # x.1.6 "Bad sender's mailbox address syntax.", # x.1.7 "Bad sender's system address.", # x.1.8 ], [ "Other or undefined mailbox status.", # x.2.0 "Mailbox disabled, not accepting messages.", # x.2.1 "Mailbox full.", # x.2.2 "Message length exceeds administrative limit.", # x.2.3 "Mailing list expansion problem.", # x.2.4 ], [ "Other or undefined mail system status.", # x.3.0 "Mail system full.", # x.3.1 "System not accepting network messages.", # x.3.2 "System not capable of selected features.", # x.3.3 "Message too big for system.", # x.3.4 "System incorrectly configured.", # x.3.5 ], [ "Other or undefined network or routing status.", # x.4.0 "No answer from host.", # x.4.1 "Bad connection.", # x.4.2 "Directory server failure.", # x.4.3 "Unable to route.", # x.4.4 "Mail system congestion.", # x.4.5 "Routing loop detected.", # x.4.6 "Delivery time expired.", # x.4.7 ], [ "Other or undefined protocol status.", # x.5.0 "Invalid command.", # x.5.1 "Syntax error.", # x.5.2 "Too many recipients.", # x.5.3 "Invalid command arguments.", # x.5.4 "Wrong protocol version.", # x.5.5 ], [ "Other or undefined media error.", # x.6.0 "Media not supported.", # x.6.1 "Conversion required and prohibited.", # x.6.2 "Conversion required but not supported.", # x.6.3 "Conversion with loss performed.", # x.6.4 "Conversion Failed.", # x.6.5 ], [ "Other or undefined security status.", # x.7.0 "Delivery not authorized, message refused.", # x.7.1 "Mailing list expansion prohibited.", # x.7.2 "Security conversion required but not possible.", # x.7.3 "Security features not supported.", # x.7.4 "Cryptographic failure.", # x.7.5 "Cryptographic algorithm not supported.", # x.7.6 "Message integrity failure.", # x.7.7 ], ); sub _status { my $return = shift; my $const = Qpsmtpd::Constants::return_code($return); if ($const =~ /^DENYSOFT/) { return 4; } elsif ($const =~ /^DENY/) { return 5; } elsif ($const eq 'OK' or $const eq 'DONE') { return 2; } else { # err .... no :) return 4; # just 2,4,5 are allowed.. temp error by default } } sub _dsn { my ($self, $return, $reason, $default, $subject, $detail) = @_; if (!defined $return) { $return = $default; } elsif ($return !~ /^\d+$/) { $reason = $return; $return = $default; } my $msg = $rfc1893[$subject][$detail]; unless (defined $msg) { $detail = 0; $msg = $rfc1893[$subject][$detail]; unless (defined $msg) { $subject = 0; $msg = $rfc1893[$subject][$detail]; } } my $class = &_status($return); if (defined $reason) { $msg = $reason; } return ($return, "$msg (#$class.$subject.$detail)"); } sub unspecified { shift->_dsn(shift, shift, DENYSOFT, 0, 0); } =head1 ADDRESS STATUS =over 9 =item addr_unspecified X.1.0 default: DENYSOFT =cut sub addr_unspecified { shift->_dsn(shift, shift, DENYSOFT, 1, 0); } =item no_such_user, addr_bad_dest_mbox X.1.1 default: DENY =cut sub no_such_user { shift->_dsn(shift, (shift || "No such user"), DENY, 1, 1); } sub addr_bad_dest_mbox { shift->_dsn(shift, shift, DENY, 1, 1); } =item addr_bad_dest_system X.1.2 default: DENY =cut sub addr_bad_dest_system { shift->_dsn(shift, shift, DENY, 1, 2); } =item addr_bad_dest_syntax X.1.3 default: DENY =cut sub addr_bad_dest_syntax { shift->_dsn(shift, shift, DENY, 1, 3); } =item addr_dest_ambigous X.1.4 default: DENYSOFT =cut sub addr_dest_ambigous { shift->_dsn(shift, shift, DENYSOFT, 1, 4); } =item addr_rcpt_ok X.1.5 default: OK =cut # XXX: do we need this? Maybe in all address verifying plugins? sub addr_rcpt_ok { shift->_dsn(shift, shift, OK, 1, 5); } =item addr_mbox_moved X.1.6 default: DENY =cut sub addr_mbox_moved { shift->_dsn(shift, shift, DENY, 1, 6); } =item addr_bad_from_syntax X.1.7 default: DENY =cut sub addr_bad_from_syntax { shift->_dsn(shift, shift, DENY, 1, 7); } =item addr_bad_from_system X.1.8 default: DENY =back =cut sub addr_bad_from_system { shift->_dsn(shift, shift, DENY, 1, 8); } =head1 MAILBOX STATUS =over 5 =item mbox_unspecified X.2.0 default: DENYSOFT =cut sub mbox_unspecified { shift->_dsn(shift, shift, DENYSOFT, 2, 0); } =item mbox_disabled X.2.1 default: DENY ...but RFC says: The mailbox exists, but is not accepting messages. This may be a permanent error if the mailbox will never be re-enabled or a transient error if the mailbox is only temporarily disabled. =cut sub mbox_disabled { shift->_dsn(shift, shift, DENY, 2, 1); } =item mbox_full X.2.2 default: DENYSOFT =cut sub mbox_full { shift->_dsn(shift, shift, DENYSOFT, 2, 2); } =item mbox_msg_too_long X.2.3 default: DENY =cut sub mbox_msg_too_long { shift->_dsn(shift, shift, DENY, 2, 3); } =item mbox_list_expansion_problem X.2.4 default: DENYSOFT =back =cut sub mbox_list_expansion_problem { shift->_dsn(shift, shift, DENYSOFT, 2, 4); } =head1 MAIL SYSTEM STATUS =over 4 =item sys_unspecified X.3.0 default: DENYSOFT =cut sub sys_unspecified { shift->_dsn(shift, shift, DENYSOFT, 3, 0); } =item sys_disk_full X.3.1 default: DENYSOFT =cut sub sys_disk_full { shift->_dsn(shift, shift, DENYSOFT, 3, 1); } =item sys_not_accepting_mail X.3.2 default: DENYSOFT =cut sub sys_not_accepting_mail { shift->_dsn(shift, shift, DENYSOFT, 3, 2); } =item sys_not_supported X.3.3 default: DENYSOFT Selected features specified for the message are not supported by the destination system. This can occur in gateways when features from one domain cannot be mapped onto the supported feature in another. =cut sub sys_not_supported { shift->_dsn(shift, shift, DENYSOFT, 3, 3); } =item sys_msg_too_big X.3.4 default DENY =back =cut sub sys_msg_too_big { shift->_dsn(shift, shift, DENY, 3, 4); } =head1 NETWORK AND ROUTING STATUS =cut =over 4 =item net_unspecified X.4.0 default: DENYSOFT =cut sub net_unspecified { shift->_dsn(shift, shift, DENYSOFT, 4, 0); } # not useful # sub net_no_answer { shift->_dsn(shift,shift,4,1); } # not useful # sub net_bad_connection { shift->_dsn(shift,shift,4,2); } =item net_directory_server_failed, temp_resolver_failed X.4.3 default: DENYSOFT =cut sub temp_resolver_failed { shift->_dsn(shift, (shift || "Temporary address resolution failure"), DENYSOFT, 4, 3); } sub net_directory_server_failed { shift->_dsn(shift, shift, DENYSOFT, 4, 3); } # not useful # sub net_unable_to_route { shift->_dsn(shift,shift,4,4); } =item net_system_congested X.4.5 default: DENYSOFT =cut sub net_system_congested { shift->_dsn(shift, shift, DENYSOFT, 4, 5); } =item net_routing_loop, too_many_hops X.4.6 default: DENY, but RFC says: A routing loop caused the message to be forwarded too many times, either because of incorrect routing tables or a user forwarding loop. This is useful only as a persistent transient error. Why do we want to DENYSOFT something like this? =back =cut sub net_routing_loop { shift->_dsn(shift, shift, DENY, 4, 6); } sub too_many_hops { shift->_dsn(shift, (shift || "Too many hops"), DENY, 4, 6,); } # not useful # sub delivery_time_expired { shift->_dsn(shift,shift,4,7); } =head1 MAIL DELIVERY PROTOCOL STATUS =over 6 =item proto_unspecified X.5.0 default: DENYSOFT =cut sub proto_unspecified { shift->_dsn(shift, shift, DENYSOFT, 5, 0); } =item proto_invalid_command X.5.1 default: DENY =cut sub proto_invalid_command { shift->_dsn(shift, shift, DENY, 5, 1); } =item proto_syntax_error X.5.2 default: DENY =cut sub proto_syntax_error { shift->_dsn(shift, shift, DENY, 5, 2); } =item proto_rcpt_list_too_long, too_many_rcpts X.5.3 default: DENYSOFT =cut sub proto_rcpt_list_too_long { shift->_dsn(shift, shift, DENYSOFT, 5, 3); } sub too_many_rcpts { shift->_dsn(shift, shift, DENYSOFT, 5, 3); } =item proto_invalid_cmd_args X.5.4 default: DENY =cut sub proto_invalid_cmd_args { shift->_dsn(shift, shift, DENY, 5, 4); } =item proto_wrong_version X.5.5 default: DENYSOFT =back =cut sub proto_wrong_version { shift->_dsn(shift, shift, DENYSOFT, 5, 5); } =head1 MESSAGE CONTENT OR MESSAGE MEDIA STATUS =over 5 =item media_unspecified X.6.0 default: DENYSOFT =cut sub media_unspecified { shift->_dsn(shift, shift, DENYSOFT, 6, 0); } =item media_unsupported X.6.1 default: DENY =cut sub media_unsupported { shift->_dsn(shift, shift, DENY, 6, 1); } =item media_conv_prohibited X.6.2 default: DENY =cut sub media_conv_prohibited { shift->_dsn(shift, shift, DENY, 6, 2); } =item media_conv_unsupported X.6.3 default: DENYSOFT =cut sub media_conv_unsupported { shift->_dsn(shift, shift, DENYSOFT, 6, 3); } =item media_conv_lossy X.6.4 default: DENYSOFT =back =cut sub media_conv_lossy { shift->_dsn(shift, shift, DENYSOFT, 6, 4); } =head1 SECURITY OR POLICY STATUS =over 8 =item sec_unspecified X.7.0 default: DENYSOFT =cut sub sec_unspecified { shift->_dsn(shift, shift, DENYSOFT, 7, 0); } =item sec_sender_unauthorized, bad_sender_ip, relaying_denied X.7.1 default: DENY =cut sub sec_sender_unauthorized { shift->_dsn(shift, shift, DENY, 7, 1); } sub bad_sender_ip { shift->_dsn(shift, (shift || "Bad sender's IP"), DENY, 7, 1,); } sub relaying_denied { shift->_dsn(shift, (shift || "Relaying denied"), DENY, 7, 1); } =item sec_list_dest_prohibited X.7.2 default: DENY =cut sub sec_list_dest_prohibited { shift->_dsn(shift, shift, DENY, 7, 2); } =item sec_conv_failed X.7.3 default: DENY =cut sub sec_conv_failed { shift->_dsn(shift, shift, DENY, 7, 3); } =item sec_feature_unsupported X.7.4 default: DENY =cut sub sec_feature_unsupported { shift->_dsn(shift, shift, DENY, 7, 4); } =item sec_crypto_failure X.7.5 default: DENY =cut sub sec_crypto_failure { shift->_dsn(shift, shift, DENY, 7, 5); } =item sec_crypto_algorithm_unsupported X.7.6 default: DENYSOFT =cut sub sec_crypto_algorithm_unsupported { shift->_dsn(shift, shift, DENYSOFT, 7, 6); } =item sec_msg_integrity_failure X.7.7 default: DENY =back =cut sub sec_msg_integrity_failure { shift->_dsn(shift, shift, DENY, 7, 7); } 1; # vim: st=4 sw=4 expandtab qpsmtpd-0.94/lib/Qpsmtpd/Plugin.pm000066400000000000000000000226171240247602400171410ustar00rootroot00000000000000package Qpsmtpd::Plugin; use strict; use warnings; use Net::DNS; use Qpsmtpd::Constants; # more or less in the order they will fire our @hooks = qw( logging config post-fork pre-connection connect ehlo_parse ehlo helo_parse helo auth_parse auth auth-plain auth-login auth-cram-md5 rcpt_parse rcpt_pre rcpt mail_parse mail mail_pre data data_headers_end data_post queue_pre queue queue_post vrfy noop quit reset_transaction disconnect post-connection unrecognized_command deny ok received_line help ); our %hooks = map { $_ => 1 } @hooks; sub new { my $proto = shift; my $class = ref($proto) || $proto; bless({}, $class); } sub hook_name { return shift->{_hook}; } sub register_hook { my ($plugin, $hook, $method, $unshift) = @_; die $plugin->plugin_name . " : Invalid hook: $hook" unless $hooks{$hook}; $plugin->{_qp}->log(LOGDEBUG, $plugin->plugin_name, "hooking", $hook) unless $hook =~ /logging/; # can't log during load_logging() # I can't quite decide if it's better to parse this code ref or if # we should pass the plugin object and method name ... hmn. $plugin->qp->_register_hook( $hook, { code => sub { local $plugin->{_qp} = shift; local $plugin->{_hook} = $hook; $plugin->$method(@_); }, name => $plugin->plugin_name, }, $unshift, ); } sub _register { my $self = shift; my $qp = shift; local $self->{_qp} = $qp; $self->init($qp, @_) if $self->can('init'); $self->_register_standard_hooks($qp, @_); $self->register($qp, @_) if $self->can('register'); } sub qp { shift->{_qp}; } sub log { my $self = shift; return if defined $self->{_hook} && $self->{_hook} eq 'logging'; my $level = $self->adjust_log_level(shift, $self->plugin_name); $self->{_qp}->varlog($level, $self->{_hook}, $self->plugin_name, @_); } sub adjust_log_level { my ($self, $cur_level, $plugin_name) = @_; my $adj = $self->{_args}{loglevel} or return $cur_level; return $adj if $adj =~ m/^[01234567]$/; # a raw syslog numeral if ($adj !~ /^[\+\-][\d]$/) { $self->log(LOGERROR, $self - "invalid $plugin_name loglevel setting ($adj)"); undef $self->{_args}{loglevel}; # only complain once per plugin return $cur_level; } my $operator = substr($adj, 0, 1); my $adjust = substr($adj, -1, 1); my $new_level = $operator eq '+' ? $cur_level + $adjust : $cur_level - $adjust; $new_level = 7 if $new_level > 7; $new_level = 0 if $new_level < 0; return $new_level; } sub transaction { # not sure if this will work in a non-forking or a threaded daemon shift->qp->transaction; } sub connection { shift->qp->connection; } sub spool_dir { shift->qp->spool_dir; } sub auth_user { shift->qp->auth_user; } sub auth_mechanism { shift->qp->auth_mechanism; } sub temp_file { my $self = shift; my $tempfile = $self->qp->temp_file; push @{$self->qp->transaction->{_temp_files}}, $tempfile; return $tempfile; } sub temp_dir { my $self = shift; my $tempdir = $self->qp->temp_dir(); push @{$self->qp->transaction->{_temp_dirs}}, $tempdir; return $tempdir; } # plugin inheritance: # usage: # sub init { # my $self = shift; # $self->isa_plugin("rhsbl"); # $self->SUPER::register(@_); # } sub isa_plugin { my ($self, $parent) = @_; my ($currentPackage) = caller; my $cleanParent = $parent; $cleanParent =~ s/\W/_/g; my $newPackage = $currentPackage . "::_isa_$cleanParent"; # don't reload plugins if they are already loaded return if defined &{"${newPackage}::plugin_name"}; # find $parent in plugin_dirs my $parent_dir; for ($self->qp->plugin_dirs) { if (-e "$_/$parent") { $parent_dir = $_; last; } } die "cannot find plugin '$parent'" unless $parent_dir; $self->compile($self->plugin_name . "_isa_$cleanParent", $newPackage, "$parent_dir/$parent"); warn "---- $newPackage\n"; no strict 'refs'; push @{"${currentPackage}::ISA"}, $newPackage; } # why isn't compile private? it's only called from Plugin and Qpsmtpd. sub compile { my ($class, $plugin, $package, $file, $test_mode, $orig_name) = @_; my $sub; open F, $file or die "could not open $file: $!"; { local $/ = undef; $sub = ; } close F; my $line = "\n#line 0 $file\n"; if ($test_mode) { if (open(F, "t/plugin_tests/$orig_name")) { local $/ = undef; $sub .= "#line 1 t/plugin_tests/$orig_name\n"; $sub .= ; close F; } } my $eval = join( "\n", "package $package;", 'use Qpsmtpd::Constants;', "require Qpsmtpd::Plugin;", 'use vars qw(@ISA);', 'use strict;', '@ISA = qw(Qpsmtpd::Plugin);', ($test_mode ? 'use Test::More;' : ''), "sub plugin_name { qq[$plugin] }", $line, $sub, "\n", # last line comment without newline? ); #warn "eval: $eval"; $eval =~ m/(.*)/s; $eval = $1; eval $eval; die "eval $@" if $@; } sub get_reject { my $self = shift; my $smtp_mess = shift || "unspecified error"; my $log_mess = shift || ''; $log_mess = ", $log_mess" if $log_mess; my $reject = $self->{_args}{reject}; if (defined $reject && !$reject) { $self->log(LOGINFO, "fail, tolerated" . $log_mess); return DECLINED; } # the naughty plugin will reject later if ($reject eq 'naughty') { $self->log(LOGINFO, "fail, NAUGHTY" . $log_mess); return $self->store_deferred_reject($smtp_mess); } # they asked for reject, we give them reject $self->log(LOGINFO, "fail" . $log_mess); return ($self->get_reject_type(), $smtp_mess); } sub get_reject_type { my $self = shift; my $default = shift || DENY; my $deny = shift || $self->{_args}{reject_type} or return $default; return $deny =~ /^(temp|soft)$/i ? DENYSOFT : $deny =~ /^(perm|hard)$/i ? DENY : $deny eq 'disconnect' ? DENY_DISCONNECT : $deny eq 'temp_disconnect' ? DENYSOFT_DISCONNECT : $default; } sub store_deferred_reject { my ($self, $smtp_mess) = @_; # store the reject message that the naughty plugin will return later if (!$self->connection->notes('naughty')) { $self->connection->notes('naughty', $smtp_mess); } else { # append this reject message to the message my $prev = $self->connection->notes('naughty'); $self->connection->notes('naughty', "$prev\015\012$smtp_mess"); } if (!$self->connection->notes('naughty_reject_type')) { $self->connection->notes('naughty_reject_type', $self->{_args}{reject_type}); } return (DECLINED); } sub store_auth_results { my ($self, $result) = @_; my $auths = $self->qp->connection->notes('authentication_results') or do { $self->qp->connection->notes('authentication_results', $result); return; }; my $ar = join('; ', $auths, $result); $self->log(LOGDEBUG, "auth-results: $ar"); $self->qp->connection->notes('authentication_results', $ar ); }; sub init_resolver { my $self = shift; my $timeout = $self->{_args}{dns_timeout} || shift || 5; return $self->{_resolver} if $self->{_resolver}; $self->log(LOGDEBUG, "initializing Net::DNS::Resolver"); $self->{_resolver} = Net::DNS::Resolver->new(dnsrch => 0); $self->{_resolver}->tcp_timeout($timeout); $self->{_resolver}->udp_timeout($timeout); return $self->{_resolver}; } sub is_immune { my $self = shift; if ($self->qp->connection->relay_client()) { # set by plugins/relay, or Qpsmtpd::Auth $self->log(LOGINFO, "skip, relay client"); return 1; } if ($self->qp->connection->notes('whitelisthost')) { # set by plugins/dns_whitelist_soft or plugins/whitelist $self->log(LOGINFO, "skip, whitelisted host"); return 1; } if ($self->qp->transaction->notes('whitelistsender')) { # set by plugins/whitelist $self->log(LOGINFO, "skip, whitelisted sender"); return 1; } return; } sub is_naughty { my ($self, $setit) = @_; # see plugins/naughty return $self->connection->notes('naughty') if ! defined $setit; $self->connection->notes('naughty', $setit); $self->connection->notes('rejected', $setit); if ($self->connection->notes('naughty')) { $self->log(LOGINFO, "skip, naughty"); return 1; } if ($self->connection->notes('rejected')) { # http://www.steve.org.uk/Software/ms-lite/ $self->log(LOGINFO, "skip, already rejected"); return 1; } return; } sub adjust_karma { my ($self, $value) = @_; my $karma = $self->connection->notes('karma') || 0; $karma += $value; $self->log(LOGINFO, "karma $value ($karma)"); $self->connection->notes('karma', $karma); return $value; } sub _register_standard_hooks { my ($plugin, $qp) = @_; for my $hook (@hooks) { my $hooksub = "hook_$hook"; $hooksub =~ s/\W/_/g; $plugin->register_hook($hook, $hooksub) if ($plugin->can($hooksub)); } } 1; qpsmtpd-0.94/lib/Qpsmtpd/Plugin/000077500000000000000000000000001240247602400165735ustar00rootroot00000000000000qpsmtpd-0.94/lib/Qpsmtpd/Plugin/Async/000077500000000000000000000000001240247602400176505ustar00rootroot00000000000000qpsmtpd-0.94/lib/Qpsmtpd/Plugin/Async/DNSBLBase.pm000066400000000000000000000045421240247602400216500ustar00rootroot00000000000000package Qpsmtpd::Plugin::Async::DNSBLBase; # Class methods shared by the async plugins using DNS based blacklists or # whitelists. use strict; use Qpsmtpd::Constants; use ParaDNS; sub lookup { my ($class, $qp, $A_lookups, $TXT_lookups) = @_; my $total_zones = @$A_lookups + @$TXT_lookups; my ($A_pdns, $TXT_pdns); if (@$A_lookups) { $qp->log(LOGDEBUG, "Checking ", join(", ", @$A_lookups), " for A record in the background"); $A_pdns = ParaDNS->new( callback => sub { my ($result, $query) = @_; return if $result !~ /^\d+\.\d+\.\d+\.\d+$/; $qp->log(LOGDEBUG, "Result for A $query: $result"); $class->process_a_result($qp, $result, $query); }, finished => sub { $total_zones -= @$A_lookups; $class->finished($qp, $total_zones); }, hosts => [@$A_lookups], type => 'A', client => $qp->input_sock, ); return unless defined $A_pdns; } if (@$TXT_lookups) { $qp->log(LOGDEBUG, "Checking ", join(", ", @$TXT_lookups), " for TXT record in the background"); $TXT_pdns = ParaDNS->new( callback => sub { my ($result, $query) = @_; return if $result !~ /[a-z]/; $qp->log(LOGDEBUG, "Result for TXT $query: $result"); $class->process_txt_result($qp, $result, $query); }, finished => sub { $total_zones -= @$TXT_lookups; $class->finished($qp, $total_zones); }, hosts => [@$TXT_lookups], type => 'TXT', client => $qp->input_sock, ); unless (defined $TXT_pdns) { undef $A_pdns; return; } } return 1; } sub finished { my ($class, $qp, $total_zones) = @_; $qp->log(LOGDEBUG, "Finished ($total_zones)"); $qp->run_continuation unless $total_zones; } # plugins should implement the following two methods to do something # useful with the results sub process_a_result { my ($class, $qp, $result, $query) = @_; } sub process_txt_result { my ($class, $qp, $result, $query) = @_; } 1; qpsmtpd-0.94/lib/Qpsmtpd/PollServer.pm000066400000000000000000000235661240247602400200040ustar00rootroot00000000000000package Qpsmtpd::PollServer; use base ('Danga::Client', 'Qpsmtpd::SMTP'); # use fields required to be a subclass of Danga::Client. Have to include # all fields used by Qpsmtpd.pm here too. use fields qw( input_sock mode header_lines in_header data_size max_size hooks start_time cmd_timeout conn _auth _auth_mechanism _auth_state _auth_ticket _auth_user _commands _config_cache _connection _continuation _extras _test_mode _transaction ); use Qpsmtpd::Constants; use Qpsmtpd::Address; use ParaDNS; use Mail::Header; use POSIX qw(strftime); use Socket qw(inet_aton AF_INET CRLF); use Time::HiRes qw(time); use strict; sub max_idle_time { 60 } sub max_connect_time { 1200 } sub input_sock { my $self = shift; @_ and $self->{input_sock} = shift; $self->{input_sock} || $self; } sub new { my Qpsmtpd::PollServer $self = shift; $self = fields::new($self) unless ref $self; $self->SUPER::new(@_); $self->{cmd_timeout} = 5; $self->{start_time} = time; $self->{mode} = 'connect'; $self->load_plugins; $self->load_logging; my ($rc, @msg) = $self->run_hooks_no_respond("pre-connection"); if ($rc == DENYSOFT || $rc == DENYSOFT_DISCONNECT) { @msg = ("Sorry, try again later") unless @msg; $self->respond(451, @msg); $self->disconnect; } elsif ($rc == DENY || $rc == DENY_DISCONNECT) { @msg = ("Sorry, service not available for you") unless @msg; $self->respond(550, @msg); $self->disconnect; } return $self; } sub uptime { my Qpsmtpd::PollServer $self = shift; return (time() - $self->{start_time}); } sub reset_for_next_message { my Qpsmtpd::PollServer $self = shift; $self->SUPER::reset_for_next_message(@_); $self->{_commands} = { ehlo => 1, helo => 1, rset => 1, mail => 1, rcpt => 1, data => 1, help => 1, vrfy => 1, noop => 1, quit => 1, auth => 0, # disabled by default }; $self->{mode} = 'cmd'; $self->{_extras} = {}; } sub respond { my Qpsmtpd::PollServer $self = shift; my ($code, @messages) = @_; while (my $msg = shift @messages) { my $line = $code . (@messages ? "-" : " ") . $msg; $self->write("$line\r\n"); } return 1; } sub fault { my Qpsmtpd::PollServer $self = shift; $self->SUPER::fault(@_); return; } my %cmd_cache; sub process_line { my Qpsmtpd::PollServer $self = shift; my $line = shift || return; if ($::DEBUG > 1) { print "$$:" . ($self + 0) . "C($self->{mode}): $line"; } if ($self->{mode} eq 'cmd') { $line =~ s/\r?\n$//s; $self->connection->notes('original_string', $line); my ($cmd, @params) = split(/ +/, $line, 2); my $meth = lc($cmd); if (my $lookup = $cmd_cache{$meth} || $self->{_commands}->{$meth} && $self->can($meth)) { $cmd_cache{$meth} = $lookup; eval { $lookup->($self, @params); }; if ($@) { my $error = $@; chomp($error); $self->log(LOGERROR, "Command Error: $error"); $self->fault("command '$cmd' failed unexpectedly"); } } else { # No such method - i.e. unrecognized command my ($rc, $msg) = $self->run_hooks("unrecognized_command", $meth, @params); } } elsif ($self->{mode} eq 'connect') { $self->{mode} = 'cmd'; # I've removed an eval{} from around this. It shouldn't ever die() # but if it does we're a bit screwed... Ah well :-) $self->start_conversation; } else { die "Unknown mode"; } return; } sub disconnect { my Qpsmtpd::PollServer $self = shift; $self->SUPER::disconnect(@_); $self->close; } sub close { my Qpsmtpd::PollServer $self = shift; $self->run_hooks_no_respond("post-connection"); $self->connection->reset; $self->SUPER::close; } sub start_conversation { my Qpsmtpd::PollServer $self = shift; my $conn = $self->connection; # set remote_host, remote_ip and remote_port my ($ip, $port) = split(/:/, $self->peer_addr_string); return $self->close() unless $ip; $conn->remote_ip($ip); $conn->remote_port($port); $conn->remote_info("[$ip]"); my ($lip, $lport) = split(/:/, $self->local_addr_string); $conn->local_ip($lip); $conn->local_port($lport); ParaDNS->new( finished => sub { $self->continue_read(); $self->run_hooks("connect") }, # NB: Setting remote_info to the same as remote_host callback => sub { $conn->remote_info($conn->remote_host($_[0])) }, host => $ip, ); return; } sub data { my Qpsmtpd::PollServer $self = shift; my ($rc, $msg) = $self->run_hooks("data"); return 1; } sub data_respond { my Qpsmtpd::PollServer $self = shift; my ($rc, $msg) = @_; if ($rc == DONE) { return; } elsif ($rc == DENY) { $msg->[0] ||= "Message denied"; $self->respond(554, @$msg); $self->reset_transaction(); return; } elsif ($rc == DENYSOFT) { $msg->[0] ||= "Message denied temporarily"; $self->respond(451, @$msg); $self->reset_transaction(); return; } elsif ($rc == DENY_DISCONNECT) { $msg->[0] ||= "Message denied"; $self->respond(554, @$msg); $self->disconnect; return; } elsif ($rc == DENYSOFT_DISCONNECT) { $msg->[0] ||= "Message denied temporarily"; $self->respond(451, @$msg); $self->disconnect; return; } return $self->respond(503, "MAIL first") unless $self->transaction->sender; return $self->respond(503, "RCPT first") unless $self->transaction->recipients; $self->{header_lines} = ''; $self->{data_size} = 0; $self->{in_header} = 1; $self->{max_size} = ($self->config('databytes'))[0] || 0; $self->log(LOGDEBUG, "max_size: $self->{max_size} / size: $self->{data_size}"); $self->respond(354, "go ahead"); my $max_get = $self->{max_size} || 1048576; $self->get_chunks($max_get, sub { $self->got_data($_[0]) }); return 1; } sub got_data { my Qpsmtpd::PollServer $self = shift; my $data = shift; my $done = 0; my $remainder; if ($data =~ s/^\.\r\n(.*)\z//ms) { $remainder = $1; $done = 1; } # add a transaction->blocked check back here when we have line by line plugin access... unless (($self->{max_size} and $self->{data_size} > $self->{max_size})) { $data =~ s/\r\n/\n/mg; $data =~ s/^\.\./\./mg; if ($self->{in_header}) { $self->{header_lines} .= $data; if ($self->{header_lines} =~ s/\n(\n.*)\z/\n/ms) { $data = $1; # end of headers $self->{in_header} = 0; # ... need to check that we don't reformat any of the received lines. # # 3.8.2 Received Lines in Gatewaying # When forwarding a message into or out of the Internet environment, a # gateway MUST prepend a Received: line, but it MUST NOT alter in any # way a Received: line that is already in the header. my @header_lines = split(/^/m, $self->{header_lines}); my $header = Mail::Header->new( \@header_lines, Modify => 0, MailFrom => "COERCE" ); $self->transaction->header($header); $self->transaction->body_write($self->{header_lines}); $self->{header_lines} = ''; #$header->add("X-SMTPD", "qpsmtpd/".$self->version.", http://smtpd.develooper.com/"); # FIXME - call plugins to work on just the header here; can # save us buffering the mail content. # Save the start of just the body itself $self->transaction->set_body_start(); } } $self->transaction->body_write(\$data); $self->{data_size} += length $data; } if ($done) { $self->end_of_data; $self->end_get_chunks($remainder); } } sub end_of_data { my Qpsmtpd::PollServer $self = shift; #$self->log(LOGDEBUG, "size is at $size\n") unless ($i % 300); $self->log(LOGDEBUG, "max_size: $self->{max_size} / size: $self->{data_size}"); my $header = $self->transaction->header; if (!$header) { $header = Mail::Header->new(Modify => 0, MailFrom => "COERCE"); $self->transaction->header($header); } my $smtp = $self->connection->hello eq "ehlo" ? "ESMTP" : "SMTP"; my $esmtp = substr($smtp, 0, 1) eq "E"; my $authheader; my $sslheader; if (defined $self->connection->notes('tls_enabled') and $self->connection->notes('tls_enabled')) { $smtp .= "S" if $esmtp; # RFC3848 $sslheader = "(" . $self->connection->notes('tls_socket')->get_cipher() . " encrypted) "; } if (defined $self->{_auth} and $self->{_auth} == OK) { $smtp .= "A" if $esmtp; # RFC3848 $authheader = "(smtp-auth username $self->{_auth_user}, mechanism $self->{_auth_mechanism})\n"; } $header->add("Received", $self->received_line($smtp, $authheader, $sslheader), 0); return $self->respond(552, "Message too big!") if $self->{max_size} and $self->{data_size} > $self->{max_size}; my ($rc, $msg) = $self->run_hooks("data_post"); return 1; } 1; qpsmtpd-0.94/lib/Qpsmtpd/Postfix.pm000066400000000000000000000137051240247602400173350ustar00rootroot00000000000000package Qpsmtpd::Postfix; =head1 NAME Qpsmtpd::Postfix - postfix queueing support for qpsmtpd =head2 DESCRIPTION This package implements the protocol Postfix servers use to communicate with each other. See src/global/rec_type.h in the postfix source for details. =cut use strict; use IO::Socket::UNIX; use IO::Socket::INET; use vars qw(@ISA); @ISA = qw(IO::Socket::UNIX); my %rec_types; sub init { my ($self) = @_; %rec_types = ( REC_TYPE_SIZE => 'C', # first record, created by cleanup REC_TYPE_TIME => 'T', # time stamp, required REC_TYPE_FULL => 'F', # full name, optional REC_TYPE_INSP => 'I', # inspector transport REC_TYPE_FILT => 'L', # loop filter transport REC_TYPE_FROM => 'S', # sender, required REC_TYPE_DONE => 'D', # delivered recipient, optional REC_TYPE_RCPT => 'R', # todo recipient, optional REC_TYPE_ORCP => 'O', # original recipient, optional REC_TYPE_WARN => 'W', # warning message time REC_TYPE_ATTR => 'A', # named attribute for extensions REC_TYPE_MESG => 'M', # start message records REC_TYPE_CONT => 'L', # long data record REC_TYPE_NORM => 'N', # normal data record REC_TYPE_XTRA => 'X', # start extracted records REC_TYPE_RRTO => 'r', # return-receipt, from headers REC_TYPE_ERTO => 'e', # errors-to, from headers REC_TYPE_PRIO => 'P', # priority REC_TYPE_VERP => 'V', # VERP delimiters REC_TYPE_END => 'E', # terminator, required ); } sub print_rec { my ($self, $type, @list) = @_; die "unknown record type" unless ($rec_types{$type}); $self->print($rec_types{$type}); # the length is a little endian base-128 number where each # byte except the last has the high bit set: my $s = "@list"; my $ln = length($s); while ($ln >= 0x80) { my $lnl = $ln & 0x7F; $ln >>= 7; $self->print(chr($lnl | 0x80)); } $self->print(chr($ln)); $self->print($s); } sub print_rec_size { my ($self, $content_size, $data_offset, $rcpt_count) = @_; my $s = sprintf("%15ld %15ld %15ld", $content_size, $data_offset, $rcpt_count); $self->print_rec('REC_TYPE_SIZE', $s); } sub print_rec_time { my ($self, $time) = @_; $time = time() unless (defined($time)); my $s = sprintf("%d", $time); $self->print_rec('REC_TYPE_TIME', $s); } sub open_cleanup { my ($class, $socket) = @_; my $self; if ($socket =~ m#^(/.+)#) { $socket = $1; # un-taint socket path $self = IO::Socket::UNIX->new(Type => SOCK_STREAM, Peer => $socket) if $socket; } elsif ($socket =~ /(.*):(\d+)/) { my ($host, $port) = ($1, $2); # un-taint address and port $self = IO::Socket::INET->new( Proto => 'tcp', PeerAddr => $host, PeerPort => $port ) if $host and $port; } unless (ref $self) { warn "Couldn't open \"$socket\": $!"; return; } # allow buffered writes $self->autoflush(0); bless($self, $class); $self->init(); return $self; } sub print_attr { my ($self, @kv) = @_; for (@kv) { $self->print("$_\0"); } $self->print("\0"); } sub get_attr { my ($self) = @_; local $/ = "\0"; my %kv; for (; ;) { my $k = $self->getline; chomp($k); last unless ($k); my $v = $self->getline; chomp($v); $kv{$k} = $v; } return %kv; } =head2 print_msg_line($line) print one line of a message to cleanup. This removes any linefeed characters from the end of the line and splits the line across several records if it is longer than 1024 chars. =cut sub print_msg_line { my ($self, $line) = @_; $line =~ s/\r?\n$//s; # split into 1k chunks. while (length($line) > 1024) { my $s = substr($line, 0, 1024); $line = substr($line, 1024); $self->print_rec('REC_TYPE_CONT', $s); } $self->print_rec('REC_TYPE_NORM', $line); } =head2 inject_mail($transaction) (class method) inject mail in $transaction into postfix queue via cleanup. $transaction is supposed to be a Qpsmtpd::Transaction object. =cut sub inject_mail { my ($class, $transaction) = @_; my @sockets = @{$transaction->notes('postfix-queue-sockets') // ['/var/spool/postfix/public/cleanup']}; my $strm; $strm = $class->open_cleanup($_) and last for @sockets; die "Unable to open any cleanup sockets!" unless $strm; my %at = $strm->get_attr; my $qid = $at{queue_id}; print STDERR "qid=$qid\n"; $strm->print_attr('flags' => $transaction->notes('postfix-queue-flags')); $strm->print_rec_time(); $strm->print_rec('REC_TYPE_FROM', $transaction->sender->address || ""); for (map { $_->address } $transaction->recipients) { $strm->print_rec('REC_TYPE_RCPT', $_); } # add an empty message length record. # cleanup is supposed to understand that. # see src/pickup/pickup.c $strm->print_rec('REC_TYPE_MESG', ""); # a received header has already been added in SMTP.pm # so we can just copy the message: my $hdr = $transaction->header->as_string; for (split(/\r?\n/, $hdr)) { print STDERR "hdr: $_\n"; $strm->print_msg_line($_); } $transaction->body_resetpos; while (my $line = $transaction->body_getline) { # print STDERR "body: $line\n"; $strm->print_msg_line($line); } # finish it. $strm->print_rec('REC_TYPE_XTRA', ""); $strm->print_rec('REC_TYPE_END', ""); $strm->flush(); %at = $strm->get_attr; my $status = $at{status}; my $reason = $at{reason}; $strm->close(); return wantarray ? ($status, $qid, $reason || "") : $status; } 1; # vim:sw=2 qpsmtpd-0.94/lib/Qpsmtpd/Postfix/000077500000000000000000000000001240247602400167715ustar00rootroot00000000000000qpsmtpd-0.94/lib/Qpsmtpd/Postfix/Constants.pm000066400000000000000000000066661240247602400213210ustar00rootroot00000000000000# # Qpsmtpd::Postfix::Constants # # This is a generated file, do not edit # # created by pf2qp.pl v0.1 @ Sun Oct 29 09:10:18 2006 # postfix version 2.4 # package Qpsmtpd::Postfix::Constants; use Qpsmtpd::Constants; require Exporter; use vars qw(@ISA @EXPORT %cleanup_soft %cleanup_hard $postfix_version); use strict; @ISA = qw(Exporter); @EXPORT = qw( %cleanup_soft %cleanup_hard $postfix_version CLEANUP_FLAG_NONE CLEANUP_FLAG_BOUNCE CLEANUP_FLAG_FILTER CLEANUP_FLAG_HOLD CLEANUP_FLAG_DISCARD CLEANUP_FLAG_BCC_OK CLEANUP_FLAG_MAP_OK CLEANUP_FLAG_MILTER CLEANUP_FLAG_FILTER_ALL CLEANUP_FLAG_MASK_EXTERNAL CLEANUP_FLAG_MASK_INTERNAL CLEANUP_FLAG_MASK_EXTRA CLEANUP_STAT_OK CLEANUP_STAT_BAD CLEANUP_STAT_WRITE CLEANUP_STAT_SIZE CLEANUP_STAT_CONT CLEANUP_STAT_HOPS CLEANUP_STAT_RCPT CLEANUP_STAT_PROXY CLEANUP_STAT_DEFER CLEANUP_STAT_MASK_CANT_BOUNCE CLEANUP_STAT_MASK_INCOMPLETE ); $postfix_version = "2.4"; use constant CLEANUP_FLAG_NONE => 0; # /* No special features */ use constant CLEANUP_FLAG_BOUNCE => (1 << 0); # /* Bounce bad messages */ use constant CLEANUP_FLAG_FILTER => (1 << 1); # /* Enable header/body checks */ use constant CLEANUP_FLAG_HOLD => (1 << 2); # /* Place message on hold */ use constant CLEANUP_FLAG_DISCARD => (1 << 3); # /* Discard message silently */ use constant CLEANUP_FLAG_BCC_OK => (1 << 4) ; # /* Ok to add auto-BCC addresses */ use constant CLEANUP_FLAG_MAP_OK => (1 << 5); # /* Ok to map addresses */ use constant CLEANUP_FLAG_MILTER => (1 << 6); # /* Enable Milter applications */ use constant CLEANUP_FLAG_FILTER_ALL => (CLEANUP_FLAG_FILTER | CLEANUP_FLAG_MILTER); use constant CLEANUP_FLAG_MASK_EXTERNAL => (CLEANUP_FLAG_FILTER_ALL | CLEANUP_FLAG_BCC_OK | CLEANUP_FLAG_MAP_OK); use constant CLEANUP_FLAG_MASK_INTERNAL => CLEANUP_FLAG_MAP_OK; use constant CLEANUP_FLAG_MASK_EXTRA => (CLEANUP_FLAG_HOLD | CLEANUP_FLAG_DISCARD); use constant CLEANUP_STAT_OK => 0; # /* Success. */ use constant CLEANUP_STAT_BAD => (1 << 0); # /* Internal protocol error */ use constant CLEANUP_STAT_WRITE => (1 << 1); # /* Error writing message file */ use constant CLEANUP_STAT_SIZE => (1 << 2); # /* Message file too big */ use constant CLEANUP_STAT_CONT => (1 << 3); # /* Message content rejected */ use constant CLEANUP_STAT_HOPS => (1 << 4); # /* Too many hops */ use constant CLEANUP_STAT_RCPT => (1 << 6); # /* No recipients found */ use constant CLEANUP_STAT_PROXY => (1 << 7); # /* Proxy reject */ use constant CLEANUP_STAT_DEFER => (1 << 8); # /* Temporary reject */ use constant CLEANUP_STAT_MASK_CANT_BOUNCE => (CLEANUP_STAT_BAD | CLEANUP_STAT_WRITE | CLEANUP_STAT_DEFER); use constant CLEANUP_STAT_MASK_INCOMPLETE => (CLEANUP_STAT_BAD | CLEANUP_STAT_WRITE | CLEANUP_STAT_SIZE | CLEANUP_STAT_DEFER); %cleanup_soft = ( CLEANUP_STAT_DEFER => "service unavailable (#4.7.1)", CLEANUP_STAT_PROXY => "queue file write error (#4.3.0)", CLEANUP_STAT_BAD => "internal protocol error (#4.3.0)", CLEANUP_STAT_WRITE => "queue file write error (#4.3.0)", ); %cleanup_hard = ( CLEANUP_STAT_RCPT => "no recipients specified (#5.1.0)", CLEANUP_STAT_HOPS => "too many hops (#5.4.0)", CLEANUP_STAT_SIZE => "message file too big (#5.3.4)", CLEANUP_STAT_CONT => "message content rejected (#5.7.1)", ); 1; qpsmtpd-0.94/lib/Qpsmtpd/Postfix/pf2qp.pl000077500000000000000000000052341240247602400203650ustar00rootroot00000000000000#/usr/bin/perl -w # # my $version = "0.1"; $0 =~ s#.*/##; my $path = $&; # sneaky way to get path back my $POSTFIX_SRC = shift || die <<"EOF"; Usage: $0 /path/to/postfix/source EOF my $header = "$POSTFIX_SRC/src/global/cleanup_user.h"; my $src = "$POSTFIX_SRC/src/global/cleanup_strerror.c"; my $pf_vers = "$POSTFIX_SRC/src/global/mail_version.h"; my $postfix_version = ""; open VERS, $pf_vers or die "Could not open $pf_vers: $!\n"; while () { next unless /^\s*#\s*define\s+MAIL_VERSION_NUMBER\s+"(.+)"\s*$/; $postfix_version = $1; last; } close VERS; $postfix_version =~ s/^(\d+\.\d+).*/$1/; if ($postfix_version < 2.3) { die "Need at least postfix v2.3"; } my $start = <<'_END'; # # Qpsmtpd::Postfix::Constants # # This is a generated file, do not edit # _END $start .= "# created by $0 v$version @ ".scalar(gmtime)."\n" ."# postfix version $postfix_version\n" ."#\n"; $start .= <<'_END'; package Qpsmtpd::Postfix::Constants; use Qpsmtpd::Constants; require Exporter; use vars qw(@ISA @EXPORT %cleanup_soft %cleanup_hard $postfix_version); use strict; @ISA = qw(Exporter); _END my @export = qw(%cleanup_soft %cleanup_hard $postfix_version); my @out = (); open HEAD, $header or die "Could not open $header: $!\n"; while () { while (s/\\\n$//) { $_ .= ; } chomp; if (/^\s*#define\s/) { s/^\s*#define\s*//; next if /^_/; s#(/\*.*\*/)##; my $comment = $1 || ""; my @words = split / /, $_; my $const = shift @words; if ($const eq "CLEANUP_STAT_OK") { push @out, ""; } push @export, $const; push @out, "use constant $const => ". join(" ", @words). "; " .($comment ? "# $comment ": ""); } } close HEAD; open SRC, $src or die "Could not open $src: $!\n"; my $data; { local $/ = undef; $data = ; } close SRC; $data =~ s/.*cleanup_stat_map\[\]\s*=\s*{\s*\n//s; $data =~ s/};.*$//s; my @array = split "\n", $data; my (@denysoft,@denyhard); foreach (@array) { chomp; s/,/ => /; s/"(\d\.\d\.\d)",\s+"(.*)",/"$2 (#$1)",/; s!(/\*.*\*/)!# $1!; s/4\d\d,\s// && push @denysoft, $_; s/5\d\d,\s// && push @denyhard, $_; } open my $CONSTANTS, '>', "$path/Constants.pm"; print ${CONSTANTS} $start, '@EXPORT = qw(', "\n"; while (@export) { print ${CONSTANTS} "\t", shift @export, "\n"; } print ${CONSTANTS} ");\n\n", "\$postfix_version = \"$postfix_version\";\n", join("\n", @out),"\n\n"; print ${CONSTANTS} "\%cleanup_soft = (\n", join("\n", @denysoft), "\n);\n\n"; print ${CONSTANTS} "\%cleanup_hard = (\n", join("\n", @denyhard), "\n);\n\n1;\n"; close $CONSTANTS; qpsmtpd-0.94/lib/Qpsmtpd/SMTP.pm000066400000000000000000000705331240247602400164660ustar00rootroot00000000000000package Qpsmtpd::SMTP; use Qpsmtpd; @ISA = qw(Qpsmtpd); my %auth_mechanisms = (); package Qpsmtpd::SMTP; use strict; use Carp; use Qpsmtpd::Connection; use Qpsmtpd::Transaction; use Qpsmtpd::Plugin; use Qpsmtpd::Constants; use Qpsmtpd::Auth; use Qpsmtpd::Address (); use Qpsmtpd::Command; use Mail::Header (); #use Data::Dumper; use POSIX qw(strftime); use Net::DNS; # this is only good for forkserver # can't set these here, cause forkserver resets them #$SIG{ALRM} = sub { respond(421, "timeout; I can't wait that long..."); exit }; #$SIG{ALRM} = sub { warn "Connection Timed Out\n"; exit; }; sub new { my $proto = shift; my $class = ref($proto) || $proto; my %args = @_; my $self = bless({args => \%args}, $class); my (@commands) = qw(ehlo helo rset mail rcpt data help vrfy noop quit); my (%commands); @commands{@commands} = ('') x @commands; # this list of valid commands should probably be a method or a set of methods $self->{_commands} = \%commands; $self->SUPER::_restart(%args) if $args{restart}; # calls Qpsmtpd::_restart() $self; } sub command_counter { my $self = shift; $self->{_counter} || 0; } sub dispatch { my $self = shift; my ($cmd) = shift; if (!$cmd) { $self->run_hooks("unrecognized_command", '', @_); return 1; } $cmd = lc $cmd; $self->{_counter}++; if ($cmd !~ /^(\w{1,12})$/ or !exists $self->{_commands}->{$1}) { $self->run_hooks("unrecognized_command", $cmd, @_); return 1; } $cmd = $1; my ($result) = eval { $self->$cmd(@_) }; $self->log(LOGERROR, "XX: $@") if $@; return $result if defined $result; return $self->fault("command '$cmd' failed unexpectedly"); } sub unrecognized_command_respond { my ($self, $rc, $msg) = @_; if ($rc == DENY_DISCONNECT) { $self->respond(521, @$msg); $self->disconnect; } elsif ($rc == DENY) { $self->respond(500, @$msg); } elsif ($rc != DONE) { $self->respond(500, "Unrecognized command"); } } sub fault { my $self = shift; my ($msg) = shift || "program fault - command not performed"; my ($name) = split /\s+/, $0, 2; print STDERR $name, "[$$]: $msg ($!)\n"; return $self->respond(451, "Internal error - try again later - " . $msg); } sub start_conversation { my $self = shift; # this should maybe be called something else than "connect", see # lib/Qpsmtpd/TcpServer.pm for more confusion. $self->run_hooks("connect"); return DONE; } sub connect_respond { my ($self, $rc, $msg) = @_; if ($rc == DENY || $rc == DENY_DISCONNECT) { $msg->[0] ||= 'Connection from you denied, bye bye.'; $self->respond(550, @$msg); $self->disconnect; } elsif ($rc == DENYSOFT || $rc == DENYSOFT_DISCONNECT) { $msg->[0] ||= 'Connection from you temporarily denied, bye bye.'; $self->respond(450, @$msg); $self->disconnect; } elsif ($rc != DONE) { my $greets = $self->config('smtpgreeting'); if ($greets) { $greets .= " ESMTP" unless $greets =~ /(^|\W)ESMTP(\W|$)/; } else { $greets = $self->config('me') . " ESMTP qpsmtpd " . $self->version . " ready; send us your mail, but not your spam."; } $self->respond(220, $greets); } } sub transaction { my $self = shift; return $self->{_transaction} || $self->reset_transaction(); } sub reset_transaction { my $self = shift; $self->run_hooks("reset_transaction") if $self->{_transaction}; return $self->{_transaction} = Qpsmtpd::Transaction->new(); } sub connection { my $self = shift; @_ and $self->{_connection} = shift; return $self->{_connection} || ($self->{_connection} = Qpsmtpd::Connection->new()); } sub helo { my ($self, $line) = @_; my ($rc, @msg) = $self->run_hooks('helo_parse'); my ($ok, $hello_host, @stuff) = Qpsmtpd::Command->parse('helo', $line, $msg[0]); return $self->respond(501, "helo requires domain/address - see RFC-2821 4.1.1.1") unless $hello_host; my $conn = $self->connection; return $self->respond(503, "but you already said HELO ...") if $conn->hello; $self->run_hooks("helo", $hello_host, @stuff); } sub helo_respond { my ($self, $rc, $msg, $args) = @_; my ($hello_host) = @$args; if ($rc == DONE) { # do nothing: 1; } elsif ($rc == DENY) { $self->respond(550, @$msg); } elsif ($rc == DENYSOFT) { $self->respond(450, @$msg); } elsif ($rc == DENY_DISCONNECT) { $self->respond(550, @$msg); $self->disconnect; } elsif ($rc == DENYSOFT_DISCONNECT) { $self->respond(450, @$msg); $self->disconnect; } else { my $conn = $self->connection; $conn->hello("helo"); $conn->hello_host($hello_host); $self->transaction; $self->respond( 250, $self->config('me') . " Hi " . $conn->remote_info . " [" . $conn->remote_ip . "]; I am so happy to meet you." ); } } sub ehlo { my ($self, $line) = @_; my ($rc, @msg) = $self->run_hooks('ehlo_parse'); my ($ok, $hello_host, @stuff) = Qpsmtpd::Command->parse('ehlo', $line, $msg[0]); return $self->respond(501, "ehlo requires domain/address - see RFC-2821 4.1.1.1") unless $hello_host; my $conn = $self->connection; return $self->respond(503, "but you already said HELO ...") if $conn->hello; $self->run_hooks("ehlo", $hello_host, @stuff); } sub ehlo_respond { my ($self, $rc, $msg, $args) = @_; my ($hello_host) = @$args; if ($rc == DONE) { # do nothing: 1; } elsif ($rc == DENY) { $self->respond(550, @$msg); } elsif ($rc == DENYSOFT) { $self->respond(450, @$msg); } elsif ($rc == DENY_DISCONNECT) { $self->respond(550, @$msg); $self->disconnect; } elsif ($rc == DENYSOFT_DISCONNECT) { $self->respond(450, @$msg); $self->disconnect; } else { my $conn = $self->connection; $conn->hello("ehlo"); $conn->hello_host($hello_host); $self->transaction; my @capabilities = $self->transaction->notes('capabilities') ? @{$self->transaction->notes('capabilities')} : (); # Check for possible AUTH mechanisms HOOK: foreach my $hook (keys %{$self->hooks}) { if ($hook =~ m/^auth-?(.+)?$/) { if (defined $1) { $auth_mechanisms{uc($1)} = 1; } else { # at least one polymorphous auth provider %auth_mechanisms = map { $_, 1 } qw(PLAIN CRAM-MD5 LOGIN); last HOOK; } } } # Check if we should only offer AUTH after TLS is completed my $tls_before_auth = ($self->config('tls_before_auth') ? ($self->config('tls_before_auth'))[0] && $self->transaction->notes('tls_enabled') : 0); if (%auth_mechanisms && !$tls_before_auth) { push @capabilities, 'AUTH ' . join(" ", keys(%auth_mechanisms)); $self->{_commands}->{'auth'} = ""; } $self->respond( 250, $self->config("me") . " Hi " . $conn->remote_info . " [" . $conn->remote_ip . "]", "PIPELINING", "8BITMIME", ( $self->config('databytes') ? "SIZE " . ($self->config('databytes'))[0] : () ), @capabilities, ); } } sub auth { my ($self, $line) = @_; $self->run_hooks('auth_parse', $line); } sub auth_parse_respond { my ($self, $rc, $msg, $args) = @_; my ($line) = @$args; my ($ok, $mechanism, @stuff) = Qpsmtpd::Command->parse('auth', $line, $msg->[0]); return $self->respond(501, $mechanism || "Syntax error in command") unless ($ok == OK); $mechanism = lc($mechanism); #they AUTH'd once already return $self->respond(503, "but you already said AUTH ...") if (defined $self->{_auth} && $self->{_auth} == OK); return $self->respond(503, "AUTH not defined for HELO") if ($self->connection->hello eq "helo"); return $self->respond(503, "SSL/TLS required before AUTH") if (($self->config('tls_before_auth'))[0] && $self->transaction->notes('tls_enabled')); # we don't have a plugin implementing this auth mechanism, 504 if (exists $auth_mechanisms{uc($mechanism)}) { return $self->{_auth} = Qpsmtpd::Auth::SASL($self, $mechanism, @stuff); } $self->respond(504, "Unimplemented authentification mechanism: $mechanism"); return DENY; } sub mail { my ($self, $line) = @_; # -> from RFC2821 # The MAIL command (or the obsolete SEND, SOML, or SAML commands) # begins a mail transaction. Once started, a mail transaction # consists of a transaction beginning command, one or more RCPT # commands, and a DATA command, in that order. A mail transaction # may be aborted by the RSET (or a new EHLO) command. There may be # zero or more transactions in a session. MAIL (or SEND, SOML, or # SAML) MUST NOT be sent if a mail transaction is already open, # i.e., it should be sent only if no mail transaction had been # started in the session, or it the previous one successfully # concluded with a successful DATA command, or if the previous one # was aborted with a RSET. # sendmail (8.11) rejects a second MAIL command. # qmail-smtpd (1.03) accepts it and just starts a new transaction. # Since we are a qmail-smtpd thing we will do the same. $self->reset_transaction; if (!$self->connection->hello) { return $self->respond(503, "please say hello first ..."); } $self->log(LOGDEBUG, "full from_parameter: $line"); $self->connection->notes('envelope_from', $line); $self->run_hooks("mail_parse", $line); } sub mail_parse_respond { my ($self, $rc, $msg, $args) = @_; my ($line) = @$args; my ($ok, $from, @params) = Qpsmtpd::Command->parse('mail', $line, $msg->[0]); return $self->respond(501, $from || "Syntax error in command") unless ($ok == OK); my %param; foreach (@params) { my ($k, $v) = split /=/, $_, 2; $param{lc $k} = $v; } # to support addresses without <> we now require a plugin # hooking "mail_pre" to # return (OK, "<$from>"); # (...or anything else parseable by Qpsmtpd::Address ;-)) # see also comment in sub rcpt() $self->run_hooks("mail_pre", $from, \%param); } sub mail_pre_respond { my ($self, $rc, $msg, $args) = @_; my ($from, $param) = @$args; if ($rc == OK) { $from = shift @$msg; } $self->log(LOGDEBUG, "from email address : [$from]"); return $self->respond(501, "could not parse your mail from command") unless $from =~ /^<.*>$/; if ($from eq "<>" or $from =~ m/\[undefined\]/ or $from eq "<#@[]>") { $from = Qpsmtpd::Address->new("<>"); } else { $from = (Qpsmtpd::Address->parse($from))[0]; } return $self->respond(501, "could not parse your mail from command") unless $from; $self->run_hooks("mail", $from, %$param); } sub mail_respond { my ($self, $rc, $msg, $args) = @_; my ($from, $param) = @$args; if ($rc == DONE) { return 1; } elsif ($rc == DENY) { $msg->[0] ||= $from->format . ', denied'; $self->log(LOGINFO, "deny mail from " . $from->format . " (@$msg)"); $self->respond(550, @$msg); } elsif ($rc == DENYSOFT) { $msg->[0] ||= $from->format . ', temporarily denied'; $self->log(LOGINFO, "denysoft mail from " . $from->format . " (@$msg)"); $self->respond(450, @$msg); } elsif ($rc == DENY_DISCONNECT) { $msg->[0] ||= $from->format . ', denied'; $self->log(LOGINFO, "deny mail from " . $from->format . " (@$msg)"); $self->respond(550, @$msg); $self->disconnect; } elsif ($rc == DENYSOFT_DISCONNECT) { $msg->[0] ||= $from->format . ', temporarily denied'; $self->log(LOGINFO, "denysoft mail from " . $from->format . " (@$msg)"); $self->respond(421, @$msg); $self->disconnect; } else { # includes OK $self->log(LOGDEBUG, "getting mail from " . $from->format); $self->respond( 250, $from->format . ", sender OK - how exciting to get mail from you!" ); $self->transaction->sender($from); } } sub rcpt { my ($self, $line) = @_; $self->connection->notes('envelope_rcpt', $line); $self->run_hooks("rcpt_parse", $line); } sub rcpt_parse_respond { my ($self, $rc, $msg, $args) = @_; my ($line) = @$args; my ($ok, $rcpt, @param) = Qpsmtpd::Command->parse("rcpt", $line, $msg->[0]); return $self->respond(501, $rcpt || "Syntax error in command") unless ($ok == OK); return $self->respond(503, "Use MAIL before RCPT") unless $self->transaction->sender; my %param; foreach (@param) { my ($k, $v) = split /=/, $_, 2; $param{lc $k} = $v; } # to support addresses without <> we now require a plugin # hooking "rcpt_pre" to # return (OK, "<$rcpt>"); # (... or anything else parseable by Qpsmtpd::Address ;-)) # this means, a plugin can decide to (pre-)accept # addresses like or # by removing the trailing dot or space from this example. $self->run_hooks("rcpt_pre", $rcpt, \%param); } sub rcpt_pre_respond { my ($self, $rc, $msg, $args) = @_; my ($rcpt, $param) = @$args; if ($rc == OK) { $rcpt = shift @$msg; } $self->log(LOGDEBUG, "to email address : [$rcpt]"); return $self->respond(501, "could not parse recipient") unless $rcpt =~ /^<.*>$/; $rcpt = (Qpsmtpd::Address->parse($rcpt))[0]; return $self->respond(501, "could not parse recipient") if (!$rcpt or ($rcpt->format eq '<>')); $self->run_hooks("rcpt", $rcpt, %$param); } sub rcpt_respond { my ($self, $rc, $msg, $args) = @_; my ($rcpt, $param) = @$args; if ($rc == DONE) { return 1; } elsif ($rc == DENY) { $msg->[0] ||= 'relaying denied'; $self->respond(550, @$msg); } elsif ($rc == DENYSOFT) { $msg->[0] ||= 'relaying denied'; return $self->respond(450, @$msg); } elsif ($rc == DENY_DISCONNECT) { $msg->[0] ||= 'delivery denied'; $self->log(LOGDEBUG, "delivery denied (@$msg)"); $self->respond(550, @$msg); $self->disconnect; } elsif ($rc == DENYSOFT_DISCONNECT) { $msg->[0] ||= 'relaying denied'; $self->log(LOGDEBUG, "delivery denied (@$msg)"); $self->respond(421, @$msg); $self->disconnect; } elsif ($rc == OK) { $self->respond(250, $rcpt->format . ", recipient ok"); return $self->transaction->add_recipient($rcpt); } else { return $self->respond(450, "No plugin decided if relaying is allowed"); } return 0; } sub help { my ($self, @args) = @_; $self->run_hooks("help", @args); } sub help_respond { my ($self, $rc, $msg, $args) = @_; return 1 if $rc == DONE; if ($rc == DENY) { $msg->[0] ||= "Syntax error, command not recognized"; $self->respond(500, @$msg); } else { unless ($msg->[0]) { @$msg = ( "This is qpsmtpd " . ($self->config('smtpgreeting') ? '' : $self->version), "See http://smtpd.develooper.com/", 'To report bugs or send comments, mail to .' ); } $self->respond(214, @$msg); } return 1; } sub noop { my $self = shift; $self->run_hooks("noop"); } sub noop_respond { my ($self, $rc, $msg, $args) = @_; return 1 if $rc == DONE; if ($rc == DENY || $rc == DENY_DISCONNECT) { $msg->[0] ||= "Stop wasting my time."; # FIXME: better default message? $self->respond(500, @$msg); $self->disconnect if $rc == DENY_DISCONNECT; return 1; } $self->respond(250, "OK"); return 1; } sub vrfy { my $self = shift; # Note, this doesn't support the multiple ambiguous results # documented in RFC2821#3.5.1 # I also don't think it provides all the proper result codes. $self->run_hooks("vrfy"); } sub vrfy_respond { my ($self, $rc, $msg, $args) = @_; if ($rc == DONE) { return 1; } elsif ($rc == DENY) { $msg->[0] ||= "Access Denied"; $self->respond(554, @$msg); $self->reset_transaction(); return 1; } elsif ($rc == OK) { $msg->[0] ||= "User OK"; $self->respond(250, @$msg); return 1; } else { # $rc == DECLINED or anything else $self->respond(252, "Just try sending a mail and we'll see how it turns out ..."); return 1; } } sub rset { my $self = shift; $self->reset_transaction; $self->respond(250, "OK"); } sub quit { my $self = shift; $self->run_hooks("quit"); } sub quit_respond { my ($self, $rc, $msg, $args) = @_; if ($rc != DONE) { $msg->[0] ||= $self->config('me') . " closing connection. Have a wonderful day."; $self->respond(221, @$msg); } $self->disconnect(); } sub disconnect { my $self = shift; $self->run_hooks("disconnect"); $self->connection->notes(disconnected => 1); $self->reset_transaction; } sub data { my $self = shift; $self->run_hooks("data"); } sub data_respond { my ($self, $rc, $msg, $args) = @_; if ($rc == DONE) { return 1; } elsif ($rc == DENY) { $msg->[0] ||= "Message denied"; $self->respond(554, @$msg); $self->reset_transaction(); return 1; } elsif ($rc == DENYSOFT) { $msg->[0] ||= "Message denied temporarily"; $self->respond(451, @$msg); $self->reset_transaction(); return 1; } elsif ($rc == DENY_DISCONNECT) { $msg->[0] ||= "Message denied"; $self->respond(554, @$msg); $self->disconnect; return 1; } elsif ($rc == DENYSOFT_DISCONNECT) { $msg->[0] ||= "Message denied temporarily"; $self->respond(421, @$msg); $self->disconnect; return 1; } $self->respond(503, "MAIL first"), return 1 unless $self->transaction->sender; $self->respond(503, "RCPT first"), return 1 unless $self->transaction->recipients; $self->respond(354, "go ahead"); my $buffer = ''; my $size = 0; my $i = 0; my $max_size = ($self->config('databytes'))[0] || 0; # this should work in scalar context my $blocked = ""; my %matches; my $in_header = 1; my $complete = 0; $self->log(LOGDEBUG, "max_size: $max_size / size: $size"); my $header = Mail::Header->new(Modify => 0, MailFrom => "COERCE"); my $timeout = $self->config('timeout'); while (defined($_ = $self->getline($timeout))) { if ($_ eq ".\r\n") { $complete++; $_ = ''; } $i++; # should probably use \012 and \015 in these checks instead of \r and \n ... # Reject messages that have either bare LF or CR. rjkaes noticed a # lot of spam that is malformed in the header. ($_ eq ".\n" or $_ eq ".\r") and $self->respond(421, "See http://smtpd.develooper.com/barelf.html") and return $self->disconnect; # add a transaction->blocked check back here when we have line by line plugin access... unless (($max_size and $size > $max_size)) { s/\r\n$/\n/; s/^\.\./\./; if ($in_header && (m/^$/ || $complete > 0)) { $in_header = 0; my @headers = split /^/m, $buffer; # ... need to check that we don't reformat any of the received lines. # # 3.8.2 Received Lines in Gatewaying # When forwarding a message into or out of the Internet environment, a # gateway MUST prepend a Received: line, but it MUST NOT alter in any # way a Received: line that is already in the header. $header->extract(\@headers); #$header->add("X-SMTPD", "qpsmtpd/".$self->version.", http://smtpd.develooper.com/"); $buffer = ""; $self->transaction->header($header); # NOTE: This will not work properly under async. A # data_headers_end_respond needs to be created. my ($rc, $msg) = $self->run_hooks('data_headers_end'); if ($rc == DENY_DISCONNECT) { $self->respond(554, $msg || "Message denied"); $self->disconnect; return 1; } elsif ($rc == DENYSOFT_DISCONNECT) { $self->respond(421, $msg || "Message denied temporarily"); $self->disconnect; return 1; } # Save the start of just the body itself $self->transaction->set_body_start(); } # grab a copy of all of the header lines if ($in_header) { $buffer .= $_; } # copy all lines into the spool file, including the headers # we will create a new header later before sending onwards $self->transaction->body_write($_) if !$complete; $size += length $_; } last if $complete > 0; #$self->log(LOGDEBUG, "size is at $size\n") unless ($i % 300); } $self->log(LOGDEBUG, "max_size: $max_size / size: $size"); # if we get here without seeing a terminator, the connection is # probably dead. unless ($complete) { $self->respond(451, "Incomplete DATA"); $self->reset_transaction; # clean up after ourselves return 1; } #$self->respond(550, $self->transaction->blocked),return 1 if ($self->transaction->blocked); if ($max_size and $size > $max_size) { $self->log(LOGALERT, "Message too big: size: $size (max size: $max_size)"); $self->respond(552, "Message too big!"); $self->reset_transaction; # clean up after ourselves return 1; } $self->authentication_results(); $self->received_line(); $self->run_hooks("data_post"); } sub authentication_results { my ($self) = @_; my @auth_list = $self->config('me'); # $self->clean_authentication_results(); if ( ! defined $self->{_auth} ) { push @auth_list, 'auth=none'; } else { my $mechanism = "(" . $self->{_auth_mechanism} . ")"; my $user = "smtp.auth=" . $self->{_auth_user}; if ( $self->{_auth} == OK) { push @auth_list, "auth=pass $mechanism $user"; } else { push @auth_list, "auth=fail $mechanism $user"; }; }; # RFC 5451: used in AUTH, DKIM, DOMAINKEYS, SENDERID, SPF if ( $self->connection->notes('authentication_results') ) { push @auth_list, $self->connection->notes('authentication_results'); }; $self->log(LOGDEBUG, "adding auth results header" ); $self->transaction->header->add('Authentication-Results', join('; ', @auth_list), 0); }; sub clean_authentication_results { my $self = shift; # http://tools.ietf.org/html/draft-kucherawy-original-authres-00.html # On messages received from the internet, move Authentication-Results headers # to Original-AR, so our downstream can trust the A-R header we insert. # TODO: Do not invalidate DKIM signatures. # if $self->transaction->header->get('DKIM-Signature') # Parse the DKIM signature(s) # return if A-R header is signed; # } my @ar_headers = $self->transaction->header->get('Authentication-Results'); for ( my $i = 0; $i < scalar @ar_headers; $i++ ) { $self->transaction->header->delete('Authentication-Results', $i); $self->transaction->header->add('Original-Authentication-Results', $ar_headers[$i]); } $self->log(LOGDEBUG, "Authentication-Results moved to Original-Authentication-Results" ); }; sub received_line { my ($self) = @_; my $smtp = $self->connection->hello eq "ehlo" ? "ESMTP" : "SMTP"; my $esmtp = substr($smtp, 0, 1) eq "E"; my $authheader = ''; my $sslheader = ''; if (defined $self->connection->notes('tls_enabled') and $self->connection->notes('tls_enabled')) { $smtp .= "S" if $esmtp; # RFC3848 $sslheader = "(" . $self->connection->notes('tls_socket')->get_cipher() . " encrypted) "; } if (defined $self->{_auth} && $self->{_auth} == OK) { my $mech = $self->{_auth_mechanism}; my $user = $self->{_auth_user}; $smtp .= "A" if $esmtp; # RFC3848 $authheader = "(smtp-auth username $user, mechanism $mech)\n"; } my $header_str; my ($rc, @received) = $self->run_hooks("received_line", $smtp, $authheader, $sslheader); if ($rc == YIELD) { die "YIELD not supported for received_line hook"; } elsif ($rc == OK) { return join("\n", @received); } else { # assume $rc == DECLINED $header_str = "from " . $self->connection->remote_info . " (HELO " . $self->connection->hello_host . ") (" . $self->connection->remote_ip . ")\n by " . $self->config('me') . " (qpsmtpd/" . $self->version . ") with $sslheader$smtp; " . (strftime('%a, %d %b %Y %H:%M:%S %z', localtime)); } $self->transaction->header->add('Received', $header_str, 0 ); } sub data_post_respond { my ($self, $rc, $msg, $args) = @_; if ($rc == DONE) { return 1; } elsif ($rc == DENY) { $msg->[0] ||= "Message denied"; $self->respond(552, @$msg); # DATA is always the end of a "transaction" return $self->reset_transaction; } elsif ($rc == DENYSOFT) { $msg->[0] ||= "Message denied temporarily"; $self->respond(452, @$msg); # DATA is always the end of a "transaction" return $self->reset_transaction; } elsif ($rc == DENY_DISCONNECT) { $msg->[0] ||= "Message denied"; $self->respond(552, @$msg); $self->disconnect; return 1; } elsif ($rc == DENYSOFT_DISCONNECT) { $msg->[0] ||= "Message denied temporarily"; $self->respond(452, @$msg); $self->disconnect; return 1; } else { $self->queue($self->transaction); } } sub getline { my ($self, $timeout) = @_; alarm $timeout; my $line = ; # default implementation alarm 0; return $line; } sub queue { my ($self, $transaction) = @_; # First fire any queue_pre hooks $self->run_hooks("queue_pre"); } sub queue_pre_respond { my ($self, $rc, $msg, $args) = @_; if ($rc == DONE) { return 1; } elsif ($rc != OK and $rc != DECLINED and $rc != 0) { return $self->log(LOGERROR, "pre plugin returned illegal value"); return 0; } # If we got this far, run the queue hooks $self->run_hooks("queue"); } sub queue_respond { my ($self, $rc, $msg, $args) = @_; # reset transaction if we queued the mail $self->reset_transaction; if ($rc == DONE) { return 1; } elsif ($rc == OK) { $msg->[0] ||= 'Queued'; $self->respond(250, @$msg); } elsif ($rc == DENY) { $msg->[0] ||= 'Message denied'; $self->respond(552, @$msg); } elsif ($rc == DENYSOFT) { $msg->[0] ||= 'Message denied temporarily'; $self->respond(452, @$msg); } else { $msg->[0] ||= 'Queuing declined or disabled; try again later'; $self->respond(451, @$msg); } # And finally run any queue_post hooks $self->run_hooks("queue_post"); } sub queue_post_respond { my ($self, $rc, $msg, $args) = @_; $self->log(LOGERROR, @$msg) unless ($rc == OK or $rc == 0); } 1; qpsmtpd-0.94/lib/Qpsmtpd/SMTP/000077500000000000000000000000001240247602400161205ustar00rootroot00000000000000qpsmtpd-0.94/lib/Qpsmtpd/SMTP/Prefork.pm000066400000000000000000000014161240247602400200700ustar00rootroot00000000000000package Qpsmtpd::SMTP::Prefork; use Qpsmtpd::SMTP; use Qpsmtpd::Constants; @ISA = qw(Qpsmtpd::SMTP); sub dispatch { my $self = shift; my ($cmd) = lc shift; $self->{_counter}++; if ($cmd !~ /^(\w{1,12})$/ or !exists $self->{_commands}->{$1}) { $self->run_hooks("unrecognized_command", $cmd, @_); return 1; } $cmd = $1; if (1 or $self->{_commands}->{$cmd} and $self->can($cmd)) { my ($result) = eval { $self->$cmd(@_) }; if ($@ =~ /^disconnect_tcpserver/) { die "disconnect_tcpserver"; } elsif ($@) { $self->log(LOGERROR, "XX: $@") if $@; } return $result if defined $result; return $self->fault("command '$cmd' failed unexpectedly"); } return; } qpsmtpd-0.94/lib/Qpsmtpd/TcpServer.pm000066400000000000000000000141451240247602400176150ustar00rootroot00000000000000package Qpsmtpd::TcpServer; use Qpsmtpd::SMTP; use Qpsmtpd::Constants; use Socket; @ISA = qw(Qpsmtpd::SMTP); use strict; use POSIX (); my $has_ipv6 = 0; if ( eval { require Socket6; } && # INET6 prior to 2.01 will not work; sorry. eval { require IO::Socket::INET6; IO::Socket::INET6->VERSION("2.00"); } ) { Socket6->import(qw(inet_ntop)); $has_ipv6 = 1; } sub has_ipv6 { return $has_ipv6; } my $first_0; sub start_connection { my $self = shift; my ( $remote_host, $remote_info, $remote_ip, $remote_port, $local_ip, $local_port, $local_host ); if ($ENV{TCPREMOTEIP}) { # started from tcpserver (or some other superserver which # exports the TCPREMOTE* variables. $remote_ip = $ENV{TCPREMOTEIP}; $remote_host = $ENV{TCPREMOTEHOST} || "[$remote_ip]"; $remote_info = $ENV{TCPREMOTEINFO} ? "$ENV{TCPREMOTEINFO}\@$remote_host" : $remote_host; $remote_port = $ENV{TCPREMOTEPORT}; $local_ip = $ENV{TCPLOCALIP}; $local_port = $ENV{TCPLOCALPORT}; $local_host = $ENV{TCPLOCALHOST}; } else { # Started from inetd or similar. # get info on the remote host from the socket. # ignore ident/tap/... my $hersockaddr = getpeername(STDIN) or die "getpeername failed: $0 must be called from tcpserver, (x)inetd or a similar program which passes a socket to stdin"; my ($port, $iaddr) = sockaddr_in($hersockaddr); $remote_ip = inet_ntoa($iaddr); $remote_host = gethostbyaddr($iaddr, AF_INET) || "[$remote_ip]"; $remote_info = $remote_host; } $self->log(LOGNOTICE, "Connection from $remote_info [$remote_ip]"); # if the local dns resolver doesn't filter it out we might get # ansi escape characters that could make a ps axw do "funny" # things. So to be safe, cut them out. $remote_host =~ tr/a-zA-Z\.\-0-9\[\]//cd; $first_0 = $0 unless $first_0; my $now = POSIX::strftime("%H:%M:%S %Y-%m-%d", localtime); $0 = "$first_0 [$remote_ip : $remote_host : $now]"; $self->SUPER::connection->start( remote_info => $remote_info, remote_ip => $remote_ip, remote_host => $remote_host, remote_port => $remote_port, local_ip => $local_ip, local_port => $local_port, local_host => $local_host, @_ ); } sub run { my ($self, $client) = @_; # Set local client_socket to passed client object for testing socket state on writes $self->{__client_socket} = $client; $self->load_plugins unless $self->{hooks}; my $rc = $self->start_conversation; return if $rc != DONE; # this should really be the loop and read_input should just get one line; I think $self->read_input; } sub read_input { my $self = shift; my $timeout = $self->config('timeoutsmtpd') # qmail smtpd control file || $self->config('timeout') # qpsmtpd control file || 1200; # default value alarm $timeout; while () { alarm 0; $_ =~ s/\r?\n$//s; # advanced chomp $self->log(LOGINFO, "dispatching $_"); $self->connection->notes('original_string', $_); defined $self->dispatch(split / +/, $_, 2) or $self->respond(502, "command unrecognized: '$_'"); alarm $timeout; } alarm(0); return if $self->connection->notes('disconnected'); $self->reset_transaction; $self->run_hooks('disconnect'); $self->connection->notes(disconnected => 1); } sub respond { my ($self, $code, @messages) = @_; my $buf = ''; if (!$self->check_socket()) { $self->log(LOGERROR, "Lost connection to client, cannot send response."); return (0); } while (my $msg = shift @messages) { my $line = $code . (@messages ? "-" : " ") . $msg; $self->log(LOGINFO, $line); $buf .= "$line\r\n"; } print $buf or ($self->log(LOGERROR, "Could not print [$buf]: $!"), return 0); return 1; } sub disconnect { my $self = shift; $self->log(LOGINFO, "click, disconnecting"); $self->SUPER::disconnect(@_); $self->run_hooks("post-connection"); $self->connection->reset; exit; } # local/remote port and ip address sub lrpip { my ($server, $client, $hisaddr) = @_; my ($port, $iaddr) = ($server->sockdomain == AF_INET) ? (sockaddr_in($hisaddr)) : (sockaddr_in6($hisaddr)); my $localsockaddr = getsockname($client); my ($lport, $laddr) = ($server->sockdomain == AF_INET) ? (sockaddr_in($localsockaddr)) : (sockaddr_in6($localsockaddr)); my $nto_iaddr = ($server->sockdomain == AF_INET) ? (inet_ntoa($iaddr)) : (inet_ntop(AF_INET6(), $iaddr)); my $nto_laddr = ($server->sockdomain == AF_INET) ? (inet_ntoa($laddr)) : (inet_ntop(AF_INET6(), $laddr)); $nto_iaddr =~ s/::ffff://; $nto_laddr =~ s/::ffff://; return ($port, $iaddr, $lport, $laddr, $nto_iaddr, $nto_laddr); } sub tcpenv { my ($nto_laddr, $nto_iaddr, $no_rdns) = @_; my $TCPLOCALIP = $nto_laddr; my $TCPREMOTEIP = $nto_iaddr; if ($no_rdns) { return ($TCPLOCALIP, $TCPREMOTEIP, $TCPREMOTEIP ? "[$ENV{TCPREMOTEIP}]" : "[noip!]"); } my $res = Net::DNS::Resolver->new( dnsrch => 0 ); $res->tcp_timeout(3); $res->udp_timeout(3); my $query = $res->query($nto_iaddr, 'PTR'); my $TCPREMOTEHOST; if ($query) { foreach my $rr ($query->answer) { next if $rr->type ne 'PTR'; $TCPREMOTEHOST = $rr->ptrdname; } } return ($TCPLOCALIP, $TCPREMOTEIP, $TCPREMOTEHOST || 'Unknown'); } sub check_socket() { my $self = shift; return 1 if ($self->{__client_socket}->connected); return 0; } 1; qpsmtpd-0.94/lib/Qpsmtpd/TcpServer/000077500000000000000000000000001240247602400172525ustar00rootroot00000000000000qpsmtpd-0.94/lib/Qpsmtpd/TcpServer/Prefork.pm000066400000000000000000000043351240247602400212250ustar00rootroot00000000000000package Qpsmtpd::TcpServer::Prefork; use Qpsmtpd::TcpServer; use Qpsmtpd::SMTP::Prefork; use Qpsmtpd::Constants; @ISA = qw(Qpsmtpd::SMTP::Prefork Qpsmtpd::TcpServer); my $first_0; sub start_connection { my $self = shift; #reset info $self->{_connection} = Qpsmtpd::Connection->new(); #reset connection $self->reset_transaction; $self->SUPER::start_connection(@_); } sub read_input { my $self = shift; my $timeout = $self->config('timeoutsmtpd') # qmail smtpd control file || $self->config('timeout') # qpsmtpd control file || 1200; # default value alarm $timeout; eval { while () { alarm 0; $_ =~ s/\r?\n$//s; # advanced chomp $self->log(LOGINFO, "dispatching $_"); $self->connection->notes('original_string', $_); defined $self->dispatch(split / +/, $_, 2) or $self->respond(502, "command unrecognized: '$_'"); alarm $timeout; } unless ($self->connection->notes('disconnected')) { $self->reset_transaction; $self->run_hooks('disconnect'); $self->connection->notes(disconnected => 1); } }; if ($@ =~ /^disconnect_tcpserver/) { die "disconnect_tcpserver"; } else { $self->run_hooks("post-connection"); $self->connection->reset; die "died while reading from STDIN (probably broken sender) - $@"; } alarm(0); } sub respond { my ($self, $code, @messages) = @_; if (!$self->check_socket()) { $self->log(LOGERROR, "Lost connection to client, cannot send response."); return (0); } while (my $msg = shift @messages) { my $line = $code . (@messages ? "-" : " ") . $msg; $self->log(LOGINFO, $line); print "$line\r\n" or ($self->log(LOGERROR, "Could not print [$line]: $!"), return 0); } return 1; } sub disconnect { my $self = shift; $self->log(LOGINFO, "click, disconnecting"); $self->SUPER::disconnect(@_); $self->run_hooks("post-connection"); $self->connection->reset; die "disconnect_tcpserver"; } 1; qpsmtpd-0.94/lib/Qpsmtpd/Transaction.pm000066400000000000000000000267121240247602400201700ustar00rootroot00000000000000package Qpsmtpd::Transaction; use Qpsmtpd; @ISA = qw(Qpsmtpd); use strict; use warnings; use Qpsmtpd::Utils; use Qpsmtpd::Constants; use IO::File qw(O_RDWR O_CREAT); use Socket qw(inet_aton); use Sys::Hostname; use Time::HiRes qw(gettimeofday); sub new { start(@_) } sub start { my $proto = shift; my $class = ref($proto) || $proto; my %args = @_; my $self = {_rcpt => [], started => time,}; bless($self, $class); return $self; } sub add_recipient { my ($self, $rcpt) = @_; push @{$self->{_recipients}}, $rcpt if $rcpt; } sub remove_recipient { my ($self, $rcpt) = @_; $self->{_recipients} = [grep { $_->address ne $rcpt->address } @{$self->{_recipients} || []}] if $rcpt; } sub recipients { my $self = shift; @_ and $self->{_recipients} = [@_]; ($self->{_recipients} ? @{$self->{_recipients}} : ()); } sub sender { my $self = shift; @_ and $self->{_sender} = shift; $self->{_sender}; } sub header { my $self = shift; @_ and $self->{_header} = shift; $self->{_header}; } # blocked() will return when we actually can do something useful with it... #sub blocked { # my $self = shift; # carp 'Use of transaction->blocked is deprecated;' # . 'tell ask@develooper.com if you have a reason to use it'; # @_ and $self->{_blocked} = shift; # $self->{_blocked}; #} sub notes { my ($self, $key) = (shift, shift); # Check for any additional arguments passed by the caller -- including undef return $self->{_notes}->{$key} unless @_; return $self->{_notes}->{$key} = shift; } sub set_body_start { my $self = shift; $self->{_body_start} = $self->body_current_pos; if ($self->{_body_file}) { $self->{_header_size} = $self->{_body_start}; } else { $self->{_header_size} = 0; if ($self->{_body_array}) { foreach my $line (@{$self->{_body_array}}) { $self->{_header_size} += length($line); } } } } sub body_start { my $self = shift; @_ and die "body_start now read only"; $self->{_body_start}; } sub body_current_pos { my $self = shift; if ($self->{_body_file}) { return tell($self->{_body_file}); } return $self->{_body_current_pos} || 0; } sub body_filename { my $self = shift; $self->body_spool() unless $self->{_filename}; $self->{_body_file}->flush(); # so contents won't be cached return $self->{_filename}; } sub body_spool { my $self = shift; $self->log(LOGINFO, "spooling message to disk"); $self->{_filename} = $self->temp_file(); $self->{_body_file} = IO::File->new($self->{_filename}, O_RDWR | O_CREAT, 0600) or die "Could not open file $self->{_filename} - $! " ; # . $self->{_body_file}->error; if ($self->{_body_array}) { foreach my $line (@{$self->{_body_array}}) { $self->{_body_file}->print($line) or die "Cannot print to temp file: $!"; } $self->{_body_start} = $self->{_header_size}; } else { $self->log(LOGERROR, "no message body"); } $self->{_body_array} = undef; } sub body_write { my $self = shift; my $data = shift; if ($self->{_body_file}) { #warn("body_write to file\n"); # go to the end of the file seek($self->{_body_file}, 0, 2) unless $self->{_body_file_writing}; $self->{_body_file_writing} = 1; $self->{_body_file}->print(ref $data eq "SCALAR" ? $$data : $data) and $self->{_body_size} += length(ref $data eq "SCALAR" ? $$data : $data); } else { #warn("body_write to array\n"); $self->{_body_array} ||= []; my $ref = ref($data) eq "SCALAR" ? $data : \$data; pos($$ref) = 0; while ($$ref =~ m/\G(.*?\n)/gc) { push @{$self->{_body_array}}, $1; $self->{_body_size} += length($1); ++$self->{_body_current_pos}; } if ($$ref =~ m/\G(.+)\z/gc) { push @{$self->{_body_array}}, $1; $self->{_body_size} += length($1); ++$self->{_body_current_pos}; } $self->body_spool if ($self->{_body_size} >= $self->size_threshold()); } } sub body_size { # depreceated, use data_size() instead my $self = shift; $self->log(LOGWARN, "WARNING: body_size() is depreceated, use data_size() instead"); $self->{_body_size} || 0; } sub data_size { shift->{_body_size} || 0; } sub body_length { my $self = shift; $self->{_body_size} or return 0; $self->{_header_size} or return 0; return $self->{_body_size} - $self->{_header_size}; } sub body_resetpos { my $self = shift; if ($self->{_body_file}) { my $start = $self->{_body_start} || 0; seek($self->{_body_file}, $start, 0); $self->{_body_file_writing} = 0; } else { $self->{_body_current_pos} = $self->{_body_start}; } 1; } sub body_getline { my $self = shift; if ($self->{_body_file}) { my $start = $self->{_body_start} || 0; seek($self->{_body_file}, $start, 0) if $self->{_body_file_writing}; $self->{_body_file_writing} = 0; my $line = $self->{_body_file}->getline; return $line; } else { return unless $self->{_body_array}; $self->{_body_current_pos} ||= 0; my $line = $self->{_body_array}->[$self->{_body_current_pos}]; $self->{_body_current_pos}++; return $line; } } sub body_as_string { my $self = shift; $self->body_resetpos; local $/; my $str = ''; while (defined(my $line = $self->body_getline)) { $str .= $line; } return $str; } sub body_fh { return shift->{_body_file}; } sub dup_body_fh { my ($self) = @_; open(my $fh, '<&=', $self->body_fh); return $fh; } sub DESTROY { my $self = shift; # would we save some disk flushing if we unlinked the file before # closing it? $self->log(LOGDEBUG, sprintf("DESTROY called by %s, %s, %s", (caller))); if ($self->{_body_file}) { undef $self->{_body_file}; } if ($self->{_filename} and -e $self->{_filename}) { if (unlink $self->{_filename}) { $self->log(LOGDEBUG, "unlinked ", $self->{_filename}); } else { $self->log(LOGERROR, "Could not unlink ", $self->{_filename}, ": $!"); } } # These may not exist if ($self->{_temp_files}) { $self->log(LOGDEBUG, "Cleaning up temporary transaction files"); foreach my $file (@{$self->{_temp_files}}) { next unless -e $file; unlink $file or $self->log(LOGERROR, "Could not unlink temporary file", $file, ": $!"); } } # Ditto if ($self->{_temp_dirs}) { eval { use File::Path }; $self->log(LOGDEBUG, "Cleaning up temporary directories"); foreach my $dir (@{$self->{_temp_dirs}}) { rmtree($dir) or $self->log(LOGERROR, "Could not unlink temporary dir", $dir, ": $!"); } } } 1; __END__ =head1 NAME Qpsmtpd::Transaction - single SMTP session transaction data =head1 SYNOPSIS foreach my $recip ($transaction->recipients) { print "T", $recip->address, "\0"; } =head1 DESCRIPTION Qpsmtpd::Transaction maintains a single SMTP session's data, including the envelope details and the mail header and body. The docs below cover using the C<$transaction> object from within plugins rather than constructing a C object, because the latter is done for you by qpsmtpd. =head1 API =head2 add_recipient($recipient) This adds a new recipient (as in RCPT TO) to the envelope of the mail. The C<$recipient> is a C object. See L for more details. =head2 remove_recipient($recipient) This removes a recipient (as in RCPT TO) from the envelope of the mail. The C<$recipient> is a C object. See L for more details. =head2 recipients( ) This returns a list of the current recipients in the envelope. Each recipient returned is a C object. This method is also a setter. Pass in a list of recipients to change the recipient list to an entirely new list. Note that the recipients you pass in B be C objects. =head2 sender( [ ADDRESS ] ) Get or set the sender (MAIL FROM) address in the envelope. The sender is a C object. =head2 header( [ HEADER ] ) Get or set the header of the email. The header is a object, which gives you access to all the individual headers using a simple API. e.g.: my $headers = $transaction->header(); my $msgid = $headers->get('Message-Id'); my $subject = $headers->get('Subject'); =head2 notes( $key [, $value ] ) Get or set a note on the transaction. This is a piece of data that you wish to attach to the transaction and read somewhere else. For example you can use this to pass data between plugins. Note though that these notes will be lost when a transaction ends, for example on a C or after C completes, so you might want to use the notes field in the C object instead. =head2 body_filename ( ) Returns the temporary filename used to store the message contents; useful for virus scanners so that an additional copy doesn't need to be made. Calling C also forces spooling to disk. A message is not spooled to disk if it's size is smaller than I<$self-Econfig("size_threshold")>, default threshold is 0, the sample config file sets this to 10000. =head2 body_write( $data ) Write data to the end of the email. C<$data> can be either a plain scalar, or a reference to a scalar. =head2 body_size( ) B, Use I instead. =head2 data_size( ) Get the current size of the email. Note that this is not the size of the message that will be queued, it is the size of what the client sent after the C command. If you need the size that will be queued, use my $msg_len = length($transaction->header->as_string) + $transaction->body_length; The line above is of course only valid in I, as other plugins may add headers and qpsmtpd will add it's I header. =head2 body_length( ) Get the current length of the body of the email. This length includes the empty line between the headers and the body. Until the client has sent some data of the body of the message (i.e. headers are finished and client sent the empty line) this will return 0. =head2 body_resetpos( ) Resets the body filehandle to the start of the file (via C). Use this function before every time you wish to process the entire body of the email to ensure that some other plugin has not moved the file pointer. =head2 body_getline( ) Returns a single line of data from the body of the email. =head2 body_fh( ) Returns the file handle to the temporary file of the email. This will return undef if the file is not opened (yet). In I or later you can force spooling to disk by calling I<$transaction-Ebody_filename>. =head2 dup_body_fh( ) Returns a dup()'d file handle to the temporary file of the email. This can be useful if an external module may call close() on the filehandle that is passed to it. This should only be used for reads, as writing to a dup'd filehandle may have unintended consequences. =head1 SEE ALSO L, L, L =cut qpsmtpd-0.94/lib/Qpsmtpd/Utils.pm000066400000000000000000000003471240247602400167770ustar00rootroot00000000000000package Qpsmtpd::Utils; use strict; sub tildeexp { my $path = shift; $path =~ s{^~([^/]*)} { $1 ? (getpwnam($1))[7] : ( $ENV{HOME} || $ENV{LOGDIR} || (getpwuid($>))[7]) }ex; return $path; } 1; qpsmtpd-0.94/log/000077500000000000000000000000001240247602400137205ustar00rootroot00000000000000qpsmtpd-0.94/log/log2sql000077500000000000000000000471751240247602400152470ustar00rootroot00000000000000#!/usr/bin/perl use strict; use warnings; use Cwd; use Data::Dumper; use DBIx::Simple; use IO::File; use File::stat; use Time::TAI64 qw/ tai2unix /; $Data::Dumper::Sortkeys = 1; my $logdir = get_log_dir(); my @logfiles = get_logfiles($logdir); my (%plugins, %os, %message_ids); my $has_cleanup; my $db = get_db(); check_plugins_table(); foreach my $file (@logfiles) { my ($fid, $offset) = check_logfile($file); $fid or next; parse_logfile($file, $fid, $offset); } exit; sub trim_message { my $mess = shift; return '' if $mess eq 'skip, naughty'; return '' if $mess eq 'skip, relay client'; return '' if $mess eq 'skip, no match'; return '' if $mess eq 'skip: unsigned'; return '' if $mess eq 'skip, not a null sender'; return '' if $mess eq 'pass'; return '' if $mess eq 'pass, no record'; return '' if $mess eq 'pass, Deliverable through vpopmail'; return '' if $mess eq 'pass, clean'; return '' if $mess =~ /^fail. NAUGHTY/; return '' if $mess =~ /^PTR:\s/; return '' if $mess eq 'TLS setup returning'; return $mess; } sub get_os_id { my $p0f_string = shift or return; $p0f_string =~ s/\s+$//; $p0f_string =~ s/^\s+//; return if !$p0f_string; return if $p0f_string =~ /no match/; return if $p0f_string =~ /^skip/; return if $p0f_string =~ /^\d/; return if $p0f_string =~ /^\(/; return if $p0f_string !~ /\w/; return if $p0f_string =~ /no longer in the cache/; if (!scalar keys %os) { my $ref = exec_query('SELECT * FROM os'); foreach my $o (@$ref) { $os{$o->{name}} = $o->{id}; } } if (!defined $os{$p0f_string}) { warn "missing OS for $p0f_string\n"; } return $os{$p0f_string}; } sub get_plugin_id { my $plugin = shift; if (!scalar keys %plugins) { my $ref = exec_query('SELECT * FROM plugin'); foreach my $p (@$ref) { $plugins{$p->{name}} = $p->{id}; $plugins{$p->{id}} = $p->{name}; } $ref = exec_query('SELECT * FROM plugin_aliases'); foreach my $pa (@$ref) { $plugins{$pa->{name}} = $pa->{plugin_id}; } } if (!defined $plugins{$plugin}) { #warn Dumper(\%plugins); die "missing DB plugin $plugin\n"; } return $plugins{$plugin}; } sub get_msg_id { my ($fid, $pid) = @_; return $message_ids{"$fid-$pid"} if $message_ids{"$fid-$pid"}; #print "searching for message $pid..."; my $msgs = exec_query('SELECT * FROM message WHERE file_id=? AND qp_pid=?', [$fid, $pid]); #print scalar @$msgs ? "y\n" : "n\n"; if ($msgs->[0]{id}) { $message_ids{"$fid-$pid"} = $msgs->[0]{id}; } return $msgs->[0]{id}; } sub create_message { my ($fid, $ts, $pid, $message) = @_; my ($host, $ip) = split /\s/, $message; $ip = substr $ip, 1, -1; # remove brackets my $id = exec_query( "INSERT INTO message SET file_id=?, connect_start=FROM_UNIXTIME(?), qp_pid=?, ip=INET_ATON(?)", [$fid, $ts, $pid, $ip] ); if ($host && $host ne 'Unknown') { exec_query("UPDATE message SET hostname=? WHERE id=?", [$host, $id]); } #warn "host updated: $host\n"; } sub insert_plugin { my ($msg_id, $plugin, $message) = @_; my $plugin_id = get_plugin_id($plugin); if ($plugin eq 'ident::geoip') { my ($gip, $distance) = $message =~ /(.*?),\s+([\d]+)\skm/; if ($distance) { exec_query('UPDATE message SET distance=? WHERE id=?', [$distance, $msg_id]); $message = $gip; } } elsif ($plugin =~ /^ident::p0f/) { my $os_id = get_os_id($message); if ($os_id) { exec_query('UPDATE message SET os_id=? WHERE id=?', [$os_id, $msg_id]); $message = 'pass'; } } elsif ($plugin eq 'connection_time') { my ($seconds) = $message =~ /\s*([\d\.]+)\s/; if ($seconds) { exec_query('UPDATE message SET time=? WHERE id=?', [$seconds, $msg_id]); $message = 'pass'; } } my $result = get_score($message); if ($result) { $message = trim_message($message); } exec_query( 'INSERT INTO message_plugin SET msg_id=?, plugin_id=?, result=?, string=?', [$msg_id, $plugin_id, $result, $message] ); } sub parse_logfile { my $file = shift; my $fid = shift; my $offset = shift || 0; my $path = "$logdir/$file"; print "parsing file $file (id: $fid) from offset $offset\n"; open my $F, '<', $path or die "could not open $path: $!"; seek($F, $offset, 0) if $offset; while (defined(my $line = <$F>)) { chomp $line; next if !$line; my ($type, $pid, $hook, $plugin, $message) = parse_line($line); next if !$type; next if $type eq 'info'; next if $type eq 'unknown'; next if $type eq 'response'; next if $type eq 'init'; # doesn't occur in all deployment models next if $type eq 'cleanup'; next if $type eq 'error'; my $ts = tai2unix((split /\s/, $line)[0]); # print "ts: $ts\n"; my $msg_id = get_msg_id($fid, $pid) or do { create_message($fid, $ts, $pid, $message) if $type eq 'connect'; next; }; #warn "type: $type\n"; if ($type eq 'plugin') { next if $plugin eq 'naughty'; # housekeeping only next if $plugin eq 'karma' && 'karma adjust' eq substr($message,0,12); insert_plugin($msg_id, $plugin, $message); } elsif ($type eq 'queue') { exec_query('UPDATE message SET result=? WHERE id=?', [3, $msg_id]); } elsif ($type eq 'reject') { exec_query('UPDATE message SET result=? WHERE id=?', [-3, $msg_id]); } elsif ($type eq 'close') { if ($message eq 'Connection Timed Out') { exec_query('UPDATE message SET result=? WHERE id=?', [-1, $msg_id]); } } elsif ($type eq 'connect') { } elsif ($type eq 'dispatch') { if (substr($message, 0, 21) eq 'dispatching MAIL FROM') { my ($from) = $message =~ /<(.*?)>/; exec_query('UPDATE message SET mail_from=? WHERE id=?', [$from, $msg_id]); } elsif (substr($message, 0, 19) eq 'dispatching RCPT TO') { my ($to) = $message =~ /<(.*?)>/; exec_query( 'UPDATE message SET rcpt_to=? WHERE id=? AND rcpt_to IS NULL', [$to, $msg_id] ); } elsif ($message =~ m/dispatching (EHLO|HELO) (.*)/) { exec_query('UPDATE message SET helo=? WHERE id=?', [$2, $msg_id]); } elsif ($message eq 'dispatching DATA') { } elsif ($message eq 'dispatching QUIT') { } elsif ($message eq 'dispatching STARTTLS') { } elsif ($message eq 'dispatching RSET') { } else { # anything here is likely an unrecognized command #print "$message\n"; } } else { print "$type $pid $hook $plugin $message\n"; } } close $F; } sub check_logfile { my $file = shift; my $path = "$logdir/$file"; die "missing file $logdir/$file" if !-f "$logdir/$file"; my $inode = stat($path)->ino or die "unable to get inode for $path\n"; my $size = stat($path)->size or die "unable to get size for $path\n"; my $exists; #warn "check if file $file is in the DB as 'current'\n"; if ($file =~ /^\@/) { $exists = exec_query('SELECT * FROM log WHERE inode=? AND name=?', [$inode, 'current']); if (@$exists) { print "Updating current -> $file\n"; exec_query('UPDATE log SET name=? WHERE inode=? AND name=?', [$file, $inode, 'current']); return ($exists->[0]{id}, $exists->[0]{size}); # continue parsing } } if ($file eq 'current') { $exists = exec_query('SELECT * FROM log WHERE inode=? AND name=?', [$inode, $file]); if (@$exists) { exec_query('UPDATE log SET size=? WHERE inode=? AND name=?', [$size, $inode, 'current']); return ($exists->[0]{id}, $exists->[0]{size}); # continue parsing } } $exists = exec_query('SELECT * FROM log WHERE name=? AND size=?', [$file, $size]); return if @$exists; # log file hasn't changed, ignore it #print Dumper($exists); # file is a new one we haven't seen, add to DB and parse my $id = exec_query( 'INSERT INTO log SET inode=?, size=?, name=?, created=FROM_UNIXTIME(?)', [$inode, $size, $file, stat($path)->ctime] ); print "new file id: $id\n"; return ($id); } sub get_log_dir { if (-d "log/main") { my $wd = Cwd::cwd(); return "$wd/log/main"; } foreach my $user (qw/ qpsmtpd smtpd /) { my ($homedir) = (getpwnam($user))[7] or next; if (-d "$homedir/log") { return "$homedir/log/main"; } if (-d "$homedir/smtpd/log") { return "$homedir/smtpd/log/main"; } } } sub get_logfiles { my $dir = shift; opendir my $D, $dir or die "unable to open log dir $dir\n"; my @files; while (defined(my $f = readdir($D))) { next if !-f "$dir/$f"; # ignore anything that's not a file if ($f =~ /^\@.*s$/) { push @files, $f; } } push @files, "current"; # always have this one last closedir $D; return @files; } sub parse_line { my $line = shift; my ($tai, $pid, $message) = split /\s+/, $line, 3; return if !$message; # garbage in the log file # lines seen many times per connection return parse_line_plugin($line) if substr($message, 0, 1) eq '('; return ('dispatch', $pid, undef, undef, $message) if substr($message, 0, 12) eq 'dispatching '; return ('queue', $pid, undef, undef, $message) if substr($message, 0, 11) eq '250 Queued!'; return ('response', $pid, undef, undef, $message) if $message =~ /^[2|3]\d\d/; # lines seen about once per connection return ('init', $pid, undef, undef, $message) if substr($message, 0, 19) eq 'Accepted connection'; return ('connect', $pid, undef, undef, substr($message, 16)) if substr($message, 0, 15) eq 'Connection from'; return ('connect', $pid, undef, undef, substr($message, 16)) if substr($message, 0, 8) eq 'connect '; return ('close', $pid, undef, undef, $message) if substr($message, 0, 6) eq 'close '; return ('close', $pid, undef, undef, $message) if $message eq 'Connection Timed Out'; return ('close', $pid, undef, undef, $message) if substr($message, 0, 20) eq 'click, disconnecting'; return parse_line_cleanup($line) if substr($message, 0, 11) eq 'cleaning up'; # lines seen less than once per connection return ('info', $pid, undef, undef, $message) if $message eq 'spooling message to disk'; return ('reject', $pid, undef, undef, $message) if $message =~ /^[4|5]\d\d/; return ('reject', $pid, undef, undef, $message) if substr($message, 0, 14) eq 'deny mail from'; return ('reject', $pid, undef, undef, $message) if substr($message, 0, 18) eq 'denysoft mail from'; return ('info', $pid, undef, undef, $message) if substr($message, 0, 15) eq 'Lost connection'; return ('info', $pid, undef, undef, $message) if $message eq 'auth success cleared naughty'; return ('info', $pid, undef, undef, $message) if substr($message, 0, 15) eq 'Running as user'; return ('info', $pid, undef, undef, $message) if substr($message, 0, 16) eq 'Loaded Qpsmtpd::'; return ('info', $pid, undef, undef, $message) if substr($message, 0, 24) eq 'Permissions on spool_dir'; return ('info', $pid, undef, undef, $message) if substr($message, 0, 13) eq 'Listening on '; return ('info', $pid, undef, undef, $message) if substr($message, 0, 18) eq 'size_threshold set'; return ('info', $pid, undef, undef, $message) if substr($message, 0, 12) eq 'tls: ciphers'; return ('error', $pid, undef, undef, $message) if substr($message, 0, 22) eq 'of uninitialized value'; return ('error', $pid, undef, undef, $message) if substr($message, 0, 8) eq 'symbol "'; return ('error', $pid, undef, undef, $message) if substr($message, 0, 9) eq 'error at '; return ('error', $pid, undef, undef, $message) if substr($message, 0, 15) eq 'Could not print'; print "UNKNOWN LINE: $line\n"; return ('unknown', $pid, undef, undef, $message); } sub parse_line_plugin { my ($line) = @_; # @tai 13486 (connect) ident::p0f: Windows (XP/2000 (RFC1323+, w, tstamp-)) # @tai 13681 (connect) dnsbl: fail, NAUGHTY # @tai 15787 (connect) karma: pass, no penalty (0 naughty, 3 nice, 3 connects) # @tai 27500 (queue) queue::qmail_2dqueue: (for 27481) Queuing to /var/qmail/bin/qmail-queue my ($tai, $pid, $hook, $plugin, $message) = split /\s/, $line, 5; $plugin =~ s/:$//; return parse_line_plugin_p0f($line) if $plugin =~ /^ident::p0f/; return parse_line_plugin_dspam($line) if $plugin =~ /^dspam/; return parse_line_plugin_spamassassin($line) if $plugin =~ /^spamassassin/; if ($plugin eq 'sender_permitted_from') { $message = 'pass' if $message =~ /^pass/; $message = 'fail' if $message =~ /^fail/; $message = 'skip' if $message =~ /^none/; } elsif ($plugin eq 'queue::qmail_2dqueue') { ($pid) = $message =~ /\(for ([\d]+)\)/; $message = 'pass' if $message =~ /Queuing/; } elsif ($plugin =~ /(?:early|karma|helo|rcpt_ok)/) { $message = 'pass' if $message =~ /^pass/; } elsif ($plugin =~ /resolvable_fromhost/) { $message = 'pass' if $message =~ /^pass/; } return ('plugin', $pid, $hook, $plugin, $message); } sub parse_line_plugin_dspam { my $line = shift; my ($tai, $pid, $hook, $plugin, $message) = split /\s/, $line, 5; $plugin =~ s/:$//; if ($message =~ /Innocent, (\d\.\d\d c)/) { $message = "pass, $1"; } if ($message =~ /Spam, (\d\.\d\d c)/) { $message = "fail, $1"; } return ('plugin', $pid, $hook, $plugin, $message); } sub parse_line_plugin_spamassassin { my $line = shift; my ($tai, $pid, $hook, $plugin, $message) = split /\s/, $line, 5; $plugin =~ s/:$//; if ($message =~ /pass, Ham, ([\d\-\.]+)\s/) { $message = "pass, $1"; } if ($message =~ /^fail, Spam,\s([\d\.]+)\s< 100/) { $message = "fail, $1"; } return ('plugin', $pid, $hook, $plugin, $message); } sub parse_line_plugin_p0f { my $line = shift; my ($tai, $pid, $hook, $plugin, $message) = split /\s/, $line, 5; $plugin =~ s/:$//; if (substr($message, -5, 5) eq 'hops)') { ($message) = split(/\s\(/, $message); } $message = 'iOS' if $message =~ /^iOS/; $message = 'Solaris' if $message =~ /^Solaris/; $message = 'Mac OS X' if $message =~ /^Mac OS X/; $message = 'FreeBSD' if $message =~ /^FreeBSD/; $message = 'Linux' if $message =~ /^Linux/; $message = 'OpenBSD' if $message =~ /^OpenBSD/; $message = 'Windows NT' if $message =~ /^Windows \(?NT/; $message = 'Windows 95' if $message =~ /^Windows \(?95/; $message = 'Windows 98' if $message =~ /^Windows \(?98/; $message = 'Windows XP' if $message =~ /^Windows \(?XP/; $message = 'Windows 2000' if $message =~ /^Windows \(?2000/; $message = 'Windows 2003' if $message =~ /^Windows \(?2003/; $message = 'Windows 7 or 8' if $message =~ /^Windows 7/; $message = 'Windows 7 or 8' if $message =~ /^Windows 8/; $message = 'Google' if $message =~ /^Google/; $message = 'HP-UX' if $message =~ /^HP\-UX/; $message = 'NetCache' if $message =~ /^NetCache/i; $message = 'Cisco' if $message =~ /^Cisco/i; $message = 'Netware' if $message =~ /Netware/i; return ('plugin', $pid, $hook, $plugin, $message); } sub parse_line_cleanup { my ($line) = @_; # @tai 85931 cleaning up after 3210 my $pid = (split /\s+/, $line)[-1]; $has_cleanup++; return ('cleanup', $pid, undef, undef, $line); } sub get_score { my $mess = shift; return 3 if $mess eq 'TLS setup returning'; return 3 if $mess =~ /^pass/; return -3 if $mess =~ /^fail/; return -2 if $mess =~ /^negative/; return 2 if $mess =~ /^positive/; return 1 if $mess =~ /^skip/; return 0; } sub get_db { my %dbv = get_config('log2sql'); $dbv{dsn} ||= 'DBI:mysql:database=qpsmtpd;host=db;port=3306'; $dbv{user} ||= 'qplog'; $dbv{pass} ||= 't0ps3cret'; print Dumper(\%dbv); my $db = DBIx::Simple->connect($dbv{dsn}, $dbv{user}, $dbv{pass}) or die DBIx::Simple->error; return $db; } sub get_config { my $file = shift or die "missing file name\n"; my %values; foreach my $line ( get_config_contents( $file ) ) { next if $line =~ /^#/; chomp $line; my ($key,$val) = split /\s*=\s*/, $line, 2; $values{$key} = $val; }; return %values; }; sub get_config_contents { my $name = shift; my @config_dirs = qw[ config ../config log plugins ]; foreach my $dir ( @config_dirs ) { next if ! -f "$dir/$name"; my $fh = IO::File->new(); if ( ! $fh->open( "$dir/$name", '<' ) ) { warn "unable to open config file $dir/$name\n"; next; }; my @contents = <$fh>; return @contents; }; }; sub check_plugins_table { my $rows = exec_query( 'SELECT COUNT(*) FROM plugin'); return if scalar @$rows != 0; my @lines = get_config_contents('registry.txt'); foreach my $line ( @lines ) { next if $line =~ /^\s*#/; # ignore comments chomp $line; next if ! $line; my ($id, $name, $abb3, $abb5, $aliases) = split /\s+/, $line, 5; my $q = "REPLACE INTO plugin (id,name,abb3,abb5) VALUES (??)"; print "query: $q, $id, $name, $abb3, $abb5\n"; exec_query($q, [$id, $name, $abb3, $abb5 ]); next if ! $aliases; foreach my $alias ( split /\s*,\s*/, $aliases ) { next if ! $alias; my $aq = "REPLACE INTO plugin_aliases (plugin_id,name) VALUES (??)"; print "aqury: $aq, $id, $alias\n"; exec_query($aq, [$id, $alias]); }; }; }; sub exec_query { my $query = shift; my $params = shift; die "invalid arguments to exec_query!" if @_; my @params; if (defined $params) { @params = ref $params eq 'ARRAY' ? @$params : $params; } my $err = "query failed: $query\n"; if (scalar @params) { $err .= join(',', @params); } #warn "err: $err\n"; if ($query =~ /(?:REPLACE|INSERT) INTO/) { my ($table) = $query =~ /(?:REPLACE|INSERT) INTO (\w+)\s/; $db->query($query, @params); warn "$db->error\n$err" if $db->error ne 'DBI error: '; return if $query =~ /^REPLACE/; my $id = $db->last_insert_id(undef, undef, $table, undef) or die $err; return $id; } elsif ($query =~ /^UPDATE/i) { return $db->query($query, @params); } elsif ($query =~ /DELETE/) { $db->query($query, @params) or die $err; return $db->query("SELECT ROW_COUNT()")->list; } my $r = $db->query($query, @params)->hashes or die $err; return $r; } qpsmtpd-0.94/log/log2sql.sql000066400000000000000000000105541240247602400160310ustar00rootroot00000000000000/*!40101 SET @OLD_CHARACTER_SET_CLIENT=@@CHARACTER_SET_CLIENT */; /*!40101 SET @OLD_CHARACTER_SET_RESULTS=@@CHARACTER_SET_RESULTS */; /*!40101 SET @OLD_COLLATION_CONNECTION=@@COLLATION_CONNECTION */; /*!40101 SET NAMES utf8 */; /*!40014 SET @OLD_FOREIGN_KEY_CHECKS=@@FOREIGN_KEY_CHECKS, FOREIGN_KEY_CHECKS=0 */; /*!40101 SET @OLD_SQL_MODE=@@SQL_MODE, SQL_MODE='NO_AUTO_VALUE_ON_ZERO' */; /*!40111 SET @OLD_SQL_NOTES=@@SQL_NOTES, SQL_NOTES=0 */; # Dump of table log # ------------------------------------------------------------ DROP TABLE IF EXISTS `log`; CREATE TABLE `log` ( `id` int(11) unsigned NOT NULL AUTO_INCREMENT, `inode` int(11) unsigned NOT NULL, `size` int(11) unsigned NOT NULL, `name` varchar(30) NOT NULL DEFAULT '', `created` datetime DEFAULT NULL, PRIMARY KEY (`id`) ) ENGINE=InnoDB DEFAULT CHARSET=utf8; # Dump of table message # ------------------------------------------------------------ DROP TABLE IF EXISTS `message`; CREATE TABLE `message` ( `id` int(11) unsigned NOT NULL AUTO_INCREMENT, `file_id` int(10) unsigned NOT NULL, `connect_start` datetime NOT NULL, `ip` int(10) unsigned NOT NULL, `qp_pid` int(10) unsigned NOT NULL, `result` tinyint(3) NOT NULL DEFAULT '0', `distance` mediumint(8) unsigned DEFAULT NULL, `time` decimal(3,2) unsigned DEFAULT NULL, `os_id` tinyint(3) unsigned DEFAULT NULL, `hostname` varchar(128) DEFAULT NULL, `helo` varchar(128) DEFAULT NULL, `mail_from` varchar(128) DEFAULT NULL, `rcpt_to` varchar(128) DEFAULT NULL, PRIMARY KEY (`id`), KEY `file_id` (`file_id`), CONSTRAINT `message_ibfk_1` FOREIGN KEY (`file_id`) REFERENCES `log` (`id`) ON DELETE CASCADE ON UPDATE CASCADE ) ENGINE=InnoDB DEFAULT CHARSET=utf8; # Dump of table message_plugin # ------------------------------------------------------------ DROP TABLE IF EXISTS `message_plugin`; CREATE TABLE `message_plugin` ( `id` int(11) unsigned NOT NULL AUTO_INCREMENT, `msg_id` int(11) unsigned NOT NULL, `plugin_id` int(4) unsigned NOT NULL, `result` tinyint(4) NOT NULL, `string` varchar(128) DEFAULT NULL, PRIMARY KEY (`id`), KEY `msg_id` (`msg_id`), KEY `plugin_id` (`plugin_id`), CONSTRAINT `message_plugin_ibfk_1` FOREIGN KEY (`plugin_id`) REFERENCES `plugin` (`id`) ON DELETE CASCADE ON UPDATE CASCADE, CONSTRAINT `msg_id` FOREIGN KEY (`msg_id`) REFERENCES `message` (`id`) ON DELETE CASCADE ON UPDATE CASCADE ) ENGINE=InnoDB DEFAULT CHARSET=utf8; # Dump of table os # ------------------------------------------------------------ DROP TABLE IF EXISTS `os`; CREATE TABLE `os` ( `id` tinyint(3) unsigned NOT NULL AUTO_INCREMENT, `name` varchar(36) DEFAULT NULL, PRIMARY KEY (`id`) ) ENGINE=InnoDB DEFAULT CHARSET=utf8; LOCK TABLES `os` WRITE; /*!40000 ALTER TABLE `os` DISABLE KEYS */; INSERT INTO `os` (`id`, `name`) VALUES (1,'FreeBSD'), (2,'Mac OS X'), (3,'Solaris'), (4,'Linux'), (5,'OpenBSD'), (6,'iOS'), (7,'HP-UX'), (8,'Windows 95'), (9,'Windows 98'), (10,'Windows NT'), (11,'Windows XP'), (12,'Windows XP/2000'), (13,'Windows 2000'), (14,'Windows 2003'), (15,'Windows 7 or 8'), (17,'Google'), (18,'NetCache'), (19,'Cisco'), (20,'Netware'); /*!40000 ALTER TABLE `os` ENABLE KEYS */; UNLOCK TABLES; # Dump of table plugin # ------------------------------------------------------------ DROP TABLE IF EXISTS `plugin`; CREATE TABLE `plugin` ( `id` int(4) unsigned NOT NULL AUTO_INCREMENT, `name` varchar(35) CHARACTER SET utf8 NOT NULL DEFAULT '', `abb3` char(3) CHARACTER SET utf8 DEFAULT NULL, `abb5` char(5) CHARACTER SET utf8 DEFAULT NULL, PRIMARY KEY (`id`), UNIQUE KEY `abb5` (`abb5`) ) ENGINE=InnoDB DEFAULT CHARSET=utf8 COLLATE=utf8_bin; # Dump of table plugin_aliases # ------------------------------------------------------------ DROP TABLE IF EXISTS `plugin_aliases`; CREATE TABLE `plugin_aliases` ( `plugin_id` int(11) unsigned NOT NULL, `name` varchar(35) CHARACTER SET utf8 NOT NULL DEFAULT '', UNIQUE KEY `plugin_id` (`plugin_id`,`name`) ) ENGINE=InnoDB DEFAULT CHARSET=utf8 COLLATE=utf8_bin; /*!40111 SET SQL_NOTES=@OLD_SQL_NOTES */; /*!40101 SET SQL_MODE=@OLD_SQL_MODE */; /*!40014 SET FOREIGN_KEY_CHECKS=@OLD_FOREIGN_KEY_CHECKS */; /*!40101 SET CHARACTER_SET_CLIENT=@OLD_CHARACTER_SET_CLIENT */; /*!40101 SET CHARACTER_SET_RESULTS=@OLD_CHARACTER_SET_RESULTS */; /*!40101 SET COLLATION_CONNECTION=@OLD_COLLATION_CONNECTION */; qpsmtpd-0.94/log/run000077500000000000000000000001271240247602400144520ustar00rootroot00000000000000#!/bin/sh export LOGDIR=./main mkdir -p $LOGDIR exec multilog t s10000000 n20 $LOGDIR qpsmtpd-0.94/log/show_message000077500000000000000000000033471240247602400163410ustar00rootroot00000000000000#!/usr/bin/perl use strict; use warnings; use Data::Dumper; my $QPDIR = get_qp_dir(); my $logfile = "$QPDIR/log/main/current"; my $is_ip = 0; my $search = $ARGV[0]; if (!$search) { die "\nusage: $0 [ ip_address | PID ]\n\n"; } if ($search =~ /^(?:[0-9]{1,3}\.){3}[0-9]{1,3}$/) { #print "it's an IP\n"; $is_ip++; } open my $LOG, '<', $logfile or die "unable to open $logfile\n"; if ($is_ip) { # look for the connection start message for the IP my $ip_matches; while (defined(my $line = <$LOG>)) { next if !$line; my ($tai, $pid, $mess) = split /\s/, $line, 3; if ('Connection from ' eq substr($mess, 0, 16)) { my ($ip) = (split /\s+/, $mess)[-1]; # IP is last word $ip = substr $ip, 1, -1; # trim off brackets if ($ip eq $search) { $ip_matches++; $search = $pid; $is_ip = 0; } } } seek $LOG, 0, 0; die "no pid found for ip $search\n" if $is_ip; print "showing the last of $ip_matches connnections from $ARGV[0]\n"; } print "showing QP message PID $search\n"; while (defined(my $line = <$LOG>)) { next if !$line; my ($tai, $pid, $mess) = split /\s/, $line, 3; next if !$pid; print $mess if ($pid eq $search); } close $LOG; sub get_qp_dir { foreach my $user (qw/ qpsmtpd smtpd /) { my ($homedir) = (getpwnam($user))[7] or next; if (-d "$homedir/plugins") { return "$homedir"; } foreach my $s (qw/ smtpd qpsmtpd qpsmtpd-dev /) { if (-d "$homedir/$s/plugins") { return "$homedir/$s"; } } } if (-d "./plugins") { return Cwd::getcwd(); } } qpsmtpd-0.94/log/summarize000077500000000000000000000424071240247602400156710ustar00rootroot00000000000000#!/usr/bin/perl use strict; use warnings; use Cwd; use Data::Dumper; use File::Tail; use Getopt::Std; $|++; $Data::Dumper::Sortkeys = 1; our $opt_l = 0; getopts('l'); my (%plugins, %plugin_aliases, %seen_plugins, %pids); my %hide_plugins = map { $_ => 1 } qw/ hostname /; my $qpdir = get_qp_dir(); my $file = "$qpdir/log/main/current"; populate_plugins_from_registry(); my @sorted_plugins = sort { $plugins{$a}{id} <=> $plugins{$b}{id} } keys %plugins; my $fh = File::Tail->new( name => $file, interval => 1, maxinterval => 1, debug => 1, tail => 1000 ); my $printed = 0; my $has_cleanup; my %formats = get_default_field_widths(); my %formats3 = ( %formats, map { $_ => "%-3.3s" } qw/ badrcptto check_badrcptto qmail_deliverable rcpt_ok check_basicheaders headers uribl bogus_bounce check_bogus_bounce domainkeys dkim dmarc spamassassin dspam virus::clamdscan / ); while (defined(my $line = $fh->read)) { chomp $line; $line =~ s/[^[ -~]]//g; # strip out binary/unprintable next if !$line; my ($type, $pid, $hook, $plugin, $message) = parse_line($line); next if !$type; next if $type =~ /^(?:info|unknown|response|tcpserver)$/; next if $type eq 'init'; # doesn't occur in all deployment models if (!$pids{$pid}) { # haven't seen this pid next if $type ne 'connect'; # ignore unless connect my ($host, $ip) = split /\s/, $message; $ip = substr $ip, 1, -1; foreach (keys %seen_plugins, qw/ helo_host from to /) { $pids{$pid}{$_} = ''; # define them } $pids{$pid}{ip} = $ip; $pids{$pid}{hostname} = $host if $host ne 'Unknown'; } if ($type eq 'close') { next if $has_cleanup; # it'll get handled later print_auto_format($pid, $line); delete $pids{$pid}; } elsif ($type eq 'cleanup') { print_auto_format($pid, $line); delete $pids{$pid}; } elsif ($type eq 'plugin') { handle_plugin($message,$plugin,$pid,$line); } elsif ($type eq 'reject') { } elsif ($type eq 'connect') { } elsif ($type eq 'dispatch') { handle_dispatch($message,$pid,$line); } else { print "$type $pid $hook $plugin $message\n"; } } sub get_default_field_widths { my %widths = ( ip => "%-15.15s", hostname => "%-20.20s", 'ident::geoip' => $opt_l ? "%-20.20s" : "%-6.6s", 'ident::p0f' => "%-10.10s", distance => "%5.5s", count_unrecognized_commands => "%-5.5s", unrecognized_commands => "%-5.5s", connection_time => "%-4.4s", map { $_ => "%-3.3s" } qw/ dnsbl rhsbl relay karma fcrdns earlytalker check_earlytalker helo tls auth::auth_vpopmail auth::auth_vpopmaild auth::auth_vpopmail_sql auth::auth_checkpassword badmailfrom check_badmailfrom sender_permitted_from resolvable_fromhost dont_require_anglebrackets queue::qmail-queue queue::smtp-forward / ); return %widths; }; sub handle_plugin { my ($message, $plugin, $pid, $line) = @_; return if $plugin eq 'naughty'; # housekeeping only if (!$pids{$pid}{$plugin}) { # first entry for this plugin $pids{$pid}{$plugin} = $message; } else { # subsequent log entry for this plugin if ($pids{$pid}{$plugin} !~ /^(?:pass|fail|skip)/i) { $pids{$pid}{$plugin} = $message; # overwrite 1st } else { #print "ignoring subsequent hit on $plugin: $message\n"; } } if ($plugin eq 'ident::geoip') { if (length $message < 3) { $formats{'ident::geoip'} = "%-3.3s"; $formats3{'ident::geoip'} = "%-3.3s"; } else { my ($gip, $distance) = $message =~ /(.*?),\s+([\d]+)\skm/; if ($distance) { $pids{$pid}{$plugin} = $gip; $pids{$pid}{distance} = $distance; } } } } sub handle_dispatch { my ($message, $pid, $line) = @_; if ($message =~ /^dispatching MAIL FROM/i) { my ($from) = $message =~ /<(.*?)>/; $pids{$pid}{from} = $from || ''; } elsif ($message =~ /^dispatching RCPT TO/i) { my ($to) = $message =~ /<(.*?)>/; $pids{$pid}{to} = $to || ''; } elsif ($message =~ m/dispatching (EHLO|HELO) (.*)/) { $pids{$pid}{helo_host} = $2 || ''; } elsif ($message eq 'dispatching DATA') { } elsif ($message eq 'dispatching QUIT') { } elsif ($message eq 'dispatching STARTTLS') { } elsif ($message eq 'dispatching RSET') { print_auto_format($pid, $line); } else { # anything here is likely an unrecognized command #print "$message\n"; } } sub parse_line { my $line = shift; my ($tai, $pid, $message) = split /\s+/, $line, 3; return if !$message; # garbage in the log file # lines seen many times per connection return parse_line_plugin($line) if substr($message, 0, 1) eq '('; return ('dispatch', $pid, undef, undef, $message) if substr($message, 0, 12) eq 'dispatching '; return ('response', $pid, undef, undef, $message) if $message =~ /^[2|3]\d\d/; return ('tcpserver', $pid, undef, undef, undef) if substr($pid, 0, 10) eq 'tcpserver:'; # lines seen about once per connection return ('init', $pid, undef, undef, $message) if substr($message, 0, 19) eq 'Accepted connection'; return ('connect', $pid, undef, undef, substr($message, 16)) if substr($message, 0, 15) eq 'Connection from'; return ('close', $pid, undef, undef, $message) if substr($message, 0, 6) eq 'close '; return ('close', $pid, undef, undef, $message) if substr($message, 0, 20) eq 'click, disconnecting'; return parse_line_cleanup($line) if substr($message, 0, 11) eq 'cleaning up'; # lines seen less than once per connection return ('info', $pid, undef, undef, $message) if $message eq 'spooling message to disk'; return ('reject', $pid, undef, undef, $message) if $message =~ /^[4|5]\d\d/; return ('reject', $pid, undef, undef, $message) if substr($message, 0, 14) eq 'deny mail from'; return ('reject', $pid, undef, undef, $message) if substr($message, 0, 18) eq 'denysoft mail from'; return ('info', $pid, undef, undef, $message) if substr($message, 0, 15) eq 'Lost connection'; return ('info', $pid, undef, undef, $message) if $message eq 'auth success cleared naughty'; return ('info', $pid, undef, undef, $message) if substr($message, 0, 15) eq 'Running as user'; return ('info', $pid, undef, undef, $message) if substr($message, 0, 16) eq 'Loaded Qpsmtpd::'; return ('info', $pid, undef, undef, $message) if substr($message, 0, 24) eq 'Permissions on spool_dir'; return ('info', $pid, undef, undef, $message) if substr($message, 0, 13) eq 'Listening on '; return ('err', $pid, undef, undef, $message) if $line =~ /at [\S]+ line \d/; # generic perl error print "UNKNOWN LINE: $line\n"; return ('unknown', $pid, undef, undef, $message); } sub parse_line_plugin { my ($line) = @_; # @tai 13486 (connect) ident::p0f: Windows (XP/2000 (RFC1323+, w, tstamp-)) # @tai 13681 (connect) dnsbl: fail, NAUGHTY # @tai 15787 (connect) karma: pass, no penalty (0 naughty, 3 nice, 3 connects) # @tai 77603 (queue) queue::qmail_2dqueue: (for 77590) Queuing to /var/qmail/bin/qmail-queue my ($tai, $pid, $hook, $plugin, $message) = split /\s/, $line, 5; $plugin =~ s/:$//; if ($plugin =~ /_3a/) { ($plugin) = split /_3a/, $plugin; # trim :N off the plugin log entry } $plugin =~ s/_2d/-/g; $plugin = $plugin_aliases{$plugin} if $plugin_aliases{$plugin}; # map alias to master if ($hook eq '(queue)') { ($pid) = $message =~ /\(for ([\d]+)\)\s/; $message = 'pass'; } return ('plugin', $pid, $hook, $plugin, $message); } sub parse_line_cleanup { my ($line) = @_; # @tai 85931 cleaning up after 3210 my $pid = (split /\s+/, $line)[-1]; $has_cleanup++; return ('cleanup', $pid, undef, undef, $line); } sub print_auto_format { my ($pid, $line) = @_; my $format; my @headers; my @values; foreach my $plugin (qw/ ip hostname distance /, @sorted_plugins) { if (defined $pids{$pid}{$plugin}) { if (!$seen_plugins{$plugin}) { # first time seeing this plugin $printed = 0; # force header print } $seen_plugins{$plugin}++; } next if !$seen_plugins{$plugin}; # hide unused plugins if ($hide_plugins{$plugin}) { # user doesn't want to see delete $pids{$pid}{$plugin}; next; } my $wide = $opt_l ? 20 : 8; if (defined $pids{$pid}{helo_host} && $plugin =~ /helo/) { $format .= " %-$wide.${wide}s"; push @values, substr(delete $pids{$pid}{helo_host}, -$wide, $wide); push @headers, 'HELO'; } elsif (defined $pids{$pid}{from} && $plugin =~ /from/) { $format .= " %-$wide.${wide}s"; push @values, substr(delete $pids{$pid}{from}, -$wide, $wide); push @headers, 'MAIL FROM'; } elsif (defined $pids{$pid}{to} && $plugin =~ /to|rcpt|recipient/) { $format .= " %-$wide.${wide}s"; push @values, delete $pids{$pid}{to}; push @headers, 'RCPT TO'; } $format .= $formats3{$plugin} ? " $formats3{$plugin}" : " %-10.10s"; if (defined $pids{$pid}{$plugin}) { push @values, show_symbol(delete $pids{$pid}{$plugin}); } else { push @values, ''; } push @headers, ($plugins{$plugin}{abb3} ? $plugins{$plugin}{abb3} : $plugin); } $format .= "\n"; printf("\n$format", @headers) if (!$printed || $printed % 20 == 0); printf($format, @values); #print Data::Dumper::Dumper($pids{$pid}) if keys %{$pids{$pid}}; $printed++; } sub show_symbol { my $mess = shift; return ' o' if $mess eq 'TLS setup returning'; return ' o' if $mess eq 'pass'; return ' -' if $mess eq 'skip'; return ' x' if 'fail, tolerated' eq substr($mess, 0, 15); return ' X' if $mess eq 'fail'; return ' -' if $mess =~ /^skip[,:\s]/i; return ' o' if $mess =~ /^pass[,:\s]/i; return ' X' if $mess =~ /^fail[,:\s]/i; return ' x' if $mess =~ /^negative[,:\s]/i; return ' o' if $mess =~ /^positive[,:\s]/i; return ' !' if $mess =~ /^error[,:\s]/i; $mess =~ s/\s\s/ /g; return $mess; } sub get_qp_dir { foreach my $user (qw/ qpsmtpd smtpd /) { my ($homedir) = (getpwnam($user))[7] or next; if (-d "$homedir/plugins") { return "$homedir"; } foreach my $s (qw/ smtpd qpsmtpd qpsmtpd-dev /) { if (-d "$homedir/$s/plugins") { return "$homedir/$s"; } } } if (-d "./plugins") { return Cwd::getcwd(); } } sub populate_plugins_from_registry { my $file = "$qpdir/plugins/registry.txt"; if (!-f $file) { die "unable to find plugin registry\n"; } open my $F, '<', $file; while (defined(my $line = <$F>)) { next if $line =~ /^#/; # discard comments chomp $line; next if ! $line; my ($id, $name, $abb3, $abb5, $aliases) = split /\s+/, $line; next if !defined $name; $plugins{$name} = {id => $id, abb3 => $abb3, abb5 => $abb5}; next if !$aliases; $aliases =~ s/\s+//g; $plugins{$name}{aliases} = $aliases; foreach my $a (split /,/, $aliases) { $plugin_aliases{$a} = $name; } } } __END__ =head1 NAME Summarize =head2 SYNOPSIS Parse the qpsmtpd logs and display a one line summary of each connection =head2 EXAMPLES ip dista geo p0f krm dbl rly dns ear HELO hlo tls MAIL FRO bmf rbl rfh spf RCPT TO bto qmd rok tim 192.48.85.146 2705 NA, US FreeBSD 9. o o - o - tnpi.net o o 0.55 190.194.22.35 7925 SA, AR Windows 7 X X - X o a.net.ar x ogle.com o o o x *o*g@sim o o o 2.72 192.48.85.146 2705 NA, US - o o - o - tnpi.net o 0.41 181.164.160.98 8493 SA, AR Windows 7 X X - X o l.com.ar x ogle.com o o o x trapped@ o o o 2.61 188.79.146.22 8381 EU, ES Windows 7 o X - o o zztel.es o ogle.com o o o x *o**an@s o o o 3.02 188.79.146.22 8381 EU, ES Windows 7 o X - o o zztel.es o ogle.com o o o x *o**an@s o o o 2.58 188.79.146.22 8381 EU, ES Windows 7 o X - o o zztel.es o ogle.com o o o x *o**an@s o o o 2.70 190.194.22.35 7925 SA, AR Windows 7 X X - X o a.net.ar x ogle.com o o o x do*g@s*m o o o 2.60 ip dista geo p0f krm dbl rly dns ear HELO hlo tls MAIL FRO bmf rbl rfh spf RCPT TO bto qmd rok bog hdr dky dkm dmc spm dsp clm qqm tim 192.48.85.146 2705 NA, US FreeBSD 9. o o - o - tnpi.net o o 1.36 192.48.85.146 2705 NA, US - o o - o - tnpi.net o 0.36 66.175.56.179 2313 NA, US Linux 2.6. o o - o - zone.com o o chem.com o o o - d**n@the o o o o o - o - - - - o 2.86 190.237.55.32 5411 SA, PE Windows 7 o X - X o gtsgnvnu x ryrk.net o o x - *an@s*rl o o o 3.54 192.48.85.146 2705 NA, US - o o - o - tnpi.net o 0.20 207.171.174.77 2700 NA, US o o - o - azon.com o azon.com o o o o *a*e@s*r o o o o o - o o o o o o 7.27 201.141.78.4 1487 NA, MX Windows XP o X - X o fmhufhjo x fdvx.net o o x - d**@si*e o o o 2.95 201.141.78.4 1487 NA, MX Windows XP X X - X o fmhufhjo x fdvx.net o o x - d**@s*rl o o o 2.42 The display autosizes to display disposition results for as many plugins as are emitting logs. The 3 char abbreviations are listed with their full plugin names in plugins/registry.txt. The GeoIP, p0f, HELO, FROM, and RCPT fields are compressed to fit on a typical display. If you have a wider display, use the -l option to display longer lines and more detail. Starting from left to right, in the first block, the results are interpreted as follows: geo - We see 2 connections from N. America, 3 from S. America, and 3 from Europe. p0f - One system is running FreeBSD and the rest are running Windows 7. krm - 3 of the connections will be rejected because of bad karma (sender history) dbl - 7 are from IPs on DNS blacklists, an offense worth rejecting for. rly - None of the IPs have relay permission. dns - Only three senders have Forward Confirmed Reverse DNS ear - two connections skipped testing (good karma), and the rest passed hlo - three of the senders failed to present valid HELO hostnames tls - one sender negotiated TLS bmf - none of the senders presented a from address in our badmailfrom list rbl - none of the sender domains are in a RHS blocking list rfh - resolvable_from_host: all the sender domains resolve spf - all but two connections fail SPF, meaning they are forging the envelope sender identity bto - badmailto: none of the recipients are in our badmailto list qmd - qmail_deliverable: the recipients are valid addresses on our system rok - the recipient domain is on our system tim - the number of seconds the connection was active In the second block, we have two messages that were ultimately delivered. bog - no messages were bogus bounces hdr - the messages had valid headers dky - the messages were not DomainKeys signed dkm - two messages were DKIM signed and passed validation dmc - the message from amazon.com passed DMARC validation spm - spamassassin, one skipped processing, one passed dsp - dspam, one skipped, one passed clm - clamav, one skipped, one passed qqm - qmail queue, two messages were delivered In the first block of entries, not a single connection made it past the DATA phase of the SMTP conversation, where the content tests kick in. Other interesting observations are that many connections purport to be from Google. Ah, you say, but does Google have Windows mail servers in Estonia? If we look over to the SPF column, the lower case x is telling us that it failed SPF tests, meaning Google has explicitely told us that IP is not theirs. Instead of rejecting immediately, the SPF plugin deferred the rejection to B to disconnect later. =head1 AUTHOR Matt Simerson =cut qpsmtpd-0.94/log/watch000077500000000000000000000020351240247602400147540ustar00rootroot00000000000000#!/usr/bin/perl use strict; use warnings; $|++; # OUTPUT_AUTOFLUSH use Cwd; use Data::Dumper; use File::Tail; my $dir = get_qp_dir() or die "unable to find QP home dir"; my $file = "$dir/log/main/current"; my $fh = File::Tail->new( name => $file, interval => 1, maxinterval => 1, debug => 1, tail => 300 ); while (defined(my $line = $fh->read)) { my (undef, $line) = split /\s/, $line, 2; # strip off tai timestamps print $line; } sub get_qp_dir { foreach my $user (qw/ qpsmtpd smtpd /) { my ($homedir) = (getpwnam($user))[7] or next; if (-d "$homedir/plugins") { return "$homedir"; } foreach my $s (qw/ smtpd qpsmtpd qpsmtpd-dev /) { if (-d "$homedir/$s/plugins") { return "$homedir/$s"; } } } if (-d "./plugins") { return Cwd::getcwd(); } } qpsmtpd-0.94/packaging/000077500000000000000000000000001240247602400150635ustar00rootroot00000000000000qpsmtpd-0.94/packaging/rpm/000077500000000000000000000000001240247602400156615ustar00rootroot00000000000000qpsmtpd-0.94/packaging/rpm/Makefile000066400000000000000000000110211240247602400173140ustar00rootroot00000000000000# -- generic Makefile for building RPM-based packages out of source # code control systems (git, cvs, svn) SCM_TYPE := git SCM_PATH := ../../ #CVSROOT := $(shell cat 2>/dev/null src/CVS/Root) #SVN_PATH := $(shell svn info ${SCM_PATH} 2>/dev/null | awk '/^URL:/{print $$2}') #SVN_REV := $(shell svn info ${SVN_PATH} 2>/dev/null | awk '/^Last Changed Rev:/{print $$4}') PACKAGE := $(shell cat PACKAGE) VERSION := $(shell cat VERSION) RELEASE := $(shell cat RELEASE) BASE_VER := ${VERSION}-${RELEASE} CURRENT_PACKAGE := $(PACKAGE)-$(BASE_VER) TARBALL := $(CURRENT_PACKAGE).tar DIRNAME := $(shell echo $${PWD}) DIRBASE := $(shell basename $${PWD}) .SUFFIXES: .PHONY: clean mrclean distclean prepclean all default .PHONY: rpm rpmdist buildrpm buildrpmdist .PHONY: buildtarball buildtargz .PHONY: builddir distdir prepbuildtarball .PHONY: cvs-export git-export svn-export test-export .PHONY: cvs-clean git-clean svn-clean test-clean .PHONY: update default: rpmdist # -- the "rpmdist" target will build out of the SCM, but will # use the user's default build settings (which in many cases # is exposed as an RPM repository) # #rpmdist: buildrpmdist distclean rpmdist: buildrpmdist buildrpmdist: buildtargz @rpmbuild \ --define "_package ${PACKAGE}" \ --define "_version ${VERSION}" \ --define "_release ${RELEASE}" \ -ta ./build/$(TARBALL).gz # -- the "srpmdist" target will build an SRPM out of the SCM, but # will use the user's default build settings (which in many # cases is exposed as an RPM repository) # srpmdist: buildsrpmdist buildsrpmdist: buildtargz @rpmbuild \ --define "_package ${PACKAGE}" \ --define "_version ${VERSION}" \ --define "_release ${RELEASE}" \ -ts --nodeps ./build/$(TARBALL).gz # -- the "rpm" target will build out of the SCM, but will leave # the resulting package in the relative ./build/ directory # rpm: buildrpm $(SCM_TYPE)-clean buildrpm: buildtargz @echo ${PACKAGE} ${VERSION} ${RELEASE} @rpmbuild \ --define "_rpmdir ./build/" \ --define "_sourcedir ./build/" \ --define "_srcrpmdir ./build/" \ --define "_package ${PACKAGE}" \ --define "_version ${VERSION}" \ --define "_release ${RELEASE}" \ -ta ./build/$(TARBALL).gz # -- the "srpm" target will build an SRPM out of the SCM, but # will leave the resulting package in the relative ./build/ # directory # srpm: buildsrpm $(SCM_TYPE)-clean buildsrpm: buildtargz @echo ${PACKAGE} ${VERSION} ${RELEASE} @rpmbuild \ --define "_rpmdir ./build/" \ --define "_sourcedir ./build/" \ --define "_srcrpmdir ./build/" \ --define "_package ${PACKAGE}" \ --define "_version ${VERSION}" \ --define "_release ${RELEASE}" \ -ts --nodeps ./build/$(TARBALL).gz buildtarball: prepbuildtarball @tar \ --create \ --directory ./build/ \ --file ./build/$(TARBALL) \ ${CURRENT_PACKAGE} buildtargz: buildtarball @gzip -c < ./build/$(TARBALL) > ./build/$(TARBALL).gz prepbuildtarball: $(SCM_TYPE)-export ${MAKE} update \ && cp ${PACKAGE}.spec ./build/${CURRENT_PACKAGE} \ && cp files/* ./build/ test-clean: @cd .. \ && rm "$(CURRENT_PACKAGE)" test-export: builddir @cd .. \ && ln -snvf $(DIRBASE) $(CURRENT_PACKAGE) \ && tar \ --create \ --dereference \ --to-stdout \ --exclude "*.git*" \ --exclude "*.svn*" \ --exclude "*/CVS/*" \ --exclude "$(CURRENT_PACKAGE)/build/*" \ $(CURRENT_PACKAGE) \ | tar \ --extract \ --directory $(CURRENT_PACKAGE)/build/ \ --file - git-export: builddir prepclean (cd $(SCM_PATH) ; git archive --format=tar --prefix=$(CURRENT_PACKAGE)/ HEAD) \ | tar \ --extract \ --directory ./build/ \ --file - git-clean: @: cvs-export: builddir prepclean @cd ./build/ \ && echo CURRENT_PACKAGE: ${CURRENT_PACKAGE} \ && echo CVSROOT: ${CVSROOT} \ && CVSROOT=${CVSROOT} cvs export -r HEAD -d$(CURRENT_PACKAGE) ${PACKAGE} cvs-clean: @: svn-export: builddir prepclean @cd ./build/ \ && svn export $(SVN_PATH) $(CURRENT_PACKAGE) svn-clean: @: builddir: @mkdir -p ./build distdir: @mkdir -p ./dist prepclean: @rm -rf ./build/$(CURRENT_PACKAGE)* clean: @rm -rf ./build/* ./dist/* 2>/dev/null || : mrclean: clean distclean: clean $(SCM_TYPE)-clean @rmdir ./build/ ./dist/ 2>/dev/null || : # -- recursive Makefile calls (during build phase) # update: $(PACKAGE).spec VERSION RELEASE $(PACKAGE).spec: VERSION RELEASE $(PACKAGE).spec.in @sed \ -e "s|@PACKAGE@|$(PACKAGE)|" \ -e "s|@VERSION@|$(VERSION)|" \ -e "s|@RELEASE@|$(RELEASE)|" \ < $(PACKAGE).spec.in > $@ # -- end of Makefile qpsmtpd-0.94/packaging/rpm/PACKAGE000066400000000000000000000000101240247602400166260ustar00rootroot00000000000000qpsmtpd qpsmtpd-0.94/packaging/rpm/RELEASE000066400000000000000000000000041240247602400166560ustar00rootroot000000000000000.1 qpsmtpd-0.94/packaging/rpm/VERSION000066400000000000000000000000051240247602400167240ustar00rootroot000000000000000.82 qpsmtpd-0.94/packaging/rpm/files/000077500000000000000000000000001240247602400167635ustar00rootroot00000000000000qpsmtpd-0.94/packaging/rpm/files/README.selinux000066400000000000000000000005141240247602400213310ustar00rootroot00000000000000If you run qpsmtpd-apache on a box with SELinux enabled, you'll need to allow apache to listen to your SMTP port, typically port 25. The following command allows apache to listen on port 25: semanage port -m -t http_port_t -p tcp 25 Use the -d option to remove this permission: semanage port -d -t http_port_t -p tcp 25 qpsmtpd-0.94/packaging/rpm/files/in.qpsmtpd000077500000000000000000000001201240247602400207770ustar00rootroot00000000000000#!/bin/sh export QPSMTPD_CONFIG=/etc/qpsmtpd exec /usr/bin/qpsmtpd 2> /dev/null qpsmtpd-0.94/packaging/rpm/files/qpsmtpd-forkserver.rc000077500000000000000000000043531240247602400231770ustar00rootroot00000000000000#! /bin/bash # # qpsmtpd-forkserver Start/Stop the qpsmtpd forking server # # chkconfig: 2345 90 60 # description: qpsmtpd is a flexible smtpd daemon written in Perl. \ # Apart from the core SMTP features, all functionality is \ # implemented in small "extension plugins" using the easy \ # to use object oriented plugin API. # processname: qpsmtpd-forkserver # config: /etc/qpsmtpd # pidfile: /var/run/qpsmtpd-forkserver.pid # Source function library. . /etc/init.d/functions . /etc/sysconfig/qpsmtpd-forkserver RETVAL=0 # See how we were called. prog="qpsmtpd-forkserver" start() { # cleanup environment a bit. unset PERL_UNICODE unset LANG unset LC_TIME unset LC_ALL unset BASH_ENV unset ENV unset CDPATH unset IFS echo -n $"Starting $prog: " trap "" 1 daemon $prog --detach $QPSMTPD_OPTIONS RETVAL=$? echo [ $RETVAL -eq 0 ] && touch /var/lock/subsys/$prog return $RETVAL } stop() { echo -n $"Stopping $prog: " killproc $prog RETVAL=$? echo [ $RETVAL -eq 0 ] && rm -f /var/lock/subsys/$prog return $RETVAL } # functions status() uses pidof, which doesn't work with (?) scripts qpstatus() { local base=${1##*/} local pid # Test syntax. if [ "$#" = 0 ] ; then echo $"Usage: status {program}" return 1 fi # Use "/var/run/*.pid" file for pid if [ -f /var/run/${base}.pid ] ; then read pid < /var/run/${base}.pid if [ -n "$pid" ]; then /bin/ps -p $pid >/dev/null if [ $? -eq 0 ]; then echo $"${base} (pid $pid) is running..." return 0 else echo $"${base} dead but pid file exists" return 1 fi fi fi # See if /var/lock/subsys/${base} exists if [ -f /var/lock/subsys/${base} ]; then echo $"${base} dead but subsys locked" return 2 fi echo $"${base} is stopped" return 3 } restart() { stop start } reload() { stop start } case "$1" in start) start ;; stop) stop ;; restart) restart ;; reload) reload ;; status) qpstatus qpsmtpd-forkserver ;; condrestart) [ -f /var/lock/subsys/$prog ] && restart || : ;; *) echo $"Usage: $0 {start|stop|status|reload|restart|condrestart}" exit 1 esac exit $? qpsmtpd-0.94/packaging/rpm/files/qpsmtpd-forkserver.sysconfig000066400000000000000000000002061240247602400245650ustar00rootroot00000000000000QPSMTPD_OPTIONS="-p 25 -l 127.0.0.1 --pid-file /var/run/qpsmtpd-forkserver.pid" export QPSMTPD_CONFIG=/etc/qpsmtpd export HOME=~smtpd qpsmtpd-0.94/packaging/rpm/files/qpsmtpd-xinetd000066400000000000000000000006001240247602400216630ustar00rootroot00000000000000# default: on # description: The telnet server serves telnet sessions; it uses \ # unencrypted username/password pairs for authentication. service smtp { flags = REUSE socket_type = stream wait = no user = smtpd groups = yes server = /usr/sbin/in.qpsmtpd log_on_failure += USERID disable = yes rlimit_as = 128M instances = 40 per_source = 10 cps = 50 10 } qpsmtpd-0.94/packaging/rpm/files/qpsmtpd.conf000066400000000000000000000007741240247602400213320ustar00rootroot00000000000000Listen 0.0.0.0:25 smtp AcceptFilter smtp none ## "smtp" and the AcceptFilter are required for Linux, FreeBSD ## with apache >= 2.1.5, for others it doesn't hurt. See also ## http://httpd.apache.org/docs/2.2/mod/core.html#acceptfilter ## and http://httpd.apache.org/docs/2.2/mod/mpm_common.html#listen use Apache::Qpsmtpd; $ENV{QPSMTPD_CONFIG} = "/etc/qpsmtpd"; PerlModule Apache::Qpsmtpd PerlProcessConnectionHandler Apache::Qpsmtpd qpsmtpd-0.94/packaging/rpm/qpsmtpd.spec.in000066400000000000000000000306171240247602400206410ustar00rootroot00000000000000%{!?_package:%define _package @PACKAGE@} %{!?_version:%define _version @VERSION@} %{!?_release:%define _release @RELEASE@} Name: %{_package} Version: %{_version} Release: %{_release} Summary: qpsmtpd + qpsmtpd-apache + qpsmtpd-async License: MIT Group: System Environment/Daemons URL: http://smtpd.develooper.com/ BuildRoot: %{_builddir}/%{name}-%{version}-%{release}-root BuildRequires: perl >= 0:5.00503 BuildRequires: perl(ExtUtils::MakeMaker) BuildArchitectures: noarch Requires: perl(Mail::Header), perl(Net::DNS) perl(Net::IP) perl(IPC::Shareable) Requires(pre): coreutils, shadow-utils, perl Source0: %{name}-%{version}-%{release}.tar.gz Source1: qpsmtpd-forkserver.rc Source2: qpsmtpd-forkserver.sysconfig Source3: qpsmtpd-xinetd Source4: in.qpsmtpd Source5: qpsmtpd.conf Source6: README.selinux %description qpsmtpd is a flexible smtpd daemon written in Perl. Apart from the core SMTP features, all functionality is implemented in small "extension plugins" using the easy to use object oriented plugin API. qpsmtpd was originally written as a drop-in qmail-smtpd replacement, but now it also includes a smtp forward and a postfix "backend". %package apache Requires: perl(mod_perl2) Summary: mod_perl-2 connection handler for qpsmtpd Group: System Environment/Daemons %package async Summary: qpsmtpd using async I/O in a single process Group: System Environment/Daemons %package xinetd Summary: xinetd support for qpsmtpd Group: System Environment/Daemons Requires: xinetd %description apache This module implements a mod_perl/apache 2.0 connection handler that turns Apache into an SMTP server using Qpsmtpd. %description async This package contains the Qpsmtpd::PollServer module, which allows qpsmtd to handle many connections in a single process and the qpsmpd-async which uses it. %description xinetd This package contains the xinetd startup files for qpsmptd. %prep %setup -q -n %{name}-%{version}-%{release} %build CFLAGS="$RPM_OPT_FLAGS" perl Makefile.PL INSTALLSITELIB=%{_prefix}/lib/perl5/site_perl make %clean rm -rf $RPM_BUILD_ROOT %install rm -rf $RPM_BUILD_ROOT eval `perl '-V:installarchlib'` mkdir -p $RPM_BUILD_ROOT/$installarchlib if grep -q DESTDIR Makefile then make DESTDIR=$RPM_BUILD_ROOT find blib/lib -name '*.pm.*' -exec rm -f {} \; make DESTDIR=$RPM_BUILD_ROOT install else make PREFIX=$RPM_BUILD_ROOT/usr find blib/lib -name '*.pm.*' -exec rm -f {} \; make PREFIX=$RPM_BUILD_ROOT/usr install fi mkdir -p ${RPM_BUILD_ROOT}%{_datadir}/%{name} rm -f ${RPM_BUILD_ROOT}%{_datadir}/%{name}/plugins/*.* cp -r plugins ${RPM_BUILD_ROOT}%{_datadir}/%{name}/plugins mkdir -p ${RPM_BUILD_ROOT}%{_sysconfdir}/%{name} rm -f ${RPM_BUILD_ROOT}%{_sysconfdir}/%{name}/*.* cp -r config.sample/* ${RPM_BUILD_ROOT}%{_sysconfdir}/%{name}/ echo %{_datadir}/%{name}/plugins > ${RPM_BUILD_ROOT}%{_sysconfdir}/%{name}/plugin_dirs echo %{_localstatedir}/spool/qpsmtpd > ${RPM_BUILD_ROOT}%{_sysconfdir}/%{name}/spool_dir mkdir -p ${RPM_BUILD_ROOT}%{_initrddir} cp %{SOURCE1} ${RPM_BUILD_ROOT}%{_initrddir}/qpsmtpd-forkserver mkdir -p ${RPM_BUILD_ROOT}%{_sysconfdir}/sysconfig cp %{SOURCE2} ${RPM_BUILD_ROOT}%{_sysconfdir}/sysconfig/qpsmtpd-forkserver mkdir -p ${RPM_BUILD_ROOT}%{_localstatedir}/spool/qpsmtpd mkdir -p ${RPM_BUILD_ROOT}%{_localstatedir}/log/qpsmtpd mkdir -p ${RPM_BUILD_ROOT}%{_sysconfdir}/xinetd.d cp %{SOURCE3} ${RPM_BUILD_ROOT}%{_sysconfdir}/xinetd.d/smtp mkdir -p ${RPM_BUILD_ROOT}%{_sbindir} cp %{SOURCE4} ${RPM_BUILD_ROOT}%{_sbindir}/in.qpsmtpd mkdir -p ${RPM_BUILD_ROOT}%{_sysconfdir}/httpd/conf.d cp %{SOURCE5} ${RPM_BUILD_ROOT}%{_sysconfdir}/httpd/conf.d mkdir -p $RPM_BUILD_ROOT%{_docdir}/%{name}-apache-%{version} cp %{SOURCE6} $RPM_BUILD_ROOT%{_docdir}/%{name}-apache-%{version} [ -x /usr/lib/rpm/brp-compress ] && /usr/lib/rpm/brp-compress find ${RPM_BUILD_ROOT}%{_prefix} \( -name perllocal.pod -o -name .packlist \) -exec rm {} \; find ${RPM_BUILD_ROOT}%{_prefix} -type f -print | \ sed "s@^$RPM_BUILD_ROOT@@g" | \ grep -v [Aa]sync | \ grep -v packaging | \ grep -v README.selinux | \ grep -v in\\.qpsmtpd | \ grep -v /Apache | \ grep -v /Danga | \ grep -v ConfigServer | \ grep -v Qpsmtpd/PollServer.pm > %{name}-%{version}-%{release}-filelist if [ "$(cat %{name}-%{version}-%{release}-filelist)X" = "X" ] ; then echo "ERROR: EMPTY FILE LIST" exit -1 fi find ${RPM_BUILD_ROOT}%{_prefix} -type f -print | \ sed "s@^$RPM_BUILD_ROOT@@g" | \ grep -v packaging | \ grep -v README.selinux | \ grep -v /Apache | cat - %{name}-%{version}-%{release}-filelist | sort | uniq -u > %{name}-%{version}-%{release}-async-filelist if [ "$(cat %{name}-%{version}-%{release}-async-filelist)X" = "X" ] ; then echo "ERROR: EMPTY FILE LIST" exit -1 fi find ${RPM_BUILD_ROOT}%{_prefix} -type f -print | \ sed "s@^$RPM_BUILD_ROOT@@g" | \ grep -v [Aa]sync | \ grep -v packaging | \ grep -v /Danga | \ grep -v ConfigServer | \ grep -v Qpsmtpd/PollServer.pm | cat - %{name}-%{version}-%{release}-filelist | sort | uniq -u > %{name}-%{version}-%{release}-apache-filelist if [ "$(cat %{name}-%{version}-%{release}-apache-filelist)X" = "X" ] ; then echo "ERROR: EMPTY FILE LIST" exit -1 fi %files -f %{name}-%{version}-%{release}-filelist %defattr(-,root,root) %doc CREDITS Changes LICENSE README README.plugins STATUS %{_initrddir}/qpsmtpd-forkserver %config(noreplace) %{_sysconfdir}/qpsmtpd/* %config(noreplace) %{_sysconfdir}/sysconfig/qpsmtpd-forkserver %attr(2750,qpsmtpd,clamav) %dir %{_localstatedir}/spool/qpsmtpd %attr(0750,smtpd,smtpd) %dir %{_localstatedir}/log/qpsmtpd %files apache -f %{name}-%{version}-%{release}-apache-filelist %defattr(-,root,root) %config(noreplace) %{_sysconfdir}/httpd/conf.d/* %doc %{_docdir}/%{name}-apache-%{version}/README.selinux %files async -f %{name}-%{version}-%{release}-async-filelist %defattr(-,root,root) %{_datadir}/%{name}/plugins/async/* %files xinetd %defattr(-,root,root) %config(noreplace) %{_sysconfdir}/xinetd.d/smtp %{_sbindir}/in.qpsmtpd %pre if ! id smtpd >/dev/null 2>&1 then # need to create smtpd user. if perl -e 'exit ! defined(getgrnam("postdrop"))' then # if postfix is installed, we will probably use # queue/postfix, which will need this: supp="-G postdrop" fi useradd -r -M -s /bin/false $supp smtpd fi %changelog * Fri Oct 14 2011 0.84-1 - Removed rpm/files/qpsmtpd-plugin-file_connection as there's a newer version in plugins/logging/file * Sat Feb 13 2010 - Split out xinetd files into separate RPM * Sun Jul 12 2009 0.82-0.1 - Update to latest release - don't add qpsmtpd to start-up by default - add apache config file to qpsmtpd-apache package - remove all patches - use rpm macros for dirs - use a filelist for main package instead of a long list of files * Tue Jul 15 2008 0.43-0.7 - Removed SelectServer.pm from .spec file * Tue Mar 18 2008 0.43-0.6 - moved config files back to /etc/qpsmtpd following some changes to the qpsmtpd src * Tue Mar 18 2008 0.43-0.5 - moved config files to /etc/qpsmtpd/config * Tue Mar 18 2008 0.43-0.4 - Moved qpsmtpd-async to /usr/bin - Added qpsmtpd-async man page to async package - Added async smtproute plugin to async package * Wed Mar 12 2008 0.43-0.3 - Makefile.PL now updated in svn, so remove hack * Wed Mar 12 2008 0.43-0.2 - Added qpsmtpd-prefork to qpsmtpd RPM, inc. hack to work round deficiency in Makefile.PL * Mon Mar 10 2008 0.43-0.1 - Updated to work with Makefile to build from svn * Wed Sep 12 2007 0.40-2.0 - Updated to build trunk-r790 * Tue Jun 12 2007 0.40-1.0 - updated to 0.40 - no code change. * Thu Jun 07 2007 0.40-0.2 - unset environment variables which are normally tainted in perl. - updated to 0.40rc1 - added dependency on Net::IP (needed by some plugins) * Sat May 05 2007 0.33-0.5 - moved environment cleanup into start() function, otherwise LANG just gets reinitialized. * Sat May 05 2007 0.33-0.4 - split qpsmtpd-async into a separate package to avoid dependency on ParaDNS. * Sat May 05 2007 0.33-0.3 - also unset LANG, LC_ALL and LC_TIME in startup script to prevent locale specific Received headers (bug reported by Dominik Meyer) * Sun Feb 25 2007 0.33-0.2 - 0.3x branch has been merged back to trunk. Got current snapshot (r715) from trunk. * Sun Feb 25 2007 0.33-0.1 - Start forkserver via "daemon" (Gavin Carr) - Fixed 'service qpsmtpd-forkserver status' (Gavin Carr) - Changed policy for config files to noreplace (Gavin Carr) * Sun Nov 05 2006 0.33-0.0 - Upgraded to current snapshot from 0.3x branch (which should become 0.33 soon-ish) - included xinetd-support again. * Sat Mar 18 2006 0.32-2 - fix dnsbl to check whether answer fits query. - randomize Net::DNS ids for qpsmtpd-forkserver child processes. * Wed Mar 08 2006 0.32-1 - New upstream 0.32 - rc-file unsets PERL_UNICODE (bug #38397) * Sat Jan 28 2006 0.31.1-3 - Use ${SOURCE*} macros to refer to source files - Avoid invoking rpm and other cleanup in pre section - Invoke chkconfig in post. - (Thanks to Josko Plazonic for the reporting these problems and suggesting fixes) * Tue Nov 30 2005 0.31.1-2 - Revision 170 of plugins/loggin/file_connection: Return DECLINED from open_log. Open log in write_log if it isn't already open. * Tue Nov 29 2005 0.31.1-1 - Commented out queue plugins from sample config - Added dependencies - Create smtpd user if it doesn't exist - Added /var/log/qpsmtpd and /var/spool/qpsmtpd * Sat Nov 26 2005 - Added file_connection plugin - Startup file for qpsmtpd-forkserver now uses --detach and assumes that a suitable logging module is configured (file_connection by default) * Wed Nov 23 2005 - Forkserver drops privileges before loading plugins now. * Sun Nov 20 2005 - New upstream 0.31.1 * Mon Nov 14 2005 0.31-8 - New upstream 0.31rc3. - pre-connection patch slightly simplified since upstream fixed one of the bugs. * Tue Aug 23 2005 - forced INSTALLSITELIB=/usr/lib/perl5/site_perl as suggested by Charlie Brady. * Sat Aug 20 2005 0.31-7 - RC2 from upstream. - Removed patches which aren't applied from spec file. * Fri Jul 22 2005 0.31-6 - New upstream snapshot from 0.31 branch: svn revision 509. * Sun Jul 17 2005 0.31-5 - include only /etc/init.d/qpsmtpd-forkserver, not /etc/init.d it conflicts with old initscripts packages. * Sun Jul 17 2005 0.31-4 - removed tabs from forkserver * Sun Jul 17 2005 0.31-3 - added startup script for forkserver - changed BuildArchitectures to noarch. * Sat Jul 16 2005 0.31-2 - pre-connection hook is now actually called, not just defined. * Fri Jul 15 2005 0.31-1 - merged with 0.31. Most of my patches are now in the official release. - merged Gavin's per-user-config patch with my dirs patch, since the latter needs a way to turn off logging. - added /etc/qpsmtpd/plugin_dir to package. * Mon Jun 13 2005 0.29-6 - fixed removal of patch backup files - fixed option --pid-file * Sun Jun 12 2005 - avoid installing patch backup files - split Apache::Qpsmtpd into separate package to avoid dependency hell. - fixed URL - changed group to Daemons. - Fixed installation for newer versions of ExtUtils::MakeMaker * Wed Jun 1 2005 0.29-5 - Really don't reap children in signal handler. * Tue May 31 2005 0.29-4 - Return 421 for DENYSOFT_DISCONNECT - Don't reap children in signal handler. * Thu May 19 2005 0.29-3 - removed code to accept paths without <>. * Thu May 19 2005 0.29-2 - added QPSMTPD_CONFIG env variable and plugin_dir config. - added supplemental groups and support for pid file - added shared_connect hook - changed log level for SMTP dialog from DEBUG to INFO * Thu Apr 21 2005 hjp@hjp.at - added plugins, /etc and docs. * Mon Apr 18 2005 hjp@hjp.at - Specfile autogenerated qpsmtpd-0.94/plugins/000077500000000000000000000000001240247602400146205ustar00rootroot00000000000000qpsmtpd-0.94/plugins/async/000077500000000000000000000000001240247602400157355ustar00rootroot00000000000000qpsmtpd-0.94/plugins/async/dns_whitelist_soft000066400000000000000000000046361240247602400216040ustar00rootroot00000000000000#!perl -w use Qpsmtpd::Plugin::Async::DNSBLBase; sub init { my $self = shift; my $class = ref $self; no strict 'refs'; push @{"${class}::ISA"}, 'Qpsmtpd::Plugin::Async::DNSBLBase'; } sub hook_connect { my ($self, $transaction) = @_; my $class = ref $self; my %whitelist_zones = map { (split /\s+/, $_, 2)[0, 1] } $self->qp->config('whitelist_zones'); return DECLINED unless %whitelist_zones; my $remote_ip = $self->connection->remote_ip; my $reversed_ip = join(".", reverse(split(/\./, $remote_ip))); # type TXT lookup only return DECLINED unless $class->lookup($self->qp, [], [map { "$reversed_ip.$_" } keys %whitelist_zones], ); return YIELD; } sub process_txt_result { my ($class, $qp, $result, $query) = @_; my $connection = $qp->connection; $connection->notes('whitelisthost', $result) unless $connection->notes('whitelisthost'); } sub hook_rcpt { my ($self, $transaction, $rcpt) = @_; my $connection = $self->qp->connection; if (my $note = $connection->notes('whitelisthost')) { my $ip = $connection->remote_ip; $self->log(LOGNOTICE, "Host $ip is whitelisted: $note"); } return DECLINED; } =head1 NAME dns_whitelist_soft - dns-based whitelist override for other qpsmtpd plugins =head1 DESCRIPTION The dns_whitelist_soft plugin allows selected host to be whitelisted as exceptions to later plugin processing. It is most suitable for multisite installations, so that the whitelist is stored in one location and available from all. =head1 CONFIGURATION To enable the plugin, add it to the ~qpsmtpd/config/plugins file as usual. It should precede any plugins whose rejections you wish to override. You may have to alter those plugins to check the appropriate notes field. Several configuration files are supported, corresponding to different parts of the SMTP conversation: =over 4 =item whitelist_zones Any IP address listed in the whitelist_zones file is queried using the connecting MTA's IP address. Any A or TXT answer means that the remote HOST address can be selectively exempted at other stages by plugins testing for a 'whitelisthost' connection note. =back NOTE: in contrast to the non-async version, the other 'connect' hooks fired after the 'connect' hook of this plugin will see the 'whitelisthost' connection note, if set by this plugin. =cut qpsmtpd-0.94/plugins/async/dnsbl000066400000000000000000000130451240247602400167650ustar00rootroot00000000000000#!perl -w use Qpsmtpd::Plugin::Async::DNSBLBase; sub init { my ($self, $qp, $denial) = @_; my $class = ref $self; { no strict 'refs'; push @{"${class}::ISA"}, 'Qpsmtpd::Plugin::Async::DNSBLBase'; } if (defined $denial and $denial =~ /^disconnect$/i) { $self->{_dnsbl}->{DENY} = DENY_DISCONNECT; } else { $self->{_dnsbl}->{DENY} = DENY; } } sub hook_connect { my ($self, $transaction) = @_; my $class = ref $self; my $remote_ip = $self->connection->remote_ip; my $allow = grep { s/\.?$/./; $_ eq substr($remote_ip . '.', 0, length $_) } $self->qp->config('dnsbl_allow'); return DECLINED if $allow; my %dnsbl_zones = map { (split /:/, $_, 2)[0, 1] } $self->qp->config('dnsbl_zones'); return DECLINED unless %dnsbl_zones; my $reversed_ip = join(".", reverse(split(/\./, $remote_ip))); my @A_zones = grep { defined($dnsbl_zones{$_}) } keys %dnsbl_zones; my @TXT_zones = grep { !defined($dnsbl_zones{$_}) } keys %dnsbl_zones; if (@A_zones) { # message templates for responding to the client $self->connection->notes( dnsbl_templates => { map { +"$reversed_ip.$_" => $dnsbl_zones{$_} } @A_zones } ); } return DECLINED unless $class->lookup($self->qp, [map { "$reversed_ip.$_" } @A_zones], [map { "$reversed_ip.$_" } @TXT_zones], ); return YIELD; } sub process_a_result { my ($class, $qp, $result, $query) = @_; my $conn = $qp->connection; return if $class->connection->notes('dnsbl'); my $templates = $class->connection->notes('dnsbl_templates'); my $ip = $conn->remote_ip; my $template = $templates->{$query}; $template =~ s/%IP%/$ip/g; $class->connection->notes('dnsbl', $template); } sub process_txt_result { my ($class, $qp, $result, $query) = @_; my $conn = $class->connection; $conn->notes('dnsbl', $result) unless $conn->notes('dnsbl'); } sub hook_rcpt { my ($self, $transaction, $rcpt) = @_; my $connection = $self->qp->connection; # RBLSMTPD being non-empty means it contains the failure message to return if (defined($ENV{'RBLSMTPD'}) && $ENV{'RBLSMTPD'} ne '') { my $result = $ENV{'RBLSMTPD'}; my $remote_ip = $self->connection->remote_ip; $result =~ s/%IP%/$remote_ip/g; return (DENY, join(" ", $self->qp->config('dnsbl_rejectmsg'), $result)); } my $note = $self->connection->notes('dnsbl'); return (DENY, $note) if $note; return DECLINED; } =head1 NAME dnsbl - handle DNS BlackList lookups =head1 DESCRIPTION Plugin that checks the IP address of the incoming connection against a configurable set of RBL services. =head1 Configuration files This plugin uses the following configuration files. All of these are optional. However, not specifying dnsbl_zones is like not using the plugin at all. =over 4 =item dnsbl_zones Normal ip based dns blocking lists ("RBLs") which contain TXT records are specified simply as: relays.ordb.org spamsources.fabel.dk To configure RBL services which do not contain TXT records in the DNS, but only A records (e.g. the RBL+ at http://www.mail-abuse.org), specify your own error message to return in the SMTP conversation after a colon e.g. rbl-plus.mail-abuse.org:You are listed at - http://http://www.mail-abuse.org/cgi-bin/lookup?%IP% The string %IP% will be replaced with the IP address of incoming connection. Thus a fully specified file could be: sbl-xbl.spamhaus.org list.dsbl.org rbl-plus.mail-abuse.ja.net:Listed by rbl-plus.mail-abuse.ja.net - see relays.ordb.org =item dnsbl_allow List of allowed ip addresses that bypass RBL checking. Format is one entry per line, with either a full IP address or a truncated IP address with a period at the end. For example: 192.168.1.1 172.16.33. NB the environment variable RBLSMTPD is considered before this file is referenced. See below. =item dnsbl_rejectmsg A textual message that is sent to the sender on an RBL failure. The TXT record from the RBL list is also sent, but this file can be used to indicate what action the sender should take. For example: If you think you have been blocked in error, then please forward this entire error message to your ISP so that they can fix their problems. The next line often contains a URL that can be visited for more information. =back =head1 Environment Variables =head2 RBLSMTPD The environment variable RBLSMTPD is supported and mimics the behaviour of Dan Bernstein's rblsmtpd. The exception to this is the '-' char at the start of RBLSMTPD which is used to force a hard error in Dan's rblsmtpd. NB I don't really see the benefit of using a soft error for a site in an RBL list. This just complicates things as it takes 7 days (or whatever default period) before a user gets an error email back. In the meantime they are complaining that their emails are being "lost" :( =over 4 =item RBLSMTPD is set and non-empty The contents are used as the SMTP conversation error. Use this for forcibly blocking sites you don't like =item RBLSMTPD is set, but empty In this case no RBL checks are made. This can be used for local addresses. =item RBLSMTPD is not set All RBL checks will be made. This is the setting for remote sites that you want to check against RBL. =back =head1 Revisions See: http://cvs.perl.org/viewcvs/qpsmtpd/plugins/dnsbl =cut qpsmtpd-0.94/plugins/async/earlytalker000066400000000000000000000104451240247602400202030ustar00rootroot00000000000000#!perl -w =head1 NAME earlytalker - Check that the client doesn't talk before we send the SMTP banner =head1 DESCRIPTION Checks to see if the remote host starts talking before we've issued a 2xx greeting. If so, we're likely looking at a direct-to-MX spam agent which pipelines its entire SMTP conversation, and will happily dump an entire spam into our mail log even if later tests deny acceptance. Depending on configuration, clients which behave in this way are either immediately disconnected with a deny or denysoft code, or else are issued this on all mail/rcpt commands in the transaction. =head1 CONFIGURATION =over 4 =item wait [integer] The number of seconds to delay the initial greeting to see if the connecting host speaks first. The default is 1. Do not select a value that is too high, or you may be unable to receive mail from MTAs with short SMTP connect or greeting timeouts -- these are known to range as low as 30 seconds, and may in some cases be configured lower by mailserver admins. Network transit time must also be allowed for. =item action [string: deny, denysoft, log] What to do when matching an early-talker -- the options are I, I or I. If I is specified, the connection will be allowed to proceed as normal, and only a warning will be logged. The default is I. =item defer-reject [boolean] When an early-talker is detected, if this option is set to a true value, the SMTP greeting will be issued as usual, but all RCPT/MAIL commands will be issued a deny or denysoft (depending on the value of I). The default is to react at the SMTP greeting stage by issuing the apropriate response code and terminating the SMTP connection. =item check-at [string: connect, data] Defines when to check for early talkers, either at connect time (pre-greet pause) or at DATA time (pause before sending "354 go ahead"). The default is I. Note that defer-reject has no meaning if check-at is I. =back =cut my $MSG = 'Connecting host started transmitting before SMTP greeting'; sub register { my ($self, $qp, @args) = @_; if (@args % 2) { $self->log(LOGERROR, "Unrecognized/mismatched arguments"); return undef; } $self->{_args} = { 'wait' => 1, 'action' => 'denysoft', 'defer-reject' => 0, 'check-at' => 'connect', @args, }; print STDERR "Check at: ", $self->{_args}{'check-at'}, "\n"; $self->register_hook($self->{_args}->{'check-at'}, 'check_talker_poll'); $self->register_hook($self->{_args}->{'check-at'}, 'check_talker_post'); if ($self->{_args}{'check-at'} eq 'connect') { $self->register_hook('mail', 'hook_mail') if $self->{_args}->{'defer-reject'}; } 1; } sub check_talker_poll { my ($self, $transaction) = @_; my $qp = $self->qp; my $conn = $qp->connection; my $check_until = time + $self->{_args}{'wait'}; $qp->AddTimer( 1, sub { read_now($qp, $conn, $check_until, $self->{_args}{'check-at'}); } ); return YIELD; } sub read_now { my ($qp, $conn, $until, $phase) = @_; if ($qp->has_data) { $qp->log(LOGNOTICE, 'remote host started talking after $phase before we responded'); $qp->clear_data if $phase eq 'data'; $conn->notes('earlytalker', 1); $qp->run_continuation; } elsif (time >= $until) { # no early talking $qp->run_continuation; } else { $qp->AddTimer(1, sub { read_now($qp, $conn, $until, $phase) }); } } sub check_talker_post { my ($self, $transaction) = @_; return DECLINED unless $self->connection->notes('earlytalker'); return DECLINED if $self->{'defer-reject'}; return (DENY, $MSG) if $self->{_args}->{'action'} eq 'deny'; return (DENYSOFT, $MSG) if $self->{_args}->{'action'} eq 'denysoft'; return DECLINED; # assume action eq 'log' } sub hook_mail { my ($self, $transaction) = @_; return DECLINED unless $self->connection->notes('earlytalker'); return (DENY, $MSG) if $self->{_args}->{'action'} eq 'deny'; return (DENYSOFT, $MSG) if $self->{_args}->{'action'} eq 'denysoft'; return DECLINED; } qpsmtpd-0.94/plugins/async/queue/000077500000000000000000000000001240247602400170615ustar00rootroot00000000000000qpsmtpd-0.94/plugins/async/queue/smtp-forward000066400000000000000000000226201240247602400214330ustar00rootroot00000000000000#!perl -w =head1 NAME smtp-forward =head1 DESCRIPTION This plugin forwards the mail via SMTP to a specified server, rather than delivering the email locally. =head1 CONFIG It takes one required parameter, the IP address or hostname to forward to. async/queue/smtp-forward 10.2.2.2 Optionally you can also add a port: async/queue/smtp-forward 10.2.2.2 9025 =cut use Qpsmtpd::Constants; sub register { my ($self, $qp) = @_; $self->register_hook(queue => "start_queue"); $self->register_hook(queue => "finish_queue"); } sub init { my ($self, $qp, @args) = @_; if (@args > 0) { if ($args[0] =~ /^([\.\w_-]+)$/) { $self->{_smtp_server} = $1; } else { die "Bad data in smtp server: $args[0]"; } $self->{_smtp_port} = 25; if (@args > 1 and $args[1] =~ /^(\d+)$/) { $self->{_smtp_port} = $1; } $self->log(LOGWARN, "WARNING: Ignoring additional arguments.") if (@args > 2); } else { die("No SMTP server specified in smtp-forward config"); } } sub start_queue { my ($self, $transaction) = @_; my $qp = $self->qp; my $SERVER = $self->{_smtp_server}; my $PORT = $self->{_smtp_port}; $self->log(LOGINFO, "forwarding to $SERVER:$PORT"); $transaction->notes( 'async_sender', AsyncSMTPSender->new( $SERVER, $PORT, $qp, $self, $transaction ) ); return YIELD; } sub finish_queue { my ($self, $transaction) = @_; my $sender = $transaction->notes('async_sender'); $transaction->notes('async_sender', undef); my ($rc, $msg) = $sender->results; return $rc, $msg; } package AsyncSMTPSender; use IO::Socket; use base qw(Danga::Socket); use fields qw( qp pkg tran state rcode rmsg buf command resp to ); use constant ST_CONNECTING => 0; use constant ST_CONNECTED => 1; use constant ST_COMMANDS => 2; use constant ST_DATA => 3; use Qpsmtpd::Constants; sub new { my ($self, $server, $port, $qp, $pkg, $transaction) = @_; $self = fields::new($self) unless ref $self; my $sock = IO::Socket::INET->new( PeerAddr => $server, PeerPort => $port, Blocking => 0, ) or die "Error connecting to server $server:$port : $!\n"; IO::Handle::blocking($sock, 0); binmode($sock, ':raw'); $self->{qp} = $qp; $self->{pkg} = $pkg; $self->{tran} = $transaction; $self->{state} = ST_CONNECTING; $self->{rcode} = DECLINED; $self->{command} = 'connect'; $self->{buf} = ''; $self->{resp} = []; # copy the recipients so we can pop them off one by one $self->{to} = [$transaction->recipients]; $self->SUPER::new($sock); # Watch for write first, this is when the TCP session is established. $self->watch_write(1); return $self; } sub results { my AsyncSMTPSender $self = shift; return ($self->{rcode}, $self->{rmsg}); } sub log { my AsyncSMTPSender $self = shift; $self->{qp}->log(@_); } sub cont { my AsyncSMTPSender $self = shift; $self->{qp}->run_continuation; } sub command { my AsyncSMTPSender $self = shift; my ($command, $params) = @_; $params ||= ''; $self->log(LOGDEBUG, ">> $command $params"); $self->write( ($command =~ m/ / ? "$command:" : $command) . ($params ? " $params" : "") . "\r\n"); $self->watch_read(1); $self->{command} = ($command =~ /(\S+)/)[0]; } sub handle_response { my AsyncSMTPSender $self = shift; my $method = "cmd_" . lc($self->{command}); $self->$method(@_); } sub cmd_connect { my AsyncSMTPSender $self = shift; my ($code, $response) = @_; if ($code != 220) { $self->{rmsg} = "Error on connect: @$response"; $self->close; $self->cont; } else { my $host = $self->{qp}->config('me'); print "HELOing with $host\n"; $self->command((join '', @$response) =~ m/ ESMTP/ ? "EHLO" : "HELO", $host); } } sub cmd_helo { my AsyncSMTPSender $self = shift; my ($code, $response) = @_; if ($code != 250) { $self->{rmsg} = "Error on HELO: @$response"; $self->close; $self->cont; } else { $self->command("MAIL", "FROM:" . $self->{tran}->sender->format); } } sub cmd_ehlo { my AsyncSMTPSender $self = shift; my ($code, $response) = @_; if ($code != 250) { $self->{rmsg} = "Error on EHLO: @$response"; $self->close; $self->cont; } else { $self->command("MAIL", "FROM:" . $self->{tran}->sender->format); } } sub cmd_mail { my AsyncSMTPSender $self = shift; my ($code, $response) = @_; if ($code != 250) { $self->{rmsg} = "Error on MAIL FROM: @$response"; $self->close; $self->cont; } else { $self->command("RCPT", "TO:" . shift(@{$self->{to}})->format); } } sub cmd_rcpt { my AsyncSMTPSender $self = shift; my ($code, $response) = @_; if ($code != 250) { $self->{rmsg} = "Error on RCPT TO: @$response"; $self->close; $self->cont; } else { if (@{$self->{to}}) { $self->command("RCPT", "TO:" . shift(@{$self->{to}})->format); } else { $self->command("DATA"); } } } sub cmd_data { my AsyncSMTPSender $self = shift; my ($code, $response) = @_; if ($code != 354) { $self->{rmsg} = "Error on DATA: @$response"; $self->close; $self->cont; } else { # $self->{state} = ST_DATA; $self->datasend($self->{tran}->header->as_string); $self->{tran}->body_resetpos; my $write_buf = ''; while (my $line = $self->{tran}->body_getline) { $line =~ s/\r?\n/\r\n/; $write_buf .= $line; if (length($write_buf) >= 131072) { # 128KB, arbitrary value $self->log(LOGDEBUG, ">> $write_buf"); $self->datasend($write_buf); $write_buf = ''; } } if (length($write_buf)) { $self->log(LOGDEBUG, ">> $write_buf"); $self->datasend($write_buf); } $self->write(".\r\n"); $self->{command} = "DATAEND"; } } sub cmd_dataend { my AsyncSMTPSender $self = shift; my ($code, $response) = @_; if ($code != 250) { $self->{rmsg} = "Error after DATA: @$response"; $self->close; $self->cont; } else { $self->command("QUIT"); } } sub cmd_quit { my AsyncSMTPSender $self = shift; my ($code, $response) = @_; $self->{rcode} = OK; $self->{rmsg} = "Queued!"; $self->close; $self->cont; } sub datasend { my AsyncSMTPSender $self = shift; my ($data) = @_; $data =~ s/^\./../mg; $self->write(\$data); } sub event_read { my AsyncSMTPSender $self = shift; if ($self->{state} == ST_CONNECTED) { $self->{state} = ST_COMMANDS; } if ($self->{state} == ST_COMMANDS) { my $in = $self->read(1024); if (!$in) { # XXX: connection closed $self->close("lost connection"); return; } my @lines = split /\r?\n/, $self->{buf} . $$in, -1; $self->{buf} = delete $lines[-1]; for (@lines) { if (my ($code, $cont, $rest) = /^([0-9]{3})([ -])(.*)/) { $self->log(LOGDEBUG, "<< $code$cont$rest"); push @{$self->{resp}}, $rest; if ($cont eq ' ') { $self->handle_response($code, $self->{resp}); $self->{resp} = []; } } else { $self->log(LOGERROR, "Unrecognised SMTP response line: $_"); $self->{rmsg} = "Error from upstream SMTP server"; $self->close; $self->cont; } } } else { $self->log(LOGERROR, "SMTP Session occurred out of order"); $self->close; $self->cont; } } sub event_write { my AsyncSMTPSender $self = shift; if ($self->{state} == ST_CONNECTING) { $self->watch_write(0); $self->{state} = ST_CONNECTED; $self->watch_read(1); } elsif (0 && $self->{state} == ST_DATA) { # send more data if (my $line = $self->{tran}->body_getline) { $self->log(LOGDEBUG, ">> $line"); $line =~ s/\r?\n/\r\n/; $self->datasend($line); } else { # no more data. $self->log(LOGINFO, "No more data"); $self->watch_write(0); $self->{state} = ST_COMMANDS; } } else { $self->write(undef); } } sub event_err { my ($self) = @_; eval { $self->read(1); }; # gives us the correct error in errno $self->{rmsg} = "Read error from remote server: $!"; #print "lost connection: $!\n"; $self->close; $self->cont; } sub event_hup { my ($self) = @_; eval { $self->read(1); }; # gives us the correct error in errno $self->{rmsg} = "HUP error from remote server: $!"; #print "lost connection: $!\n"; $self->close; $self->cont; } qpsmtpd-0.94/plugins/async/resolvable_fromhost000066400000000000000000000127441240247602400217470ustar00rootroot00000000000000#!perl -w use strict; use warnings; use Qpsmtpd::Constants; use Qpsmtpd::DSN; use Qpsmtpd::TcpServer; #use ParaDNS; # moved into register use Socket; my %invalid = (); my $has_ipv6 = Qpsmtpd::TcpServer::has_ipv6(); sub register { my ($self, $qp) = @_; foreach my $i ($self->qp->config("invalid_resolvable_fromhost")) { $i =~ s/^\s*//; $i =~ s/\s*$//; if ($i =~ m#^((\d{1,3}\.){3}\d{1,3})/(\d\d?)#) { $invalid{$1} = $3; } } eval 'use ParaDNS'; if ($@) { warn "could not load ParaDNS, plugin disabled"; return DECLINED; } $self->register_hook(mail => 'hook_mail_start'); $self->register_hook(mail => 'hook_mail_done'); } sub hook_mail_start { my ($self, $transaction, $sender) = @_; return DECLINED if ($self->connection->notes('whitelisthost')); if ($sender ne '<>') { unless ($sender->host) { # default of addr_bad_from_system is DENY, we use DENYSOFT here to # get the same behaviour as without Qpsmtpd::DSN... return Qpsmtpd::DSN->addr_bad_from_system(DENYSOFT, "FQDN required in the envelope sender"); } return DECLINED if $sender->host =~ m/^\[(\d{1,3}\.){3}\d{1,3}\]$/; unless ($self->check_dns($sender->host)) { return Qpsmtpd::DSN->temp_resolver_failed( "Could not resolve " . $sender->host); } return YIELD; } return DECLINED; } sub hook_mail_done { my ($self, $transaction, $sender) = @_; return DECLINED if ($self->connection->notes('whitelisthost')); if ($sender ne "<>" && !$transaction->notes('resolvable_fromhost')) { # default of temp_resolver_failed is DENYSOFT return Qpsmtpd::DSN->temp_resolver_failed( "Could not resolve " . $sender->host); } return DECLINED; } sub check_dns { my ($self, $host) = @_; my @host_answers; my $qp = $self->qp; $qp->input_sock->pause_read; my $a_records = []; my $num_queries = 1; # queries in progress my $mx_found = 0; ParaDNS->new( callback => sub { my $mx = shift; return if $mx =~ /^[A-Z]+$/; # error my $addr = $mx->[0]; $mx_found = 1; $num_queries++; ParaDNS->new( callback => sub { push @$a_records, $_[0] if $_[0] !~ /^[A-Z]+$/; }, finished => sub { $num_queries--; $self->finish_up($qp, $a_records, $num_queries); }, host => $addr, type => 'A', ); if ($has_ipv6) { $num_queries++; ParaDNS->new( callback => sub { push @$a_records, $_[0] if $_[0] !~ /^[A-Z]+$/; }, finished => sub { $num_queries--; $self->finish_up($qp, $a_records, $num_queries); }, host => $addr, type => 'AAAA', ); } }, finished => sub { unless ($mx_found) { $num_queries++; ParaDNS->new( callback => sub { push @$a_records, $_[0] if $_[0] !~ /^[A-Z]+$/; }, finished => sub { $num_queries--; $self->finish_up($qp, $a_records, $num_queries); }, host => $host, type => 'A', ); if ($has_ipv6) { $num_queries++; ParaDNS->new( callback => sub { push @$a_records, $_[0] if $_[0] !~ /^[A-Z]+$/; }, finished => sub { $num_queries--; $self->finish_up($qp, $a_records, $num_queries); }, host => $host, type => 'AAAA', ); } } $num_queries--; $self->finish_up($qp, $a_records, $num_queries); }, host => $host, type => 'MX', ) or $qp->input_sock->continue_read, return; return 1; } sub finish_up { my ($self, $qp, $a_records, $num_queries) = @_; return if defined $qp->transaction->notes('resolvable_fromhost'); foreach my $addr (@$a_records) { if (is_valid($addr)) { $qp->transaction->notes('resolvable_fromhost', 1); $qp->input_sock->continue_read; $qp->run_continuation; return; } } unless ($num_queries) { # all queries returned no valid response $qp->transaction->notes('resolvable_fromhost', 0); $qp->input_sock->continue_read; $qp->run_continuation; } } sub is_valid { my $ip = shift; my ($net, $mask); foreach $net (keys %invalid) { $mask = $invalid{$net}; $mask = pack "B32", "1" x ($mask) . "0" x (32 - $mask); return 0 if join(".", unpack("C4", inet_aton($ip) & $mask)) eq $net; } return 1; } qpsmtpd-0.94/plugins/async/rhsbl000066400000000000000000000046301240247602400167750ustar00rootroot00000000000000#!perl -w use Qpsmtpd::Plugin::Async::DNSBLBase; sub init { my $self = shift; my $class = ref $self; no strict 'refs'; push @{"${class}::ISA"}, 'Qpsmtpd::Plugin::Async::DNSBLBase'; } sub hook_mail { my ($self, $transaction, $sender) = @_; my $class = ref $self; return DECLINED if $sender->format eq '<>'; my %rhsbl_zones = map { (split /\s+/, $_, 2)[0, 1] } $self->qp->config('rhsbl_zones'); return DECLINED unless %rhsbl_zones; my $sender_host = $sender->host; my @A_zones = grep { defined($rhsbl_zones{$_}) } keys %rhsbl_zones; my @TXT_zones = grep { !defined($rhsbl_zones{$_}) } keys %rhsbl_zones; if (@A_zones) { # message templates for responding to the client $transaction->notes(rhsbl_templates => {map { +"$sender_host.$_" => $rhsbl_zones{$_} } @A_zones}); } return DECLINED unless $class->lookup($self->qp, [map { "$sender_host.$_" } @A_zones], [map { "$sender_host.$_" } @TXT_zones], ); return YIELD; } sub process_a_result { my ($class, $qp, $result, $query) = @_; my $transaction = $qp->transaction; $transaction->notes('rhsbl', $transaction->notes('rhsbl_templates')->{$query}) unless $transaction->notes('rhsbl'); } sub process_txt_result { my ($class, $qp, $result, $query) = @_; my $transaction = $qp->transaction; $transaction->notes('rhsbl', $result) unless $transaction->notes('rhsbl'); } sub hook_rcpt { my ($self, $transaction, $rcpt) = @_; my $host = $transaction->sender->host; my $note = $transaction->notes('rhsbl'); return (DENY, "Mail from $host rejected because it $note") if $note; return DECLINED; } =head1 NAME rhsbl - handle RHSBL lookups =head1 DESCRIPTION Pluging that checks the host part of the sender's address against a configurable set of RBL services. =head1 CONFIGURATION This plugin reads the lists to use from the rhsbl_zones configuration file. Normal domain based dns blocking lists ("RBLs") which contain TXT records are specified simply as: dsn.rfc-ignorant.org To configure RBL services which do not contain TXT records in the DNS, but only A records, specify, after a whitespace, your own error message to return in the SMTP conversation e.g. abuse.rfc-ignorant.org does not support abuse@domain =cut qpsmtpd-0.94/plugins/async/uribl000066400000000000000000000073041240247602400170010ustar00rootroot00000000000000#!perl -w use Qpsmtpd::Plugin::Async::DNSBLBase; use strict; use warnings; sub init { my ($self, $qp, %args) = @_; my $class = ref $self; $self->isa_plugin("uribl"); { no strict 'refs'; push @{"${class}::ISA"}, 'Qpsmtpd::Plugin::Async::DNSBLBase'; } $self->SUPER::init($qp, %args); } sub register { my $self = shift; $self->register_hook('data_post', 'start_data_post'); $self->register_hook('data_post', 'finish_data_post'); } sub start_data_post { my ($self, $transaction) = @_; my $class = ref $self; my @names; my $queries = $self->lookup_start( $transaction, sub { my ($self, $name) = @_; push @names, $name; } ); my @hosts; foreach my $z (keys %{$self->{uribl_zones}}) { push @hosts, map { "$_.$z" } @names; } $transaction->notes(uribl_results => {}); $transaction->notes(uribl_zones => $self->{uribl_zones}); return DECLINED unless @hosts && $class->lookup($self->qp, [@hosts], [@hosts]); return YIELD; } sub finish_data_post { my ($self, $transaction) = @_; my $matches = $self->collect_results($transaction); for (@$matches) { $self->log(LOGWARN, $_->{desc}); if ($_->{action} eq 'add-header') { $transaction->header->add('X-URIBL-Match', $_->{desc}); } elsif ($_->{action} eq 'deny') { return (DENY, $_->{desc}); } elsif ($_->{action} eq 'denysoft') { return (DENYSOFT, $_->{desc}); } } return DECLINED; } sub init_resolver { } sub process_a_result { my ($class, $qp, $result, $query) = @_; my $transaction = $qp->transaction; my $results = $transaction->notes('uribl_results'); my $zones = $transaction->notes('uribl_zones'); foreach my $z (keys %$zones) { if ($query =~ /^(.*)\.$z$/) { my $name = $1; $results->{$z}->{$name}->{a} = $result; } } } sub process_txt_result { my ($class, $qp, $result, $query) = @_; my $transaction = $qp->transaction; my $results = $transaction->notes('uribl_results'); my $zones = $transaction->notes('uribl_zones'); foreach my $z (keys %$zones) { if ($query =~ /^(.*)\.$z$/) { my $name = $1; $results->{$z}->{$name}->{txt} = $result; } } } sub collect_results { my ($self, $transaction) = @_; my $results = $transaction->notes('uribl_results'); my @matches; foreach my $z (keys %$results) { foreach my $n (keys %{$results->{$z}}) { if (exists $results->{$z}->{$n}->{a}) { if ($self->evaluate($z, $results->{$z}->{$n}->{a})) { $self->log(LOGDEBUG, "match $n in $z"); push @matches, { action => $self->{uribl_zones}->{$z}->{action}, desc => "$n in $z: " . ( $results->{$z}->{$n}->{txt} || $results->{$z}->{$n}->{a} ), }; } } } } return \@matches; } =head1 NAME uribl - URIBL blocking plugin for qpsmtpd =head1 DESCRIPTION This plugin implements DNSBL lookups for URIs found in spam, such as that implemented by SURBL (see Ehttp://surbl.org/E). Incoming messages are scanned for URIs, which are then checked against one or more URIBLs in a fashion similar to DNSBL systems. =head1 CONFIGURATION See the documentation of the non-async version. The timeout config option is ignored, the ParaDNS timeout is used instead. =cut qpsmtpd-0.94/plugins/auth/000077500000000000000000000000001240247602400155615ustar00rootroot00000000000000qpsmtpd-0.94/plugins/auth/auth_checkpassword000066400000000000000000000136371240247602400213770ustar00rootroot00000000000000#!perl -w =head1 NAME auth_checkpassword - Authenticate against a DJB style checkpassword program =head1 DESCRIPTION This plugin authenticates users against a DJB style checkpassword program. Unlike previous checkpassword implementations, this plugin expects qpsmtpd to be running as the qpsmtpd user. Privilege escalation can be attained by running the checkpassword binary setuid or with sudo. =head1 CONFIGURATION Configure the path to your checkpassword binary. You can configure this in config/plugins by defining the checkpw and true arguments as follows: auth/auth_checkpassword checkpw /usr/local/vpopmail/bin/vchkpw true /bin/true or by editing the config file config/smtpauth-checkpassword: echo "/usr/local/vpopmail/bin/vchkpw /bin/true" > ~qpsmtpd/config/smtpauth-checkpassword vchkpw is the checkpassword program provided by vpopmail. Substitute your own checkpassword app as appropriate. If you are using vchkpw and this plugin is being executed by a user ID other than 89 or 0 (as is the default), and the vchkpw binary is not setuid (as is the default), this plugin will automatically prepend the vchkpw command with sudo. If that is the case, you must configure sudo by adding these two lines to your sudoers file: Defaults:qpsmtpd closefrom_override qpsmtpd ALL = (ALL) NOPASSWD: /usr/local/vpopmail/bin/vchkpw The closefrom_override option is necessary because, by default, sudo appropriates the first 3 file descriptors. Those descriptors are necessary to communicate with the checkpassword program. If you run qpsmtpd as some other user, adjust the sudo lines approriately. Using sudo is preferable to enabling setuid on the vchkpw binary. If you reinstall vpopmail and the setuid bit is lost, this plugin will be broken. =head1 SEE ALSO If you are using this plugin with vpopmail, please read the VPOPMAIL section in docs/authentication.pod =head1 DIAGNOSTICS Is the path in the config/smtpauth-checkpassword correct? Is the path to true in config/smtpauth-checkpassword correct? Is qpsmtpd running as the qpsmtpd user? If not, did you adjust the sudo configuration appropriately? If you are not using sudo, did you remember to make the vchkpw binary setuid (chmod 4711 ~vpopmail/bin/vchkpw)? While writing this plugin, I first wrote myself a little test script, which helped me identify the sudo closefrom_override issue. Here is that script: #!/usr/bin/perl use strict; my $sudo = "/usr/local/bin/sudo"; $sudo .= " -C4 -u vpopmail"; my $vchkpw = "/usr/local/vpopmail/bin/vchkpw"; my $true = "/bin/true"; open(CPW,"|$sudo $vchkpw $true 3<&0"); printf(CPW "%s\0%s\0Y123456\0",'user@example.com','pa55word'); close(CPW); my $status = $?; print "FAIL\n" and exit if ( $status != 0 ); print "OK\n"; Save that script to vchkpw.pl and then run it as the same user that qpsmtpd runs as: setuidgid qpsmtpd perl vchkpw.pl If you aren't using sudo, then remove $sudo from the open line. =head1 ACKNOWLEDGEMENTS based upon authcheckpassword by Michael Holzt and adapted by Johan Almqvist 2006-01-18 =head1 AUTHOR Matt Simerson =head1 COPYRIGHT AND LICENSE Copyright (c) 2010 Matt Simerson This plugin is licensed under the same terms as the qpsmtpd package itself. Please see the LICENSE file included with qpsmtpd for details. =cut sub register { my ($self, $qp, %args) = @_; my ($checkpw, $true) = $self->get_checkpw(\%args); return DECLINED if !$checkpw || !$true; $self->connection->notes('auth_checkpassword_bin', $checkpw); $self->connection->notes('auth_checkpassword_true', $true); $self->register_hook('auth-plain', 'auth_checkpassword'); $self->register_hook('auth-login', 'auth_checkpassword'); } sub auth_checkpassword { my ($self, $transaction, $method, $user, $passClear, $passHash, $ticket) = @_; my $binary = $self->connection->notes('auth_checkpassword_bin'); my $true = $self->connection->notes('auth_checkpassword_true'); chomp($binary, $true); my $sudo = get_sudo($binary); $self->log(LOGDEBUG, "auth_checkpassword: $sudo $binary $true 3<&0"); open(CPW, "|$sudo $binary $true 3<&0"); printf(CPW "%s\0%s\0Y123456\0", $user, $passClear); close(CPW); my $status = $?; if ($status != 0) { $self->log(LOGNOTICE, "fail, auth failed: $status"); return (DECLINED); } $self->connection->notes('authuser', $user); $self->log(LOGINFO, "pass, auth success with $method"); return (OK, "auth_checkpassword"); } sub get_checkpw { my ($self, $args) = @_; my ($checkpw) = $args->{checkpw} =~ /^(.*)$/ if $args->{checkpw}; # untaint my ($true) = $args->{true} =~ /^(.*)$/ if $args->{true}; # untaint return ($checkpw, $true) if ($checkpw && $true && -x $checkpw && -x $true); my $missing_config = "disabled due to invalid configuration. See 'perldoc plugins/auth/auth_checkpassword' for how to configure."; if (!$self->qp->config('smtpauth-checkpassword')) { $self->log(LOGERROR, $missing_config); return; } $self->log(LOGNOTICE, "reading config from smtpauth-checkpassword"); my $config = $self->qp->config("smtpauth-checkpassword"); ($checkpw, $true) = $config =~ /^(\S+)\s+(\S+)\s*$/; if (!$checkpw || !$true || !-x $checkpw || !-x $true) { $self->log(LOGERROR, $missing_config); return; } return ($checkpw, $true); } sub get_sudo { my $binary = shift; return '' if $> == 0; # running as root return '' if $> == 89 && $binary =~ /vchkpw$/; # running as vpopmail my $mode = (stat($binary))[2]; $mode = sprintf "%lo", $mode & 07777; return '' if $mode eq '4711'; # $binary is setuid my $sudo = `which sudo` || '/usr/local/bin/sudo'; return '' if !-x $sudo; $sudo .= ' -C4'; # prevent sudo from clobbering file descriptor 3 return $sudo if $binary !~ /vchkpw$/; return "$sudo -u vpopmail"; } qpsmtpd-0.94/plugins/auth/auth_cvm_unix_local000066400000000000000000000075501240247602400215360ustar00rootroot00000000000000#!perl -w =head1 NAME auth_cvm_unix_local - SMTP AUTH LOGIN module using Bruce Guenther's Credential Validation Module (CVM) http://untroubled.org/cvm/ =head1 SYNOPSIS In config/plugins: auth/auth_cvm_unix_local \ cvm_socket /var/lib/cvm/cvm-unix-local.socket \ enable_smtp no \ enable_ssmtp yes =head1 BUGS - Should probably handle auth-cram-md5 as well. However, this requires access to the plain text password. We could store a separate database of passwords purely for SMTP AUTH, for example as an optional SMTPAuthPassword property of an account in the esmith::AccountsDB; =head1 DESCRIPTION This plugin implements an authentication plugin using Bruce Guenther's Credential Validation Module (http://untroubled.org/cvm). =head1 AUTHOR Copyright 2005 Gordon Rowell This software is free software and may be distributed under the same terms as qpsmtpd itself. =head1 VERSION Version $Id: auth_cvm_unix_local,v 1.1 2005/06/09 22:50:06 gordonr Exp gordonr $ =cut use strict; use warnings; use Qpsmtpd::Constants; use Socket; use constant SMTP_PORT => getservbyname("smtp", "tcp") || 25; use constant SSMTP_PORT => getservbyname("ssmtp", "tcp") || 465; sub register { my ($self, $qp, %arg) = @_; unless ($arg{cvm_socket}) { $self->log(LOGERROR, "skip: requires cvm_socket argument"); return 0; } $self->{_args} = {%arg}; $self->{_enable_smtp} = $arg{enable_smtp} || 'no'; $self->{_enable_ssmtp} = $arg{enable_ssmtp} || 'yes'; my $port = $ENV{PORT} || SMTP_PORT; if ($arg{enable_smtp} ne 'yes' && ($port == SMTP_PORT || $port == 587)) { $self->log(LOGDEBUG, "skip: enable_smtp=no"); return 0; } if ($port == SSMTP_PORT && $arg{enable_ssmtp} ne 'yes') { $self->log(LOGDEBUG, "skip: enable_ssmtp=no"); return 0; }; if ($arg{cvm_socket} =~ /^([\w\/.-]+)$/) { $self->{_cvm_socket} = $1; } unless (-S $self->{_cvm_socket}) { $self->log(LOGERROR, "skip: cvm_socket missing or not usable"); return 0; } $self->register_hook("auth-plain", "authcvm_plain"); $self->register_hook("auth-login", "authcvm_plain"); #$self->register_hook("auth-cram-md5", "authcvm_hash"); } sub authcvm_plain { my ($self, $transaction, $method, $user, $passClear, $passHash, $ticket) = @_; if ($user =~ /\x00/) { $self->log(LOGERROR, "deny: invalid username"); return (DENY, "authcvm, invalid username"); }; socket(SOCK, PF_UNIX, SOCK_STREAM, 0) or do { $self->log(LOGERROR, "skip: socket creation attempt for: $user"); return (DENY, "authcvm"); }; # DENY, really? Should this plugin return a DENY when it cannot connect # to the cvs socket? I'd expect such a failure to return DECLINED, so # any other auth plugins could take a stab at authenticating the user connect(SOCK, sockaddr_un($self->{_cvm_socket})) or do { $self->log(LOGERROR, "skip: socket connection attempt for: $user"); return (DENY, "authcvm, connection failed"); }; my $o = select(SOCK); $| = 1; select($o); my ($u, $host) = split(/\@/, $user); $host ||= "localhost"; print SOCK "\001$u\000$host\000$passClear\000\000"; shutdown SOCK, 1; # tell remote we're finished my $ret = ; my ($s) = unpack("C", $ret); if (!defined $s) { $self->log(LOGERROR, "skip: no response from cvm for $user"); return (DECLINED); } if ($s == 0) { $self->log(LOGINFO, "pass: authentication for: $user"); return (OK, "auth success for $user"); } if ($s == 100) { $self->log(LOGINFO, "fail: authentication failure for: $user"); return (DENY, 'auth failure (100)'); } $self->log(LOGERROR, "skip: unknown response from cvm for $user"); return (DECLINED, "unknown result code ($s)"); } qpsmtpd-0.94/plugins/auth/auth_flat_file000066400000000000000000000045541240247602400204620ustar00rootroot00000000000000#!perl -w =head1 NAME auth_flat_file - simple CRAM MD5 auth plugin using a flat password file =head1 SYNOPSIS in config/plugins: auth/auth_flat_file in config/flat_auth_pw username1:password1 username2:password2 ... =head1 DESCRIPTION This plugin implements a very simple authentication plugin using a flat password file containing username and password separated by colons. Note that this plugin enforces the use of a full email address (including @domain) as the username. There's no particular reason for this so feel free to modify the code to suit your setup. The password is stored on disk unencrypted, however authentication uses a HMAC algorithm so no password is transfered in the clear. =cut use strict; use warnings; use Qpsmtpd::Auth; use Qpsmtpd::Constants; sub register { my ($self, $qp) = @_; $self->register_hook('auth-plain', 'auth_flat_file'); $self->register_hook('auth-login', 'auth_flat_file'); $self->register_hook('auth-cram-md5', 'auth_flat_file'); } sub auth_flat_file { my ($self, $transaction, $method, $user, $passClear, $passHash, $ticket) = @_; if (!defined $passClear && !defined $passHash) { $self->log(LOGINFO, "fail: missing password"); return (DENY, "authflat - missing password"); } my ($pw_name, $pw_domain) = split /@/, lc($user); unless (defined $pw_domain) { $self->log(LOGINFO, "fail: missing domain"); return DECLINED; } my ($auth_line) = grep { /^$pw_name\@$pw_domain:/ } $self->qp->config('flat_auth_pw'); if (!defined $auth_line) { $self->log(LOGINFO, "fail: no such user: $user"); return DECLINED; } my ($auth_user, $auth_pass) = split(/:/, $auth_line, 2); # at this point we can assume the user name matched return Qpsmtpd::Auth::validate_password( $self, src_clear => $auth_pass, src_crypt => undef, attempt_clear => $passClear, attempt_hash => $passHash, method => $method, ticket => $ticket, deny => DENY, ); } qpsmtpd-0.94/plugins/auth/auth_ldap_bind000066400000000000000000000154511240247602400204470ustar00rootroot00000000000000#!perl -w =head1 NAME auth_ldap_bind - Authenticate user via an LDAP bind =head1 DESCRIPTION This plugin authenticates users against an LDAP Directory. The plugin first performs a lookup for an entry matching the connecting user. This lookup uses the 'ldap_auth_filter_attr' attribute to match the connecting user to their LDAP DN. Once the plugin has found the user's DN, the plugin will attempt to bind to the Directory as that DN with the password that has been supplied. =head1 CONFIGURATION Configuration items can be held in either the 'ldap' configuration file, or as arguments to the plugin. Configuration items in the 'ldap' configuration file are set one per line, starting the line with the configuration item key, followed by a space, then the values associated with the configuration item. Configuration items given as arguments to the plugin are keys and values separated by spaces. Be sure to quote any values that have spaces in them. The only configuration item which is required is 'ldap_base'. This tells the plugin what your base DN is. The plugin will not work until it has been configured. The configuration items 'ldap_host' and 'ldap_port' specify the host and port at which your Directory server may be contacted. If these are not specified, the plugin will use port '389' on 'localhost'. The configuration item 'ldap_timeout' specifies how long the plugin should wait for a response from your Directory server. By default, the value is 5 seconds. The configuration item 'ldap_auth_filter_attr' specifies how the plugin should find the user in your Directory. By default, the plugin will look up the user based on the 'uid' attribute. =head1 NOTES Each auth requires an initial lookup to find the user's DN. Ideally, the plugin would simply bind as the user without the need for this lookup (see FUTURE DIRECTION below). This plugin requires that the Directory allow anonymous bind (see FUTURE DIRECTION below). =head1 FUTURE DIRECTION A configurable LDAP filter should be made available, to account for users who are over quota, have had their accounts disabled, or whatever other arbitrary requirements. A configurable DN template (uid=$USER,ou=$DOMAIN,$BASE). This would prevent the need of the initial user lookup, as the DN is created from the template. A configurable bind DN, for Directories that do not allow anonymous bind. Another plugin ('ldap_auth_cleartext'?), to allow retrieval of plain-text passwords from the Directory, permitting CRAM-MD5 or other hash algorithm authentication. =head1 AUTHOR Elliot Foster =head1 COPYRIGHT AND LICENSE Copyright (c) 2005 Elliot Foster This plugin is licensed under the same terms as the qpsmtpd package itself. Please see the LICENSE file included with qpsmtpd for details. =cut use strict; use warnings; use Net::LDAP qw(:all); use Qpsmtpd::Constants; sub register { my ($self, $qp, @args) = @_; $self->register_hook("auth-plain", "authldap"); $self->register_hook("auth-login", "authldap"); # pull config defaults in from file %{$self->{"ldconf"}} = map { (split /\s+/, $_, 2)[0, 1] } $self->qp->config('ldap'); # override ldap config defaults with plugin args for my $ldap_arg (@args) { %{$self->{"ldconf"}} = map { (split /\s+/, $_, 2)[0, 1] } $ldap_arg; } # do light validation of ldap_host and ldap_port to satisfy -T my $ldhost = $self->{"ldconf"}->{'ldap_host'}; my $ldport = $self->{"ldconf"}->{'ldap_port'}; if (($ldhost) && ($ldhost =~ m/^(([a-z0-9]+\.?)+)$/)) { $self->{"ldconf"}->{'ldap_host'} = $1; } else { undef $self->{"ldconf"}->{'ldap_host'}; } if (($ldport) && ($ldport =~ m/^(\d+)$/)) { $self->{"ldconf"}->{'ldap_port'} = $1; } else { undef $self->{"ldconf"}->{'ldap_port'}; } # set any values that are not already $self->{"ldconf"}->{"ldap_host"} ||= "127.0.0.1"; $self->{"ldconf"}->{"ldap_port"} ||= 389; $self->{"ldconf"}->{"ldap_timeout"} ||= 5; $self->{"ldconf"}->{"ldap_auth_filter_attr"} ||= "uid"; } sub authldap { my ($self, $transaction, $method, $user, $passClear, $passHash, $ticket) = @_; my ($ldhost, $ldport, $ldwait, $ldbase, $ldmattr, $lduserdn, $ldh, $mesg); # pull values in from config $ldhost = $self->{"ldconf"}->{"ldap_host"}; $ldport = $self->{"ldconf"}->{"ldap_port"}; $ldbase = $self->{"ldconf"}->{"ldap_base"}; # log error here and DECLINE if no baseDN, because a custom baseDN is required: unless ($ldbase) { $self->log(LOGERROR, "skip: please configure ldap_base"); return (DECLINED, "authldap - temporary auth error"); } $ldwait = $self->{"ldconf"}->{'ldap_timeout'}; $ldmattr = $self->{"ldconf"}->{'ldap_auth_filter_attr'}; my ($pw_name, $pw_domain) = split "@", lc($user); # find dn of user matching supplied username $ldh = Net::LDAP->new($ldhost, port => $ldport, timeout => $ldwait) or do { $self->log(LOGALERT, "skip: error in initial conn"); return (DECLINED, "authldap - temporary auth error"); }; # find the user's DN $mesg = $ldh->search( base => $ldbase, scope => 'sub', filter => "$ldmattr=$pw_name", attrs => ['uid'], timeout => $ldwait, sizelimit => '1' ) or do { $self->log(LOGALERT, "skip: err in search for user"); return (DECLINED, "authldap - temporary auth error"); }; # deal with errors if they exist if ($mesg->code) { $self->log(LOGALERT, "skip: err " . $mesg->code . " in search for user"); return (DECLINED, "authldap - temporary auth error"); } # unbind, so as to allow a rebind below $ldh->unbind if $ldh; # bind against directory as user with password supplied if (!$mesg->count || $lduserdn = $mesg->entry->dn) { $self->log(LOGALERT, "fail: user not found"); return (DECLINED, "authldap - wrong username or password"); } $ldh = Net::LDAP->new($ldhost, port => $ldport, timeout => $ldwait) or do { $self->log(LOGALERT, "skip: err in user conn"); return (DECLINED, "authldap - temporary auth error"); }; # here's the whole reason for the script $mesg = $ldh->bind($lduserdn, password => $passClear, timeout => $ldwait); $ldh->unbind if $ldh; # deal with errors if they exist, or allow success if ($mesg->code) { $self->log(LOGALERT, "fail: error in user bind"); return (DECLINED, "authldap - wrong username or password"); } $self->log(LOGINFO, "pass: $user auth success"); $self->log(LOGDEBUG, "user: $user, pass: $passClear"); return (OK, "authldap"); } qpsmtpd-0.94/plugins/auth/auth_vpopmail000066400000000000000000000062001240247602400203520ustar00rootroot00000000000000#!perl -w =head1 NAME auth_vpopmail - Authenticate against libvpopmail.a =head1 DESCRIPTION This plugin authenticates vpopmail users using p5-vpopmail. Using CRAM-MD5 requires that vpopmail be built with the '--enable-clear-passwd=y' option. =head1 CONFIGURATION This module will only work if qpsmtpd is running as the 'vpopmail' user. CRAM-MD5 authentication will only work with p5-vpopmail 0.09 or higher. http://github.com/sscanlon/vpopmail Decide which authentication methods you are willing to support and uncomment the lines in the register() sub. See the POD for Qspmtpd::Auth for more details on the ramifications of supporting various authentication methods. =head1 SEE ALSO For an overview of the vpopmail authentication plugins and their merits, please read the VPOPMAIL section in docs/authentication.pod =head1 AUTHOR Matt Simerson =head1 COPYRIGHT AND LICENSE Copyright (c) 2010 Matt Simerson This plugin is licensed under the same terms as the qpsmtpd package itself. Please see the LICENSE file included with qpsmtpd for details. =cut use strict; use warnings; use Qpsmtpd::Auth; use Qpsmtpd::Constants; #use vpopmail; # we eval this in $test_vpopmail_module sub register { my ($self, $qp) = @_; return (DECLINED) if !$self->test_vpopmail_module(); $self->register_hook("auth-plain", "auth_vpopmail"); $self->register_hook("auth-login", "auth_vpopmail"); $self->register_hook("auth-cram-md5", "auth_vpopmail"); } sub auth_vpopmail { my ($self, $transaction, $method, $user, $passClear, $passHash, $ticket) = @_; my $pw = vauth_getpw(split /@/, lc($user)); my $pw_clear_passwd = $pw->{pw_clear_passwd}; my $pw_passwd = $pw->{pw_passwd}; if (!$pw || (!$pw_clear_passwd && !$pw_passwd)) { $self->log(LOGINFO, "fail: invalid user $user"); return (DENY, "auth_vpopmail - invalid user"); # change DENY to DECLINED to support multiple auth plugins } return Qpsmtpd::Auth::validate_password( $self, src_clear => $pw->{pw_clear_passwd}, src_crypt => $pw->{pw_passwd}, attempt_clear => $passClear, attempt_hash => $passHash, method => $method, ticket => $ticket, deny => DENY, ); } sub test_vpopmail_module { my $self = shift; # vpopmail will not allow vauth_getpw to succeed unless the requesting user is vpopmail or root. # by default, qpsmtpd runs as the user 'qpsmtpd' and does not have permission. eval 'use vpopmail'; if ($@) { $self->log(LOGERROR, "skip: is vpopmail perl module installed?"); return; } my ($domain) = vpopmail::vlistdomains(); my $r = vauth_getpw('postmaster', $domain) or do { $self->log(LOGERROR, "skip: could not query vpopmail"); return; }; return 1; } qpsmtpd-0.94/plugins/auth/auth_vpopmail_sql000066400000000000000000000121221240247602400212310ustar00rootroot00000000000000#!perl -w =head1 NAME auth_vpopmail_sql - Authenticate to vpopmail via MySQL =head1 DESCRIPTION This plugin authenticates vpopmail users directly against a standard vpopmail MySQL database. It makes the not-unreasonable assumption that both pw_name and pw_domain are lowercase only (qmail doesn't actually care). If you are using CRAM-MD5, it also requires that vpopmail be built with the recommended '--enable-clear-passwd=y' option, because there is no way to compare the crypted password. =head1 CONFIGURATION echo "dbi:mysql:dbname=vpopmail;host=127.0.0.1" > config/vpopmail_mysql_dsn echo "vpopmailuser" > config/vpopmail_mysql_user echo "vpoppasswd" > config/vpopmail_mysql_pass This can be a read-only database user since the plugin does not update the last accessed time (yet, see below). This module supports PLAIN, LOGIN, and CRAM-MD5 authentication methods. You can disable undesired methods by editing this module and uncommenting the lines in the register() sub. See the POD for Qspmtpd::Auth for more details on the ramifications of supporting various authentication methods. The remote user must login with a fully qualified e-mail address (i.e. both account name and domain), even if they don't normally need to. This is because the vpopmail table has a unique index on pw_name/pw_domain, and this module requires that only a single record be returned from the database. =head1 LIMITATIONS This authentication modules does not recognize domain aliases. So, if you have the domain example.com, with domain aliases for example.org and example.net, smtp-auth will only work for $user@example.com. If you have domain aliases, consider using another plugin (see SEE ALSO). =head1 FUTURE DIRECTION The default MySQL configuration for vpopmail includes a table to log access, lastauth, which could conceivably be updated upon sucessful authentication. The addition of this feature is left as an exercise for someone who cares. ;) =head1 SEE ALSO For an overview of the vpopmail authentication plugins and their merits, please read the VPOPMAIL section in docs/authentication.pod =head1 AUTHOR John Peacock =head1 COPYRIGHT AND LICENSE Copyright (c) 2004 John Peacock This plugin is licensed under the same terms as the qpsmtpd package itself. Please see the LICENSE file included with qpsmtpd for details. =cut use strict; use warnings; use Qpsmtpd::Auth; use Qpsmtpd::Constants; #use DBI; # done in ->register sub register { my ($self, $qp) = @_; eval 'use DBI'; if ($@) { warn "plugin disabled. is DBI installed?\n"; $self->log(LOGERROR, "skip: plugin disabled. is DBI installed?\n"); return; } $self->register_hook('auth-plain', 'auth_vmysql'); $self->register_hook('auth-login', 'auth_vmysql'); $self->register_hook('auth-cram-md5', 'auth_vmysql'); } sub get_db_handle { my $self = shift; my $dsn = $self->qp->config("vpopmail_mysql_dsn") || "dbi:mysql:dbname=vpopmail;host=127.0.0.1"; my $dbuser = $self->qp->config("vpopmail_mysql_user") || "vpopmailuser"; my $dbpass = $self->qp->config("vpopmail_mysql_pass") || "vpoppasswd"; my $dbh = DBI->connect($dsn, $dbuser, $dbpass) or do { $self->log(LOGERROR, "skip: db connection failed"); return; }; $dbh->{ShowErrorStatement} = 1; return $dbh; } sub get_vpopmail_user { my ($self, $dbh, $user) = @_; my ($pw_name, $pw_domain) = split /@/, lc($user); if (!defined $pw_domain) { $self->log(LOGINFO, "skip: missing domain: " . lc $user); return; } $self->log(LOGDEBUG, "auth_vpopmail_sql: $user"); my $query = "SELECT pw_passwd,pw_clear_passwd FROM vpopmail WHERE pw_name = ? AND pw_domain = ?"; my $sth = $dbh->prepare($query); $sth->execute($pw_name, $pw_domain); my $userd_ref = $sth->fetchrow_hashref; $sth->finish; $dbh->disconnect; return $userd_ref; } sub auth_vmysql { my ($self, $transaction, $method, $user, $passClear, $passHash, $ticket) = @_; my $dbh = $self->get_db_handle() or return DECLINED; my $u = $self->get_vpopmail_user($dbh, $user) or return DECLINED; # if vpopmail was not built with '--enable-clear-passwd=y' # then pw_clear_passwd may not even exist # my $pw_clear_passwd = $db_user->{'pw_clear_passwd'}; if (!$u->{pw_passwd} && !$u->{pw_clear_passwd}) { $self->log(LOGINFO, "fail: no such user"); return (DENY, "auth_vmysql - no such user"); } # at this point, the user name has matched return Qpsmtpd::Auth::validate_password( $self, src_clear => $u->{pw_clear_passwd}, src_crypt => $u->{pw_passwd}, attempt_clear => $passClear, attempt_hash => $passHash, method => $method, ticket => $ticket, deny => DENY, ); } qpsmtpd-0.94/plugins/auth/auth_vpopmaild000066400000000000000000000071641240247602400205300ustar00rootroot00000000000000#!perl -w use strict; use warnings; use Qpsmtpd::Constants; use IO::Socket; use version; my $VERSION = qv('1.0.4'); sub register { my ($self, $qp, %args) = @_; $self->{_vpopmaild_host} = $args{host} || 'localhost'; $self->{_vpopmaild_port} = $args{port} || '89'; $self->register_hook('auth-plain', 'auth_vpopmaild'); $self->register_hook('auth-login', 'auth_vpopmaild'); #$self->register_hook('auth-cram-md5', 'auth_vpopmaild'); # not supported } sub auth_vpopmaild { my ($self, $transaction, $method, $user, $passClear, $passHash, $ticket) = @_; if (!$passClear) { $self->log(LOGINFO, "skip: vpopmaild does not support cram-md5"); return DECLINED; } my $socket = $self->get_socket() or return DECLINED; $self->log(LOGDEBUG, "attempting $method"); # Get server greeting (+OK) my $response = $self->get_response( $socket, '' ) or return DECLINED; if ($response !~ /^\+OK/) { $self->log(LOGERROR, "skip, bad connection response: $response"); close $socket; return DECLINED; } print $socket "login $user $passClear\n\r"; # send login details $response = $self->get_response( $socket, "login $user $passClear\n\r" ) or return DECLINED; close $socket; # check for successful login (single line (+OK) or multiline (+OK+)) if ($response =~ /^\+OK/) { $self->log(LOGINFO, "pass, clear"); return (OK, 'auth_vpopmaild'); } chomp $response; $self->log(LOGNOTICE, "fail, $response"); return DECLINED; } sub get_response { my ($self, $socket, $send) = @_; print $socket $send if $send; # send request my $response = <$socket>; # get response chomp $response; if ( ! defined $response ) { $self->log(LOGERROR, "error, no connection response"); close $socket; return; } if ($response =~ /^([ -~\n\r]+)$/) { # match ascii printable $response = $1; # $response now untainted } else { $self->log(LOGERROR, "error, response unsafe."); }; return $response; }; sub get_socket { my ($self) = @_; # create socket my $socket = IO::Socket::INET->new( PeerAddr => $self->{_vpopmaild_host}, PeerPort => $self->{_vpopmaild_port}, Proto => 'tcp', Type => SOCK_STREAM ) or do { $self->log(LOGERROR, "skip, socket connection to vpopmaild failed"); return; }; return $socket; }; __END__ =head1 NAME auth_vpopmaild - Authenticate to vpopmaild =head1 DESCRIPTION Authenticates the user against against vpopmaild [1] daemon. =head1 CONFIGURATION Add a line to C as follows: auth_vpopmaild By default, the plugin connects to localhot on port 89. If your vpopmaild daemon is running on a different host or port, specify as follows: auth_vpopmaild host [host] port [port] =head1 SEE ALSO For an overview of the vpopmail authentication plugins and their merits, please read the VPOPMAIL section in doc/authentication.pod =head1 LINKS [1] http://www.qmailwiki.org/Vpopmaild =head1 AUTHOR Robin Bowes 2012 Matt Simerson (updated response parsing, added logging) 2013 Matt Simerson - split get_response and get_socket into new methods, added taint checking to responses =head1 COPYRIGHT AND LICENSE Copyright (c) 2010 Robin Bowes This plugin is licensed under the same terms as the qpsmtpd package itself. Please see the LICENSE file included with qpsmtpd for details. =cut qpsmtpd-0.94/plugins/auth/authdeny000066400000000000000000000007331240247602400173300ustar00rootroot00000000000000#!perl -w =head1 NAME authdeny =head1 SYNOPSIS This plugin doesn't actually check anything and will fail any user no matter what they type. It is strictly a proof of concept for the Qpsmtpd::Auth module. Don't run this in production!!! =cut sub hook_auth { my ($self, $transaction, $method, $user, $passClear, $passHash, $ticket) = @_; $self->log(LOGWARN, "fail: cannot authenticate"); return (DECLINED, "$user is not free to abuse my relay"); } qpsmtpd-0.94/plugins/badmailfrom000066400000000000000000000072341240247602400170260ustar00rootroot00000000000000#!perl -w =head1 NAME check_badmailfrom - checks the badmailfrom config, with per-line reasons =head1 DESCRIPTION Reads the "badmailfrom" configuration like qmail-smtpd does. From the qmail-smtpd docs: "Unacceptable envelope sender addresses. qmail-smtpd will reject every recipient address for a message if the envelope sender address is listed in badmailfrom. A line in badmailfrom may be of the form @host, meaning every address at host." You may include an optional message after the sender address (leave a space), to be used when rejecting the sender. =head1 CONFIGURATION =head2 reject badmailfrom reject [ 0 | 1 | naughty ] I<0> will not reject any connections. I<1> will reject naughty senders. I is the most efficient setting. It's also the default. To reject at any other connection hook, use the I setting and the B plugin. =head1 PATTERNS This plugin also supports regular expression matches. This allows special patterns to be denied (e.g. FQDN-VERP, percent hack, bangs, double ats). Patterns are stored in the format pattern(\s+)response, where pattern is a Perl pattern expression. Don't forget to anchor the pattern (front ^ and back $) if you want to restrict it from matching anywhere in the string. ^streamsendbouncer@.*\.mailengine1\.com$ Your right-hand side VERP doesn't fool me ^return.*@.*\.pidplate\.biz$ I don't want it regardless of subdomain ^admin.*\.ppoonn400\.com$ =head1 AUTHORS 2002 - Jim Winstead - initial author of badmailfrom 2010 - Johan Almqvist - pattern matching plugin 2012 - Matt Simerson - merging of the two and plugin tests =cut sub register { my ($self, $qp) = (shift, shift); $self->{_args} = {@_}; $self->{_args}{reject} = 1 if !defined $self->{_args}{reject}; } sub hook_mail { my ($self, $transaction, $sender, %param) = @_; return DECLINED if $self->is_immune(); my @badmailfrom = $self->qp->config('badmailfrom'); if (defined $self->{_badmailfrom_config}) { # testing @badmailfrom = @{$self->{_badmailfrom_config}}; } return DECLINED if $self->is_immune_sender($sender, \@badmailfrom); my $host = lc $sender->host; my $from = lc($sender->user) . '@' . $host; for my $config (@badmailfrom) { $config =~ s/^\s+//g; # trim leading whitespace my ($bad, $reason) = split /\s+/, $config, 2; next unless $bad; next unless $self->is_match($from, $bad, $host); $reason ||= "Your envelope sender is in my badmailfrom list"; $self->adjust_karma(-1); return $self->get_reject($reason); } $self->log(LOGINFO, "pass"); return DECLINED; } sub is_match { my ($self, $from, $bad, $host) = @_; if ($bad =~ /[\/\^\$\*\+\!\%\?\\]/) { # it's a regexp if ($from =~ /$bad/) { $self->log(LOGDEBUG, "badmailfrom pattern ($bad) match for $from"); return 1; } return; } $bad = lc $bad; if ($bad !~ m/\@/) { $self->log(LOGWARN, "badmailfrom: bad config: no \@ sign in $bad"); return; } if (substr($bad, 0, 1) eq '@') { return 1 if $bad eq "\@$host"; return; } return if $bad ne $from; return 1; } sub is_immune_sender { my ($self, $sender, $badmf) = @_; if (!scalar @$badmf) { $self->log(LOGDEBUG, 'skip, empty list'); return 1; } if (!$sender || $sender->format eq '<>') { $self->log(LOGDEBUG, 'skip, null sender'); return 1; } if (!$sender->host || !$sender->user) { $self->log(LOGDEBUG, 'skip, missing user or host'); return 1; } return; } qpsmtpd-0.94/plugins/badmailfromto000066400000000000000000000043431240247602400173670ustar00rootroot00000000000000#!perl -w =head1 NAME badmailfromto - checks the badmailfromto config =head1 DESCRIPTION Much like the similar badmailfrom, this plugin references both the FROM: and TO: lines, and if they both are present in the badmailfromto config file (a tab delimited list of FROM/TO pairs), then the message is blocked as if the recipient (TO) didn't exist. This is specifically designed to not give the impression that the sender is blocked (good for cases of harassment). Based heavily on badmailfrom. =cut use strict; use Qpsmtpd::Constants; sub hook_mail { my ($self, $transaction, $sender, %param) = @_; my @badmailfromto = $self->qp->config("badmailfromto"); return DECLINED if $self->is_sender_immune($sender, \@badmailfromto); my $host = lc $sender->host; my $from = lc($sender->user) . '@' . $host; for my $bad (@badmailfromto) { $bad =~ s/^\s*(\S+).*/$1/; next unless $bad; $bad = lc $bad; if ($bad !~ m/\@/) { $self->log(LOGWARN, 'bad config, no @ sign in ' . $bad); next; } if ($bad eq $from || (substr($bad, 0, 1) eq '@' && $bad eq "\@$host")) { $transaction->notes('badmailfromto', $bad); } } return (DECLINED); } sub hook_rcpt { my ($self, $transaction, $rcpt, %param) = @_; my $recipient = lc($rcpt->user) . '@' . lc($rcpt->host); my $sender = $transaction->notes('badmailfromto') or do { $self->log(LOGDEBUG, "pass, sender not listed"); return (DECLINED); }; foreach ($self->qp->config("badmailfromto")) { my ($from, $to) = m/^\s*(\S+)\t(\S+).*/; return (DENY, "mail to $recipient not accepted here") if lc($from) eq $sender && lc($to) eq $recipient; } $self->log(LOGDEBUG, "pass, recipient not listed"); return (DECLINED); } sub is_sender_immune { my ($self, $sender, $badmf) = @_; if (!scalar @$badmf) { $self->log(LOGDEBUG, 'skip, empty list'); return 1; } if (!$sender || $sender->format eq '<>') { $self->log(LOGDEBUG, 'skip, null sender'); return 1; } if (!$sender->host || !$sender->user) { $self->log(LOGDEBUG, 'skip, missing user or host'); return 1; } return; } qpsmtpd-0.94/plugins/badrcptto000066400000000000000000000064471240247602400165400ustar00rootroot00000000000000#!perl -w =head1 SYNOPSIS deny connections to recipients in the I file like badmailfrom, but for recipient address rather than sender =head1 CONFIG Recipients are matched against entries in I. Entries can be a complete email address, a host entry that starts with an @ symbol, or a regular expression. For regexp pattern matches, see PATTERNS. =head1 PATTERNS This allows special patterns to be denied (e.g. percent hack, bangs, double ats). Patterns are stored in the format pattern\sresponse, where pattern is a Perl pattern expression. Don't forget to anchor the pattern if you want to restrict it from matching anywhere in the string. qpsmtpd already ensures that the address contains an @, with something to the left and right of the @. =head1 AUTHOR 2002 - original badrcptto plugin - apparently Jim Winstead https://github.com/smtpd/qpsmtpd/commits/master/plugins/check_badrcptto 2005 - pattern feature, (c) Gordon Rowell 2012 - merged the two, refactored, added tests - Matt Simerson =head1 LICENSE This software is free software and may be distributed under the same terms as qpsmtpd itself. =cut use strict; use warnings; use Qpsmtpd::Constants; use Qpsmtpd::DSN; sub hook_rcpt { my ($self, $transaction, $recipient, %param) = @_; return (DECLINED) if $self->is_immune(); my ($host, $to) = $self->get_host_and_to($recipient) or return (DECLINED); my @badrcptto = $self->qp->config("badrcptto") or do { $self->log(LOGINFO, "skip, empty config"); return (DECLINED); }; for my $line (@badrcptto) { $line =~ s/^\s+//g; # trim leading whitespace my ($bad, $reason) = split /\s+/, $line, 2; next if !$bad; if ($self->is_match($to, lc($bad), $host)) { $self->adjust_karma(-2); if ($reason) { return (DENY, "mail to $bad not accepted here"); } else { return Qpsmtpd::DSN->no_such_user( "mail to $bad not accepted here"); } } } $self->log(LOGINFO, 'pass'); return (DECLINED); } sub is_match { my ($self, $to, $bad, $host) = @_; if ($bad =~ /[\/\^\$\*\+\!\%\?\\]/) { # it's a regexp $self->log(LOGDEBUG, "badmailfrom pattern ($bad) match for $to"); if ($to =~ /$bad/i) { $self->log(LOGINFO, 'fail: pattern match'); return 1; } return; } if ($bad !~ m/\@/) { $self->log(LOGERROR, "badrcptto: bad config: no \@ sign in $bad"); return; } $bad = lc $bad; $to = lc $to; if (substr($bad, 0, 1) eq '@') { if ($bad eq "\@$host") { $self->log(LOGINFO, 'fail: host match'); return 1; } return; } if ($bad eq $to) { $self->log(LOGINFO, 'fail: rcpt match'); return 1; } return; } sub get_host_and_to { my ($self, $recipient) = @_; if (!$recipient) { $self->log(LOGERROR, 'skip: no recipient!'); return; } if (!$recipient->host || !$recipient->user) { $self->log(LOGINFO, 'skip: missing host or user'); return; } my $host = lc $recipient->host; return ($host, lc($recipient->user) . '@' . $host); } qpsmtpd-0.94/plugins/bogus_bounce000066400000000000000000000044451240247602400172240ustar00rootroot00000000000000#!perl -w =head1 NAME bogus_bounce - Check that a bounce message isn't bogus =head1 DESCRIPTION This plugin is designed to reject bogus bounce messages. In our case a bogus bounce message is defined as a bounce message which has more than a single recipient. =head1 CONFIGURATION Only a single argument is recognized and is assumed to be the default action. Valid settings are: =over 8 =item log Merely log the receipt of the bogus bounce (the default behaviour). =item deny Deny with a hard error code. =item denysoft Deny with a soft error code. =back =head1 AUTHOR 2010 - Steve Kemp - http://steve.org.uk/Software/qpsmtpd/ 2013 - Matt Simerson - added Return Path check =cut sub register { my ($self, $qp) = (shift, shift); if (@_ % 2) { $self->{_args}{action} = shift; } else { $self->{_args} = {@_}; } if (!defined $self->{_args}{reject}) { $self->{_args}{reject} = 0; # legacy default } # we only need to check for deferral, default is DENY if ($self->{_args}{action} && $self->{_args}{action} =~ /soft/i) { $self->{_args}{reject_type} = 'temp'; } } sub hook_data_post { my ($self, $transaction) = (@_); # # Find the sender, quit processing if this isn't a bounce. # my $sender = $transaction->sender->address || undef; if ($sender && $sender ne '<>') { $self->log(LOGINFO, "pass, not a null sender"); return DECLINED; } # at this point we know it is a bounce, via the null-envelope. # # Count the recipients. Valid bounces have a single recipient # my @to = $transaction->recipients || (); if (scalar @to != 1) { $self->log(LOGINFO, "fail, bogus bounce to: " . join(',', @to)); return $self->get_reject( "fail, this bounce message does not have 1 recipient"); } # validate that Return-Path is empty, RFC 3834 my $rp = $transaction->header->get('Return-Path'); if ($rp && $rp ne '<>') { $self->log(LOGINFO, "fail, bounce messages must not have a Return-Path"); return $self->get_reject( "a bounce return path must be empty (RFC 3834)"); } $self->log(LOGINFO, "pass, single recipient, empty Return-Path"); return DECLINED; } qpsmtpd-0.94/plugins/connection_time000066400000000000000000000037571240247602400177340ustar00rootroot00000000000000#!perl -w =head1 NAME connection_time - log the duration of a connection =head1 DESCRIPTION The B plugin records the time of a connection between the first and the last possible hook in qpsmtpd (I and I) and writes a C (default, see below) line to the log. =head1 CONFIG =head2 loglevel Adjust the quantity of logging for this plugin. See docs/logging.pod connection_time loglevel +1 (less logging) connection_time loglevel -1 (more logging) =cut use strict; use warnings; use Qpsmtpd::Constants; use Time::HiRes qw(gettimeofday tv_interval); sub register { my ($self, $qp) = (shift, shift); if (@_ == 1) { # backwards compatible $self->{_args}{loglevel} = shift; if ($self->{_args}{loglevel} =~ /\D/) { $self->{_args}{loglevel} = Qpsmtpd::Constants::log_level($self->{_args}{loglevel}); } $self->{_args}{loglevel} ||= 6; } elsif (@_ % 2) { $self->log(LOGERROR, "invalid arguments"); } else { $self->{_args} = {@_}; # named args, inherits loglevel } # pre-connection is not available in the tcpserver deployment model. # duplicate the handler, so it works both ways with no redudant methods $self->register_hook('pre-connection', 'connect_handler'); $self->register_hook('connect', 'connect_handler'); } sub connect_handler { my $self = shift; return DECLINED if ($self->hook_name eq 'connect' && defined $self->{_connection_start}); $self->{_connection_start} = [gettimeofday]; $self->log(LOGDEBUG, "started at " . scalar gettimeofday); return (DECLINED); } sub hook_post_connection { my $self = shift; if (!$self->{_connection_start}) { $self->log(LOGERROR, "Start time not set?!"); return (DECLINED); } my $elapsed = tv_interval($self->{_connection_start}, [gettimeofday]); $self->log(LOGINFO, sprintf "%.3f s.", $elapsed); return (DECLINED); } qpsmtpd-0.94/plugins/content_log000066400000000000000000000012601240247602400170550ustar00rootroot00000000000000#!perl -w # A simple example of a plugin that logs all incoming mail to a file. # Useful for debugging other plugins or keeping an archive of things. use POSIX qw:strftime:; sub hook_data_post { my ($self, $transaction) = @_; # as a decent default, log on a per-day-basis my $date = strftime("%Y%m%d", localtime(time)); open(my $out, ">>mail/$date") or return (DECLINED, "Could not open log file.. continuing anyway"); $transaction->header->print($out); $transaction->body_resetpos; while (my $line = $transaction->body_getline) { print $out $line; } close $out; return (DECLINED, "successfully saved message.. continuing"); } qpsmtpd-0.94/plugins/count_unrecognized_commands000066400000000000000000000021501240247602400223260ustar00rootroot00000000000000#!perl -w =head1 NAME count_unrecognized_commands - and disconnect after too many =head1 DESCRIPTION Disconnect the client if it sends too many unrecognized commands. Good for rejecting spam sent through open HTTP proxies. =head1 CONFIGURATION Takes one parameter, the number of allowed unrecognized commands before we disconnect the client. Defaults to 4. =cut use strict; use warnings; use Qpsmtpd::Constants; sub register { my ($self, $qp) = (shift, shift); $self->{_unrec_cmd_max} = shift || 4; if (scalar @_) { $self->log(LOGWARN, "Ignoring additional arguments."); } } sub hook_unrecognized_command { my ($self, $cmd) = @_[0, 2]; my $count = $self->connection->notes('unrec_cmd_count') || 0; $count = $count + 1; $self->connection->notes('unrec_cmd_count', $count); if ($count < $self->{_unrec_cmd_max}) { $self->log(LOGINFO, "'$cmd', ($count)"); return DECLINED; } $self->log(LOGINFO, "fail, '$cmd' ($count)"); return (DENY_DISCONNECT, "Closing connection, $count unrecognized commands. Perhaps you should read RFC 2821?" ); } qpsmtpd-0.94/plugins/dkim000066400000000000000000000415621240247602400154770ustar00rootroot00000000000000#!perl -w =head1 NAME dkim: validate DomainKeys and (DKIM) Domain Keys Indentified Messages =head1 SYNOPSIS Validate the DKIM and Domainkeys signatures of a message, enforce DKIM sending policies, and DKIM sign outgoing messages. =head1 CONFIGURATION =head2 reject [ 0 | 1 | naughty ] dkim [ reject 0 ] 0 - do not reject 1 - reject messages that fail DKIM policy naughty - defer rejection to the B plugin Default: 1 =head2 reject_type dkim reject_type [ temp | perm ] Default: perm =head1 HOW TO SIGN =head2 generate DKIM keys =head3 the easy way cd ~smtpd/config/dkim; ./dkim_key_gen.sh example.org =head3 the manual way mkdir -p ~smtpd/config/dkim/example.org cd ~smtpd/config/dkim/example.org echo 'may2013' > selector openssl genrsa -out private 2048 chmod 400 private openssl rsa -in private -out public -pubout chown -R smtpd:smtpd ../example.org After generating the keys, there will be three files in the example.org directory: selector, private, and public. =head3 selector The selector can be any value that is a valid DNS label. =head3 key length The minimum recommended key length for short duration keys (ones that will be replaced within a few months) is 1024. If you are unlikely to rotate your keys frequently, choose 2048, at the expense of a bit more CPU. =head2 publish public key in DNS If the DKIM keys were generated the easy way, there will be a fourth file named I. The contents contain the DNS formatted record of the public key, as well as suggestions for DKIM, SPF, and DMARC policy records. The records are ready to be copy/pasted into a BIND zone file, or better yet, NicTool. If you created your keys manually, look in the dkim_key_gen.sh script to see the commands used to format the DKIM public key. The combination of the three example DKIM, SPF, and DMARC policy records in the I file tell other mail servers that if a sender claims to be from example.org, but the message is not DKIM nor SPF aligned, then the message should be rejected. Many email servers, including the largest email providers (Gmail, Yahoo, Outlook/Live/Hotmail) will refuse to accept such messages, greatly reducing the harm caused by miscreants who forge your domain(s) in the From header of their spam. The DKIM record will look like this: may2013._domainkey TXT "v=DKIM1;p=[public key stripped of whitespace];" And the values in the address have the following meaning: hash: h=[ sha1 | sha256 ] test; t=[ s | s:y ] granularity: g=[ ] notes: n=[ ] services: s=[email] keytypes: [ rsa ] =head2 testing After confirming that the DKIM public key can be fetched with DNS (dig TXT may2013._domainkey.example.org. @ns1.example.org.), send test messages. You can testing DKIM by sending an email to: * a Gmail address and inspect the Authentication-Results header. * check-auth@verifier.port25.com * checkmyauth@auth.returnpath.net The two DKIM relays provide a nice email report with additional debugging information. =head2 publish DKIM policy in DNS _domainkey TXT "o=~; t=y; r=postmaster@example.org" o=- - all are signed o=~ - some are signed t=y - test mode r=[email] - responsible email address n=[notes] After DKIM and SPF are tested and working, update the policy, changing o=~ to o=-, so that other mail servers reject unsigned messages claiming to be from your domain. As of this writing, most mail servers do not reject messages that fail DKIM policy, unless they also fail SPF, and no DMARC policy is published. The same holds true for SPF. There are technical reasons for this. See DMARC for more information, how you can control change that behavior, as well as receiving feedback from remote servers about messages they have accepted and rejected from senders claiming the identity of your domain(s). =head2 Sign for others Following the directions above will configure QP to DKIM sign messages from authenticated senders of example.org. Suppose you host client.com and would like to DKIM sign their messages too? Do that as follows: cd ~smtpd/config/dkim ln -s example.org client.com QP will follow the symlink target and sign client.com emails with the example.org DKIM key. This is B necessary for hosts or subdomains. If the DKIM key for host.example.com does not exist, and a key for example.com does exist, the parent DKIM key will be used to sign the message. So long as your DKIM and DMARC policies are set to relaxed alignment, these signed messages for subdomains will pass. CAUTION: just because you can sign for other domains, doesn't mean you should. Even with a relaxed DKIM policy, if the other domain doesn't have a suitable DMARC record for client.com, they may encounter deliverability problems. It is better to have keys generated and published for each domain. =head1 SEE ALSO http://www.dkim.org/ http://tools.ietf.org/html/rfc6376 - DKIM Signatures http://tools.ietf.org/html/rfc5863 - DKIM Development, Deployment, & Operations http://tools.ietf.org/html/rfc5617 - DKIM ADSP (Author Domain Signing Practices) http://tools.ietf.org/html/rfc5585 - DKIM Service Overview http://tools.ietf.org/html/rfc5016 - DKIM Signing Practices Protocol http://tools.ietf.org/html/rfc4871 - DKIM Signatures http://tools.ietf.org/html/rfc4870 - DomainKeys http://dkimcore.org/tools/ http://www.protodave.com/tools/dkim-key-checker/ =head1 AUTHORS 2013 - Matt Simerson - added DKIM signing and key creation script 2012 - Matt Simerson - initial plugin =head1 ACKNOWLEDGEMENTS David Summers - http://www.nntp.perl.org/group/perl.qpsmtpd/2010/08/msg9417.html Matthew Harrell - http://alecto.bittwiddlers.com/files/qpsmtpd/dkimcheck I first attempted to fix the dkimcheck plugin, but soon scrapped that effort and wrote this one. Why? =over 4 The use of $dkim->fetch_author_policy, which is deprecated by Mail::DKIM. The paradim of a single policy, when DKIM supports 0 or many. The OBF programming style, which is nigh impossible to test. The nine 'if' brackets with 19 conditionals, and my inability to easily determine which of the 15 possible permutations (5 signature validation results x 3 possible policy results) were covered. =back =cut use strict; use warnings; use Qpsmtpd::Constants; # use Mail::DKIM::Verifier; # eval'ed in register() # use Mail::DKIM::Signer; use Socket qw(:DEFAULT :crlf); sub init { my ($self, $qp) = (shift, shift); $self->{_args} = {@_}; $self->{_args}{reject} = 1 if !defined $self->{_args}{reject}; $self->{_args}{reject_type} ||= 'perm'; } sub register { my $self = shift; # Mail::DKIM::TextWrap - nice idea, clients get mangled headers though foreach my $mod (qw/ Mail::DKIM::Verifier Mail::DKIM::Signer /) { eval "use $mod"; if ($@) { warn "error, plugin disabled, could not load $mod\n"; $self->log(LOGERROR, "skip, plugin disabled, is Mail::DKIM installed?"); return; } } $self->register_hook('data_post', 'data_post_handler'); } sub data_post_handler { my ($self, $transaction) = @_; if ($self->qp->connection->relay_client()) { # this is an authenticated user sending a message. return $self->sign_it($transaction); } return DECLINED if $self->is_immune(); return $self->validate_it($transaction); } sub validate_it { my ($self, $transaction) = @_; # Incoming message, perform DKIM validation my $dkim = Mail::DKIM::Verifier->new() or do { $self->log(LOGERROR, "error, could not instantiate a new Mail::DKIM::Verifier"); return DECLINED; }; $self->send_message_to_dkim($dkim, $transaction); my $result = $dkim->result; my $mess = $self->get_details($dkim); $self->connection->notes('dkim_result', $result); $self->connection->notes('dkim_verifier', $dkim); my $auth_str = "dkim=" .$dkim->result_detail; if ( $dkim->signature && $dkim->signature->domain ) { $auth_str .= " header.i=@" . $dkim->signature->domain; }; $self->store_auth_results( $auth_str ); foreach my $t (qw/ pass fail invalid temperror none /) { next if $t ne $result; my $handler = 'handle_sig_' . $t; $self->log(LOGDEBUG, "dispatching $result to $handler"); return $self->$handler($dkim, $mess); } $self->log(LOGERROR, "error, unknown result: $result, $mess"); return DECLINED; } sub sign_it { my ($self, $transaction) = @_; my ($domain, $keydir) = $self->get_keydir($transaction) or return DECLINED; my $selector = $self->get_selector($keydir); my $dkim = Mail::DKIM::Signer->new( Algorithm => "rsa-sha256", Method => "relaxed", Domain => $domain, Selector => $selector, KeyFile => "$keydir/private", ); $self->send_message_to_dkim($dkim, $transaction); my $signature = $dkim->signature; # what is the signature result? $self->qp->transaction->header->add('DKIM-Signature', $signature->as_string, 0); $self->log(LOGINFO, "pass, we signed the message"); return DECLINED; } sub get_details { my ($self, $dkim) = @_; my @data; my $string; push @data, "domain: " . $dkim->signature->domain if $dkim->signature; push @data, "selector: " . $dkim->signature->selector if $dkim->signature; push @data, "result: " . $dkim->result_detail if $dkim->result_detail; foreach my $policy ($dkim->policies) { next if !$policy; push @data, "policy: " . $policy->as_string; push @data, "name: " . $policy->name; push @data, "policy_location: " . $policy->location if $policy->location; my $policy_result; $policy_result = $policy->apply($dkim); $policy_result or next; push @data, "policy_result: " . $policy_result if $policy_result; } return join(', ', @data); } sub handle_sig_fail { my ($self, $dkim, $mess) = @_; $self->adjust_karma(-1); return $self->get_reject("signature invalid: " . $dkim->result_detail, $mess); } sub handle_sig_temperror { my ($self, $dkim, $mess) = @_; $self->log(LOGINFO, "error, $mess"); return (DENYSOFT, "Please try again later - $dkim->result_detail"); } sub handle_sig_invalid { my ($self, $dkim, $mess) = @_; my ($prs, $policies) = $self->get_policy_results($dkim); foreach my $policy (@$policies) { if ($policy->signall && !$policy->is_implied_default_policy) { $self->log(LOGINFO, $mess); return $self->get_reject("invalid DKIM signature with sign-all policy", "invalid signature, sign-all policy"); } } $self->adjust_karma(-1); $self->log(LOGINFO, $mess); if ($prs->{accept}) { $self->log(LOGERROR, "error, invalid signature but accept policy!?"); return DECLINED; } elsif ($prs->{neutral}) { $self->log(LOGERROR, "error, invalid signature but neutral policy?!"); return DECLINED; } elsif ($prs->{reject}) { return $self->get_reject("invalid DKIM signature: " . $dkim->result_detail, "fail, invalid signature, reject policy"); } # this should never happen $self->log(LOGINFO, "error, invalid signature, unhandled"); return DECLINED; } sub handle_sig_pass { my ($self, $dkim, $mess) = @_; $self->save_signatures_to_note($dkim); my ($prs) = $self->get_policy_results($dkim); if ($prs->{accept}) { $self->add_header($mess); $self->log(LOGINFO, "pass, valid signature, accept policy"); $self->adjust_karma(1); return DECLINED; } elsif ($prs->{neutral}) { $self->add_header($mess); $self->log(LOGINFO, "pass, valid signature, neutral policy"); $self->log(LOGDEBUG, $mess); return DECLINED; } elsif ($prs->{reject}) { $self->log(LOGINFO, $mess); $self->adjust_karma(-1); return $self->get_reject("DKIM signature valid but fails policy, $mess", "fail, valid sig, reject policy"); } # this should never happen, $self->add_header($mess); $self->log(LOGERROR, "pass, valid sig, no policy results"); $self->log(LOGINFO, $mess); return DECLINED; } sub handle_sig_none { my ($self, $dkim, $mess) = @_; my ($prs, $policies) = $self->get_policy_results($dkim); foreach my $policy (@$policies) { if ($policy->signall && !$policy->is_implied_default_policy) { $self->log(LOGINFO, $mess); return $self->get_reject("no DKIM signature with sign-all policy", "no signature, sign-all policy"); } } if ($prs->{accept}) { $self->log(LOGINFO, "pass, no signature, accept policy"); return DECLINED; } elsif ($prs->{neutral}) { $self->log(LOGINFO, "pass, no signature, neutral policy"); return DECLINED; } elsif ($prs->{reject}) { $self->log(LOGINFO, $mess); $self->get_reject( "no DKIM signature, policy says reject: " . $dkim->result_detail, "no signature, reject policy"); } # should never happen $self->log(LOGINFO, "error, no signature, no policy"); $self->log(LOGINFO, $mess); return DECLINED; } sub get_keydir { my ($self, $transaction) = @_; my $domain = $transaction->sender->host; my $dir = "config/dkim/$domain"; if (!-e $dir) { # the dkim key dir doesn't exist my @labels = split /\./, $domain; # split the domain into labels while (@labels > 1) { shift @labels; # remove the first label (ie: www) my $zone = join '.', @labels; # reassemble the labels if (-e "config/dkim/$zone") { # if the directory exists $domain = $zone; # the DKIM signing domain $dir = "config/dkim/$zone"; # use the parent domain's key $self->log(LOGINFO, "info, using $zone key for $domain"); } } } if (-l $dir) { $dir = readlink($dir); $dir = "config/dkim/$dir" if $dir !~ /\//; # no /, relative path ($domain) = (split /\//, $dir)[-1]; } if (!-d $dir) { $self->log(LOGINFO, "skip, DKIM not configured for $domain"); return; } if (!-r $dir) { $self->log(LOGINFO, "error, unable to read key from $dir"); return; } if (!-r "$dir/private") { $self->log(LOGINFO, "error, unable to read dkim key from $dir/private"); return; } return ($domain, $dir); } sub save_signatures_to_note { my ($self, $dkim) = @_; my %domains; foreach my $sig ($dkim->signatures) { next if $sig->result ne 'pass'; $domains{$sig->domain} = 1; } return if 0 == scalar keys %domains; my $doms = $self->connection->notes('dkim_pass_domains') || []; push @$doms, keys %domains; $self->log(LOGDEBUG, "info, signed by: ". join(',', keys %domains) ); $self->connection->notes('dkim_pass_domains', $doms); } sub send_message_to_dkim { my ($self, $dkim, $transaction) = @_; foreach (split(/\n/s, $transaction->header->as_string)) { $_ =~ s/\r?$//s; eval { $dkim->PRINT($_ . CRLF); }; $self->log(LOGERROR, $@) if $@; } $transaction->body_resetpos; while (my $line = $transaction->body_getline) { chomp $line; $line =~ s/\015$//; eval { $dkim->PRINT($line . CRLF); }; $self->log(LOGERROR, $@) if $@; } eval { $dkim->CLOSE; }; $self->log(LOGERROR, $@) if $@; } sub get_policies { my ($self, $dkim) = @_; my @policies; eval { @policies = $dkim->policies }; $self->log(LOGERROR, $@) if $@; return @policies; } sub get_policy_results { my ($self, $dkim) = @_; my %prs; my @policies = $self->get_policies($dkim); foreach my $policy (@policies) { my $policy_result; eval { $policy_result = $policy->apply($dkim); }; # accept, reject, neutral if ($@) { $self->log(LOGERROR, $@); } $prs{$policy_result}++ if $policy_result; } return \%prs, \@policies; } sub get_selector { my ($self, $keydir) = @_; open my $SFH, '<', "$keydir/selector" or do { $self->log(LOGINFO, "error, unable to read selector from $keydir/selector"); return DECLINED; }; my $selector = <$SFH>; chomp $selector; close $SFH; $self->log(LOGDEBUG, "info, selector: $selector"); return $selector; } sub add_header { my $self = shift; my $header = shift or return; $self->qp->transaction->header->add('X-DKIM-Authentication', $header, 0); } qpsmtpd-0.94/plugins/dmarc000066400000000000000000000143651240247602400156420ustar00rootroot00000000000000#!perl -w =head1 NAME Domain-based Message Authentication, Reporting and Conformance =head1 SYNOPSIS DMARC is a reliable means to authenticate email. =head1 DESCRIPTION From the DMARC Draft: "DMARC operates as a policy layer atop DKIM and SPF. These technologies are the building blocks of DMARC as each is widely deployed, supported by mature tools, and is readily available to both senders and receivers. They are complementary, as each is resilient to many of the failure modes of the other." DMARC provides a way to exchange authentication information and policies among mail servers. DMARC benefits domain owners by preventing others from impersonating them. A domain owner can reliably tell other mail servers that "it it doesn't originate from this list of servers (SPF) and it is not signed (DKIM), then [ignore|quarantine|reject] it." DMARC also provides domain owners with a means to receive feedback and determine that their policies are working as desired. DMARC benefits mail server operators by providing them with a more reliable (than SPF or DKIM alone) means to block forged emails. Is that message really from PayPal, Chase, Gmail, or Facebook? Since those organizations publish DMARC policies, operators have a definitive means to know. =head1 HOWTO =head2 Protect a domain with DMARC See Section 10 of the draft: Domain Owner Actions 1. Deploy DKIM & SPF 2. Ensure identifier alignment. 3. Publish a "monitor" record, ask for data reports 4. Roll policies from monitor to reject =head3 Publish a DMARC policy _dmarc IN TXT "v=DMARC1; p=reject; rua=mailto:dmarc-feedback@example.com;" v=DMARC1; (version) p=none; (disposition policy : reject, quarantine, none (monitor)) sp=reject; (subdomain policy: default, same as p) adkim=s; (dkim alignment: s=strict, r=relaxed) aspf=r; (spf alignment: s=strict, r=relaxed) rua=mailto: dmarc-feedback@example.com; (aggregate reports) ruf=mailto: dmarc-feedback@example.com; (forensic reports) rf=afrf; (report format: afrf, iodef) ri=8400; (report interval) pct=50; (percent of messages to filter) =head2 Validate messages with DMARC 1. install Mail::DMARC 2. install this plugin 3. activate this plugin. (add to config/plugins, listing it after SPF & DKIM. Check that SPF and DKIM are configured to not reject mail. =head1 MORE INFORMATION http://www.dmarc.org/draft-dmarc-base-00-02.txt https://github.com/smtpd/qpsmtpd/wiki/DMARC-FAQ =head1 TODO reject messages with multiple From: headers =head1 AUTHORS 2013 - Matt Simerson =cut use strict; use warnings; use Data::Dumper; use Qpsmtpd::Constants; sub register { my ($self, $qp, @args) = @_; $self->log(LOGERROR, "Bad arguments") if @args % 2; $self->{_args} = {@args}; $self->{_args}{reject} = 1 if !defined $self->{_args}{reject}; $self->{_args}{reject_type} ||= 'perm'; $self->{_args}{p_vals} = {map { $_ => 1 } qw/ none reject quarantine /}; eval "require Mail::DMARC::PurePerl"; if ( $@ ) { $self->log(LOGERROR, "failed to load Mail::DMARC::PurePerl" ); } else { $self->{_dmarc} = Mail::DMARC::PurePerl->new(); $self->register_hook('data_post', 'data_post_handler'); }; } sub data_post_handler { my ($self, $transaction) = @_; if ( $self->qp->connection->relay_client() ) { $self->log(LOGINFO, "skip, relay client" ); return DECLINED; # disable reporting to ourself }; my $dmarc = $self->{_dmarc}; $dmarc->init(); my $from = $transaction->header->get('From'); if ( ! $from ) { $self->log(LOGINFO, "skip, null sender" ); return $self->get_reject("empty from address, null sender?"); }; eval { $dmarc->header_from_raw( $from ); }; if ( $@ ) { $self->log(LOGERROR, "unparseable from header: $from" ); return $self->get_reject("unparseable from header"); }; my @recipients = $transaction->recipients; eval { $dmarc->envelope_to( lc $recipients[0]->host ); }; # optional eval { $dmarc->envelope_from( $transaction->sender->host ); }; # may be <> $dmarc->spf( $transaction->notes('dmarc_spf') ); my $dkim = $self->connection->notes('dkim_verifier'); if ( $dkim ) { $dmarc->dkim( $dkim ); }; $dmarc->source_ip( $self->qp->connection->remote_ip ); eval { $dmarc->validate(); }; if ( $@ ) { $self->log(LOGERROR, $@ ); return DECLINED if $self->is_immune; $self->log(LOGINFO, "TODO: handle this validation failure"); return DECLINED; return $self->get_reject( $@, $@ ); }; #$self->log(LOGINFO, "result: " . Dumper( $dmarc ) ); my $pol; eval { $pol = $dmarc->result->published; }; if ( $pol ) { if ( $dmarc->has_valid_reporting_uri($pol->rua) ) { eval { $dmarc->save_aggregate(); }; $self->log(LOGERROR, $@ ) if $@; } else { $self->log(LOGERROR, "has policy, no report URI" ); }; }; my $disposition = $dmarc->result->disposition; my $auth_str = "dmarc=$disposition"; $auth_str = " (p=" . $pol->p . ")" if $pol; if ( $dmarc->result->result eq 'pass' ) { $self->log(LOGINFO, "pass"); $self->store_auth_results( $auth_str . " d=" . $dmarc->header_from); return DECLINED; }; my $reason_type = my $comment = ''; if ( $dmarc->result->reason && $dmarc->result->reason->[0] ) { $reason_type = $dmarc->result->reason->[0]->type; if ( $dmarc->result->reason->[0]->comment ) { $comment = $dmarc->result->reason->[0]->comment; }; }; if ( $disposition eq 'none' && $comment && $comment eq 'no policy') { $self->log(LOGINFO, "skip, no policy"); return DECLINED; }; my $log_mess = $dmarc->result->result; $log_mess .= ", tolerated" if $disposition eq 'none'; $log_mess .= ", $reason_type" if $reason_type; $log_mess .= ", $comment" if $comment; $self->log(LOGINFO, $log_mess); $self->store_auth_results( $auth_str . " d=" . $dmarc->header_from); return DECLINED if $disposition eq 'none'; return DECLINED if ! $disposition; # for safety return DECLINED if $self->is_immune; $self->adjust_karma(-3); # at what point do we reject? return $self->get_reject("failed DMARC policy"); } qpsmtpd-0.94/plugins/dns_whitelist_soft000066400000000000000000000116731240247602400204660ustar00rootroot00000000000000#!perl -w =head1 NAME dns_whitelist_soft - dns-based whitelist override for other qpsmtpd plugins =head1 DESCRIPTION The dns_whitelist_soft plugin allows selected host to be whitelisted as exceptions to later plugin processing. It is strongly based on the original dnsbl plugin as well as Gavin Carr's original whitelist_soft plugin. It is most suitable for multisite installations, so that the whitelist is stored in one location and available from all. =head1 CONFIGURATION To enable the plugin, add it to the ~qpsmtpd/config/plugins file as usual. It should precede any plugins whose rejections you wish to override. You may have to alter those plugins to check the appropriate notes field. Several configuration files are supported, corresponding to different parts of the SMTP conversation: =over 4 =item whitelist_zones Any IP address listed in the whitelist_zones file is queried using the connecting MTA's IP address. Any A or TXT answer means that the remote HOST address can be selectively exempted at other stages by plugins testing for a 'whitelisthost' connection note. =back NOTE: other 'connect' hooks will continue to fire (e.g. dnsbl), since the DNS queries happen in the background. This plugin's 'rcpt_handler' retrieves the results of the query and sets the connection note if found. If you switch to qpsmtpd-async and to the async version of this plugin, then the 'whitelisthost' connection note will be available to the other 'connect' hooks, see the documentation of the async plugin. =head1 AUTHOR John Peacock Based on the 'whitelist_soft' plugin by Gavin Carr , based on the 'whitelist' plugin by Devin Carraway . =cut use strict; use warnings; use Qpsmtpd::Constants; sub register { my ($self, $qp) = (shift, shift); $self->log(LOGERROR, "Bad arguments") if @_ % 2; $self->{_args} = {@_}; } sub hook_connect { my ($self, $transaction) = @_; my $remote_ip = $self->qp->connection->remote_ip; my %whitelist_zones = map { (split /\s+/, $_, 2)[0, 1] } $self->qp->config('whitelist_zones'); return DECLINED unless %whitelist_zones; my $reversed_ip = join('.', reverse(split(/\./, $remote_ip))); # we queue these lookups in the background and just fetch the # results in the first rcpt handler my $res = new Net::DNS::Resolver; my $sel = IO::Select->new(); for my $dnsbl (keys %whitelist_zones) { $self->log(LOGDEBUG, "Checking $reversed_ip.$dnsbl in the background"); $sel->add($res->bgsend("$reversed_ip.$dnsbl", 'TXT')); } $self->connection->notes('whitelist_sockets', $sel); return DECLINED; } sub process_sockets { my ($self) = @_; my $conn = $self->connection; return $conn->notes('whitelisthost') if $conn->notes('whitelisthost'); my $res = new Net::DNS::Resolver; my $sel = $conn->notes('whitelist_sockets') or return ''; $self->log(LOGDEBUG, "waiting for whitelist dns"); # don't wait more than 4 seconds here my @ready = $sel->can_read(4); $self->log(LOGDEBUG, "done waiting for whitelist dns, got ", scalar @ready, " answers ..."); return '' unless @ready; my $result; for my $socket (@ready) { my $query = $res->bgread($socket); $sel->remove($socket); undef $socket; my $whitelist; if ($query) { my $a_record = 0; foreach my $rr ($query->answer) { $a_record = 1 if $rr->type eq 'A'; my $name = $rr->name; ($whitelist) = ($name =~ m/(?:\d+\.){4}(.*)/) unless $whitelist; $whitelist = $name unless $whitelist; $self->log(LOGDEBUG, 'name ', $rr->name); next unless $rr->type eq 'TXT'; $self->log(LOGDEBUG, "got txt record"); $result = $rr->txtdata and last; } $a_record and $result = "Blocked by $whitelist"; } else { $self->log(LOGERROR, "$whitelist query failed: ", $res->errorstring) if $res->errorstring ne "NXDOMAIN"; } if ($result) { # kill any other pending I/O $conn->notes('whitelist_sockets', undef); return $conn->notes('whitelisthost', $result); } } if ($sel->count) { # loop around if we have dns blacklists left to see results from return $self->process_sockets(); } # er, the following code doesn't make much sense anymore... # if there was more to read; then forget it $conn->notes('whitelist_sockets', undef); return $conn->notes('whitelisthost', $result); } sub hook_rcpt { my ($self, $transaction, $rcpt, %param) = @_; my $ip = $self->qp->connection->remote_ip or return (DECLINED); my $note = $self->process_sockets; if ($note) { $self->log(LOGNOTICE, "Host $ip is whitelisted: $note"); } return DECLINED; } qpsmtpd-0.94/plugins/dnsbl000066400000000000000000000217241240247602400156530ustar00rootroot00000000000000#!perl -w =head1 NAME dnsbl - handle DNS BlackList lookups =head1 DESCRIPTION Plugin that checks the IP address of the incoming connection against a configurable set of RBL services. =head1 USAGE Add the following line to the config/plugins file: dnsbl The following options are also availble: =head2 reject [ 0 | 1 | naughty ] dnsbl reject 0 <- do not reject dnsbl reject 1 <- reject dnsbl reject naughty <- See perldoc plugins/naughty Also, when I is set, DNS queries are processed during connect. =head2 reject_type [ temp | perm | disconnect ] Default: perm To immediately drop the connection (since some blacklisted servers attempt multiple sends per session), set I. In most cases, an IP address that is listed should not be given the opportunity to begin a new transaction, since even the most volatile blacklists will return the same answer for a short period of time (the minimum DNS cache period). =head2 loglevel dnsbl [loglevel -1] Adjust the quantity of logging for this plugin. See docs/logging.pod =head1 CONFIG FILES This plugin uses the following configuration files. All are optional. Not specifying dnsbl_zones is like not using the plugin at all. =head2 dnsbl_zones Normal ip based dns blocking lists ("RBLs") which contain TXT records are specified simply as: relays.ordb.org spamsources.fabel.dk To configure RBL services which do not contain TXT records in the DNS, but only A records (e.g. the RBL+ at http://www.mail-abuse.org), specify your own error message to return in the SMTP conversation after a colon e.g. rbl-plus.mail-abuse.org:You are listed at - http://http://www.mail-abuse.org/cgi-bin/lookup?%IP% The string %IP% will be replaced with the IP address of incoming connection. Thus a fully specified file could be: sbl-xbl.spamhaus.org list.dsbl.org rbl-plus.mail-abuse.ja.net:Listed by rbl-plus.mail-abuse.ja.net - see relays.ordb.org =head2 dnsbl_allow List of allowed ip addresses that bypass RBL checking. Format is one entry per line, with either a full IP address or a truncated IP address with a period at the end. For example: 192.168.1.1 172.16.33. NB the environment variable RBLSMTPD is considered before this file is referenced. See below. =head2 dnsbl_rejectmsg A textual message that is sent to the sender on an RBL failure. The TXT record from the RBL list is also sent, but this file can be used to indicate what action the sender should take. For example: If you think you have been blocked in error, then please forward this entire error message to your ISP so that they can fix their problems. The next line often contains a URL that can be visited for more information. =head1 Environment Variables =head2 RBLSMTPD The environment variable RBLSMTPD is supported and mimics the behaviour of Dan Bernstein's rblsmtpd. The exception to this is the '-' char at the start of RBLSMTPD which is used to force a hard error in Dan's rblsmtpd. NB I don't really see the benefit of using a soft error for a site in an RBL list. This just complicates things as it takes 7 days (or whatever default period) before a user gets an error email back. In the meantime they are complaining that their emails are being "lost" :( =over 4 =item RBLSMTPD is set and non-empty The contents are used as the SMTP conversation error. Use this for forcibly blocking sites you don't like =item RBLSMTPD is set, but empty In this case no RBL checks are made. This can be used for local addresses. =item RBLSMTPD is not set All RBL checks will be made. This is the setting for remote sites that you want to check against RBL. =back =head1 Revisions See: https://github.com/smtpd/qpsmtpd/commits/master/plugins/dnsbl =cut sub register { my ($self, $qp) = (shift, shift); if (@_ % 2) { $self->{_args}{reject_type} = shift; # backwards compatibility } else { $self->{_args} = {@_}; } # explicitly state legacy reject behavior if (!defined $self->{_args}{reject_type}) { $self->{_args}{reject_type} = 'perm'; } if (!defined $self->{_args}{reject}) { $self->{_args}{reject} = 1; } } sub hook_connect { my ($self, $transaction) = @_; # perform RBLSMTPD checks to mimic DJB's rblsmtpd # RBLSMTPD being non-empty means it contains the failure message to return if (defined $ENV{'RBLSMTPD'} && $ENV{'RBLSMTPD'} ne '') { my $reject = $self->{_args}{reject}; return $self->return_env_message() if $reject && $reject eq 'connect'; } return DECLINED if $self->is_immune(); return DECLINED if $self->is_set_rblsmtpd(); return DECLINED if $self->ip_whitelisted(); my $dnsbl_zones = $self->get_dnsbl_zones() or return DECLINED; my $resolv = $self->get_resolver() or return DECLINED; for my $dnsbl (keys %$dnsbl_zones) { my $query = $self->get_query($dnsbl) or do { if ($resolv->errorstring ne 'NXDOMAIN') { $self->log(LOGERROR, "$dnsbl query failed: ", $resolv->errorstring); } next; }; my $a_record = 0; my $result; foreach my $rr ($query->answer) { if ($rr->type eq 'A') { $result = $rr->name; $self->log(LOGDEBUG, "found A for $result with IP " . $rr->address); } elsif ($rr->type eq 'TXT') { $self->log(LOGDEBUG, "found TXT, " . $rr->txtdata); $result = $rr->txtdata; } next if !$result; $self->adjust_karma(-1); if (!$dnsbl) { ($dnsbl) = ($result =~ m/(?:\d+\.){4}(.*)/); } if (!$dnsbl) { $dnsbl = $result; } if ($a_record) { if (defined $dnsbl_zones->{$dnsbl}) { my $smtp_msg = $dnsbl_zones->{$dnsbl}; my $remote_ip = $self->qp->connection->remote_ip; $smtp_msg =~ s/%IP%/$remote_ip/g; return $self->get_reject($smtp_msg, $dnsbl); } return $self->get_reject("Blocked by $dnsbl"); } return $self->get_reject($result, $dnsbl); } } $self->log(LOGINFO, 'pass'); return DECLINED; } sub get_dnsbl_zones { my $self = shift; my %dnsbl_zones = map { (split /:/, $_, 2)[0, 1] } $self->qp->config('dnsbl_zones'); if (!%dnsbl_zones) { $self->log(LOGDEBUG, "skip, no zones"); return; } $self->{_dnsbl}{zones} = \%dnsbl_zones; return \%dnsbl_zones; } sub get_query { my ($self, $dnsbl) = @_; my $remote_ip = $self->qp->connection->remote_ip; my $reversed_ip = join('.', reverse(split(/\./, $remote_ip))); # fix to find A records, if the dnsbl_zones line has a second field 20/1/04 ++msp if (defined $self->{_dnsbl}{zones}{$dnsbl}) { $self->log(LOGDEBUG, "Checking $reversed_ip.$dnsbl for A record"); return $self->{_resolver}->query("$reversed_ip.$dnsbl"); } $self->log(LOGDEBUG, "Checking $reversed_ip.$dnsbl for TXT record"); return $self->{_resolver}->query("$reversed_ip.$dnsbl", 'TXT'); } sub is_set_rblsmtpd { my $self = shift; my $remote_ip = $self->qp->connection->remote_ip; if (!defined $ENV{'RBLSMTPD'}) { $self->log(LOGDEBUG, "RBLSMTPD not set for $remote_ip"); return; } if ($ENV{'RBLSMTPD'} ne '') { $self->log(LOGINFO, "RBLSMTPD=\"$ENV{'RBLSMTPD'}\" for $remote_ip"); return $ENV{'RBLSMTPD'}; } $self->log(LOGINFO, "RBLSMTPD set, but empty for $remote_ip"); return 1; # don't return empty string, it evaluates to false } sub ip_whitelisted { my ($self) = @_; my $remote_ip = $self->qp->connection->remote_ip; return grep { s/\.?$/./; $_ eq substr($remote_ip . '.', 0, length $_) } $self->qp->config('dnsbl_allow'); } sub return_env_message { my $self = shift; my $result = $ENV{'RBLSMTPD'}; my $remote_ip = $self->qp->connection->remote_ip; $result =~ s/%IP%/$remote_ip/g; my $msg = $self->qp->config('dnsbl_rejectmsg'); $self->log(LOGINFO, "fail, $msg"); return ($self->get_reject_type(), join(' ', $msg, $result)); } sub hook_rcpt { my ($self, $transaction, $rcpt, %param) = @_; if ($rcpt->user =~ /^(?:postmaster|abuse|mailer-daemon|root)$/i) { $self->log(LOGWARN, "skip, don't blacklist special account: " . $rcpt->user); # clear the naughty connection note here, if desired. $self->is_naughty(0); } return DECLINED; } sub get_resolver { my $self = shift; return $self->{_resolver} if $self->{_resolver}; $self->log(LOGDEBUG, "initializing Net::DNS::Resolver"); $self->{_resolver} = Net::DNS::Resolver->new(dnsrch => 0); my $timeout = $self->{_args}{timeout} || 30; $self->{_resolver}->tcp_timeout($timeout); $self->{_resolver}->udp_timeout($timeout); return $self->{_resolver}; } qpsmtpd-0.94/plugins/domainkeys000066400000000000000000000106661240247602400167170ustar00rootroot00000000000000#!perl -w =head1 NAME domainkeys: validate a DomainKeys signature on an incoming mail =head1 SYNOPSIS domainkeys [reject 1] Performs a DomainKeys validation on the message. =head1 DEPRECATION You should probably NOT be using this plugin. DomainKeys has been deprecated in favor of DKIM. That being said, it's March 2013 and I'm still seeing ham arrive with DomainKeys signatures. =head1 CONFIGURATION =head2 reject reject 1 Reject is a boolean that toggles message rejection on or off. Messages failing DomainKeys validation are rejected by default. =head2 reject_type reject_type [ temp | perm ] The default rejection type is permanent. =head2 warn_only A deprecated option that disables message rejection. See reject instead. =head1 COPYRIGHT Copyright (C) 2005-2006 John Peacock. Portions Copyright (C) 2004 Anthony D. Urso. All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =head1 AUTHORS Matt Simerson - 2013 - save results to Authentication-Results header instead of DomainKey-Status Matt Simerson - 2012 - refactored, added tests, safe loading John Peacock - 2005-2006 Anthony D. Urso. - 2004 =cut use strict; use warnings; use Qpsmtpd::Constants; sub init { my ($self, $qp, %args) = @_; foreach my $key (%args) { $self->{$key} = $args{$key}; } $self->{reject} = 1 if !defined $self->{reject}; # default reject $self->{reject_type} = 'perm' if !defined $self->{reject_type}; if ($args{'warn_only'}) { $self->log(LOGNOTICE, "warn_only is deprecated. Use reject instead"); $self->{'reject'} = 0; } } sub register { my $self = shift; for my $m (qw/ Mail::DomainKeys::Message Mail::DomainKeys::Policy /) { eval "use $m"; if ($@) { warn "skip: plugin disabled, could not load $m\n"; $self->log(LOGERROR, "skip: plugin disabled, is $m installed?"); return; } } $self->register_hook('data_post', 'data_post_handler'); } sub data_post_handler { my ($self, $transaction) = @_; return DECLINED if $self->is_immune(); if (!$transaction->header->get('DomainKey-Signature')) { $self->log(LOGINFO, "skip, unsigned"); return DECLINED; } my $body = $self->assemble_body($transaction); my $message = load Mail::DomainKeys::Message( HeadString => $transaction->header->as_string, BodyReference => $body) or do { $self->log(LOGWARN, "skip, unable to load message"), return DECLINED; }; # no sender domain means no verification if (!$message->senderdomain) { $self->log(LOGINFO, "skip, failed to parse sender domain"), return DECLINED; } my $status = $self->get_message_status($message); if (defined $status) { #$transaction->header->add("DomainKey-Status", $status, 0); $self->store_auth_results('domainkey=' . $status); $self->log(LOGINFO, "pass, $status"); return DECLINED; } $self->log(LOGERROR, "fail, signature invalid"); return DECLINED if !$self->{reject}; my $deny = $self->{reject_type} eq 'temp' ? DENYSOFT : DENY; return ($deny, "DomainKeys signature validation failed"); } sub get_message_status { my ($self, $message) = @_; if ($message->testing) { return "testing"; # key testing, don't do anything else } if ($message->signed && $message->verify) { return $message->signature->status; # verified: add good header } # not signed or not verified my $policy = fetch Mail::DomainKeys::Policy(Protocol => 'dns', Domain => $message->senderdomain); if (!$policy) { return $message->signed ? "non-participant" : "no signature"; } if ($policy->testing) { return "testing"; # Don't do anything else } if ($policy->signall) { return undef; # policy requires all mail to be signed } # $policy->signsome return "no signature"; # not signed and domain doesn't sign all } sub assemble_body { my ($self, $transaction) = @_; $transaction->body_resetpos; $transaction->body_getline; # \r\n seperator is NOT part of the body my @body; while (my $line = $transaction->body_getline) { push @body, $line; } return \@body; } qpsmtpd-0.94/plugins/dont_require_anglebrackets000066400000000000000000000016531240247602400221350ustar00rootroot00000000000000#!perl -w =head1 NAME dont_require_anglebrackets =head1 SYNOPSIS accept addresses in MAIL FROM:/RCPT TO: commands without surrounding <> =head1 DESCRIPTION RFC821 requires that email addresses presented during the SMTP conversation be enclosed in angle brackets. Like this: MAIL FROM: This plugin relaxes that requirement, accepting messages in this format: MAIL FROM:user@example.com =cut sub hook_mail_pre { my ($self, $transaction, $addr) = @_; unless ($addr =~ /^<.*>$/) { $addr = '<' . $addr . '>'; $self->adjust_karma(-2); $self->log(LOGINFO, "fail, added MAIL angle brackets"); } return (OK, $addr); } sub hook_rcpt_pre { my ($self, $transaction, $addr) = @_; unless ($addr =~ /^<.*>$/) { $addr = '<' . $addr . '>'; $self->adjust_karma(-2); $self->log(LOGINFO, "fail, added RCPT angle brackets"); } return (OK, $addr); } qpsmtpd-0.94/plugins/dspam000066400000000000000000000476221240247602400156620ustar00rootroot00000000000000#!perl -w =head1 NAME dspam - dspam integration for qpsmtpd =head1 DESCRIPTION Uses dspam to classify messages. Use B, B, and B to train dspam. Adds the X-DSPAM-Result and X-DSPAM-Signature headers to messages. The latter is essential for training dspam and the former is useful to MDAs, MUAs, and humans. Adds a transaction note to the qpsmtpd transaction. The note is a hashref with at least the 'class' field (Spam,Innocent,Whitelisted). It will normally contain a probability and confidence rating. =head1 TRAINING DSPAM If you enable dspam rejection without training first, you will lose valid mail. The dspam false positive rate is high when untrained. The good news is; dspam learns very, very fast. The best method way to train dspam is to feed it two large equal sized corpuses of spam and ham from your mail server. The dspam authors suggest avoiding public corpuses. I train dspam as follows: =over 4 =item learn from SpamAssassin See the SPAMASSASSIN section. =item periodic training I have a script that searches the contents of every users maildir. Any read messages that have changed since the last processing run are learned as ham or spam. The ham message list consists of read messages in any folder not named like Spam, Junk, Trash, or Deleted. This catches messages that users have read and left in their inbox or filed away into subfolders. =item on-the-fly training The dovecot IMAP server has an antispam plugin that will train dspam when messages are moved to/from the Spam folder. =back =head1 CONFIG =head2 dspam_bin The path to the dspam binary. If yours is installed somewhere other than /usr/local/bin/dspam, set this. =head2 autolearn [ naughty | karma | spamassassin | any ] =over 4 =item naughty learn naughty messages as spam (see plugins/naughty) =item karma learn messages with negative karma as spam (see plugins/karma) =item spamassassin learn from spamassassins messages with autolearn=(ham|spam). See SPAMASSASSIN. =item any all of the above, and any future tests too! =back =head2 reject Set to a floating point value between 0 and 1.00 where 0 is no confidence and 1.0 is 100% confidence. If dspam's confidence is greater than or equal to this threshold, the message will be rejected. The default is 1.00. dspam reject .95 To only reject mail if dspam and spamassassin both think the message is spam, set I. =head2 reject_type reject_type [ perm | temp | disconnect ] By default, rejects are permanent (5xx). Set I to defer mail instead of rejecting it. Set I if you'd prefer to immediately disconnect the connection when a spam is encountered. This prevents the remote server from issuing a reset and attempting numerous times in a single connection. =head1 dspam.conf dspam must be configured and working properly. I had to modify the following settings on my system: =over 4 =item mysql storage =item Trust smtpd =item TrainingMode tum =item Tokenizer osb =item Preference "trainingMode=TOE" =item Preference "spamAction=deliver" =item Preference "signatureLocation=headers" =item TrainPristine off =item ParseToHeaders off =back Of those changes, the most important is the signature location. This plugin only supports storing the signature in the headers. If you want to train dspam after delivery (ie, users moving messages to/from spam folders), then the dspam signature must be in the headers. When using the dspam MySQL backend, use InnoDB tables. DSPAM training is dramatically slowed by MyISAM table locks and dspam requires a lot of training. InnoDB has row level locking and updates are much faster. =head1 DSPAM periodic maintenance Install this cron job to clean up your DSPAM database. http://dspam.git.sourceforge.net/git/gitweb.cgi?p=dspam/dspam;a=tree;f=contrib/dspam_maintenance;hb=HEAD =head1 SPAMASSASSIN DSPAM can be trained by SpamAssassin. This relationship between them requires attention to several important details: =over 4 =item 1 dspam must be listed B spamassassin in the config/plugins file. Because SA runs first, I set the SA reject_threshold up above 100 so that all spam messages will be used to train dspam. Once dspam is trained and errors are rare, I plan to run dspam first and reduce the SA load. =item 2 For I to work, autolearn must be enabled and configured in SpamAssassin. SA autolearn will determine if a message is learned by dspam. The settings to pay careful attention to in your SA local.cf file are I and I. Make sure they are set to conservative values that will yield no false positives. If you are using I and I, messages that exceed the SA threshholds will cause dspam to reject them. Again I say, make sure the SA autolearn threshholds are set high enough to avoid false positives. =back =head1 MULTIPLE RECIPIENT BEHAVIOR For messages with multiple recipients, the user that dspam is running as will be the dspam username. When messages have a single recipient, the recipient address is used as the dspam username. For dspam to trust qpsmtpd with modifying the username, you B add the username that qpsmtpd is running to to the dspamd.conf file. ie, (Trust smtpd). =head1 CHANGES 2012-06 - Matt Simerson - added karma & naughty learning support - worked around the DESTROY bug in dspam_process =head1 AUTHOR 2012 - Matt Simerson =cut use strict; use warnings; use lib 'lib'; use Qpsmtpd::Constants; use Qpsmtpd::DSN; use IO::Handle; use Socket qw(:DEFAULT :crlf); sub register { my $self = shift; my $qp = shift; $self->log(LOGERROR, "Bad parameters for the dspam plugin") if @_ % 2; $self->{_args} = {@_}; $self->{_args}{reject} = 1 if !defined $self->{_args}{reject}; $self->{_args}{reject_type} ||= 'perm'; $self->{_args}{dspam_bin} ||= '/usr/local/bin/dspam'; $self->get_dspam_bin() or return DECLINED; $self->register_hook('data_post', 'data_post_handler'); } sub get_dspam_bin { my $self = shift; my $bin = $self->{_args}{dspam_bin}; if (!-e $bin) { $self->log(LOGERROR, "error, dspam CLI binary not found: install dspam and/or set dspam_bin" ); return; } if (!-x $bin) { $self->log(LOGERROR, "error, no permission to run $bin"); return; } return $bin; } sub data_post_handler { my $self = shift; my $transaction = shift || $self->qp->transaction; return (DECLINED) if $self->is_immune(); if ($transaction->data_size > 500_000) { $self->log(LOGINFO, "skip, too big (" . $transaction->data_size . ")"); return (DECLINED); } my $user = $self->select_username($transaction); my $bin = $self->{_args}{dspam_bin}; my $filtercmd = "$bin --user $user --mode=tum --process --deliver=summary --stdout"; $self->log(LOGDEBUG, $filtercmd); my $response = $self->dspam_process($filtercmd, $transaction); if (!$response->{result}) { $self->log(LOGWARN, "error, no dspam response. Check logs for errors."); return (DECLINED); } $transaction->notes('dspam', $response); $self->attach_headers($response, $transaction); $self->autolearn($response, $transaction); return $self->log_and_return($transaction); } sub select_username { my ($self, $transaction) = @_; my $recipient_count = scalar $transaction->recipients; $self->log(LOGDEBUG, "Message has $recipient_count recipients"); if ($recipient_count > 1) { $self->log(LOGINFO, "multiple recipients ($recipient_count), ignoring user prefs"); return getpwuid($>); } # use the recipients email address as username. This enables user prefs my $username = ($transaction->recipients)[0]->address; return lc($username); } sub assemble_message { my ($self, $transaction) = @_; my $message = "X-Envelope-From: " . $transaction->sender->format . "\n" . $transaction->header->as_string . "\n\n"; $transaction->body_resetpos; while (my $line = $transaction->body_getline) { $message .= $line; } $message = join(CRLF, split /\n/, $message); return $message . CRLF; } sub parse_response { my $self = shift; my $response = shift or do { $self->log(LOGDEBUG, "missing dspam response!"); return; }; # example DSPAM results: # user@example.com; result="Spam"; class="Spam"; probability=1.0000; confidence=1.00; signature=N/A # smtpd; result="Innocent"; class="Innocent"; probability=0.0023; confidence=1.00; signature=4f8dae6a446008399211546 #return $self->parse_response_regexp( $response ); # probably slower my ($user, $result, $class, $prob, $conf, $sig) = split /; /, $response; (undef, $result) = split /=/, $result; (undef, $class) = split /=/, $class; (undef, $prob) = split /=/, $prob; (undef, $conf) = split /=/, $conf; (undef, $sig) = split /=/, $sig; $result = substr($result, 1, -1); # strip off quotes $class = substr($class, 1, -1); return { class => $class, result => $result, probability => $prob, confidence => $conf, signature => $sig, }; } sub parse_response_regexp { my ($self, $response) = @_; my ($result, $class, $prob, $conf, $sig) = $response =~ / result=\"(Spam|Innocent)\";\s class=\"(Spam|Innocent)\";\s probability=([\d\.]+);\s confidence=([\d\.]+);\s signature=(.*) /x; return { class => $class, result => $result, probability => $prob, confidence => $conf, signature => $sig, }; } sub dspam_process { my ($self, $filtercmd, $transaction) = @_; my $response = $self->dspam_process_backticks($filtercmd); #my $response = $self->dspam_process_open2( $filtercmd, $transaction ); #my $response = $self->dspam_process_fork( $filtercmd ); return $self->parse_response($response); } sub dspam_process_fork { my ($self, $filtercmd, $transaction) = @_; # yucky. This method (which forks) exercises a bug in qpsmtpd. When the # child exits, the Transaction::DESTROY method is called, which deletes # the spooled file from disk. The contents of $self->qp->transaction # needed to spool it again are also destroyed. Don't use this. my $message = $self->assemble_message($transaction); my $in_fh; if (!open($in_fh, '-|')) { # forks child for writing open(my $out_fh, "|$filtercmd") or die "Can't run $filtercmd: $!\n"; print $out_fh $message; close $out_fh; exit(0); } my $response = <$in_fh>; close $in_fh; chomp $response; $self->log(LOGDEBUG, $response); return $response; } sub dspam_process_backticks { my ($self, $filtercmd) = @_; my $transaction = $self->qp->transaction; my $message = $self->temp_file(); open my $fh, '>', $message; print $fh "X-Envelope-From: " . $transaction->sender->format . CRLF . $transaction->header->as_string . CRLF . CRLF; $transaction->body_resetpos; while (my $line = $transaction->body_getline) { print $fh $line; } close $fh; my ($line1) = split /[\r|\n]/, `$filtercmd < $message`; $self->log(LOGDEBUG, $line1); return $line1; } sub dspam_process_open2 { my ($self, $filtercmd, $transaction) = @_; my $message = $self->assemble_message($transaction); # not sure why, but this is not as reliable as I'd like. What's a dspam # error -5 mean anyway? use FileHandle; use IPC::Open3; my ($read, $write, $err); use Symbol 'gensym'; $err = gensym; my $pid = open3($write, $read, $err, $filtercmd); print $write $message; close $write; #my $response = join('', <$dspam_out>); # get full response my $response = <$read>; # get first line only waitpid $pid, 0; my $child_exit_status = $? >> 8; #$self->log(LOGINFO, "exit status: $child_exit_status"); if ($response) { chomp $response; $self->log(LOGDEBUG, $response); } my $err_msg = <$err>; if ($err_msg) { $self->log(LOGDEBUG, $err_msg); } return $response; } sub log_and_return { my $self = shift; my $transaction = shift || $self->qp->transaction; my $d = $self->get_dspam_results($transaction) or return DECLINED; if (!$d->{class}) { $self->log(LOGWARN, "skip, no dspam class detected"); return DECLINED; } my $status = "$d->{class}, $d->{confidence} c."; my $reject = $self->{_args}{reject} or do { $self->log(LOGINFO, "skip, reject disabled ($status)"); return DECLINED; }; if ($reject eq 'agree') { return $self->reject_agree($transaction); } if ($d->{class} eq 'Innocent') { $self->log(LOGINFO, "pass, $status"); return DECLINED; } if ($self->qp->connection->relay_client) { $self->log(LOGINFO, "skip, allowing spam, user authenticated ($status)"); return DECLINED; } if ($d->{probability} <= $reject) { $self->log(LOGINFO, "pass, $d->{class} probability is too low ($d->{probability} < $reject)" ); return DECLINED; } if ($d->{confidence} != 1) { $self->log(LOGINFO, "pass, $d->{class} confidence is too low ($d->{confidence})"); return DECLINED; } # dspam is more than $reject percent sure this message is spam $self->log(LOGINFO, "fail, $d->{class}, ($d->{confidence} confident)"); my $deny = $self->get_reject_type(); return Qpsmtpd::DSN->media_unsupported($deny, 'dspam says, no spam please'); } sub reject_agree { my ($self, $transaction) = @_; my $sa = $transaction->notes('spamassassin'); my $d = $transaction->notes('dspam'); my $status = "$d->{class}, $d->{confidence} c"; if (!$sa->{is_spam}) { $self->log(LOGINFO, "pass, cannot agree, SA results missing ($status)"); return DECLINED; } if ($d->{class} eq 'Spam') { if ($sa->{is_spam} eq 'Yes') { $self->adjust_karma(-2); $self->log(LOGINFO, "fail, agree, $status"); my $reject = $self->get_reject_type(); return ($reject, 'we agree, no spam please'); } $self->log(LOGINFO, "fail, disagree, $status"); return DECLINED; } if ($d->{class} eq 'Innocent') { if ($sa->{is_spam} eq 'No') { if ($d->{confidence} > .9) { $self->adjust_karma(1); } $self->log(LOGINFO, "pass, agree, $status"); return DECLINED; } $self->log(LOGINFO, "pass, disagree, $status"); return DECLINED; } $self->log(LOGINFO, "pass, other $status"); return DECLINED; } sub get_dspam_results { my $self = shift; my $transaction = shift || $self->qp->transaction; if ($transaction->notes('dspam')) { return $transaction->notes('dspam'); } my $string = $transaction->header->get('X-DSPAM-Result') or do { $self->log(LOGWARN, "get_dspam_results: failed to find the header"); return; }; my @bits = split /,\s+/, $string; chomp @bits; my $class = shift @bits; my %d; foreach (@bits) { my ($key, $val) = split /=/, $_; $d{$key} = $val; } $d{class} = $class; my $message = $d{class}; if (defined $d{probability} && defined $d{confidence}) { $message .= ", prob: $d{probability}, conf: $d{confidence}"; } $self->log(LOGDEBUG, $message); $transaction->notes('dspam', \%d); return \%d; } sub attach_headers { my ($self, $r, $transaction) = @_; $transaction ||= $self->qp->transaction; my $header_str = "$r->{result}, probability=$r->{probability}, confidence=$r->{confidence}"; $self->log(LOGDEBUG, $header_str); my $name = 'X-DSPAM-Result'; $transaction->header->delete($name) if $transaction->header->get($name); $transaction->header->add($name, $header_str, 0); # the signature header is required if you intend to train dspam later. # In dspam.conf, set: Preference "signatureLocation=headers" $transaction->header->add('X-DSPAM-Signature', $r->{signature}, 0); } sub train_error_as_ham { my $self = shift; my $transaction = shift; my $user = $self->select_username($transaction); my $dspam_bin = $self->{_args}{dspam_bin} || '/usr/local/bin/dspam'; my $cmd = "$dspam_bin --user $user --mode=toe --source=error --class=innocent --deliver=summary --stdout"; $self->dspam_process($cmd, $transaction); return; } sub train_error_as_spam { my $self = shift; my $transaction = shift; my $user = $self->select_username($transaction); my $dspam_bin = $self->{_args}{dspam_bin} || '/usr/local/bin/dspam'; my $cmd = "$dspam_bin --user $user --mode=toe --source=error --class=spam --deliver=summary --stdout"; $self->dspam_process($cmd, $transaction); return; } sub autolearn { my ($self, $response, $transaction) = @_; defined $self->{_args}{autolearn} or return; if ( $self->{_args}{autolearn} ne 'any' && $self->{_args}{autolearn} ne 'karma' && $self->{_args}{autolearn} ne 'naughty' && $self->{_args}{autolearn} ne 'spamassassin') { $self->log(LOGERROR, "bad autolearn setting! Read 'perldoc plugins/dspam' again!"); return; } # only train once. $self->autolearn_naughty($response, $transaction) and return; $self->autolearn_karma($response, $transaction) and return; $self->autolearn_spamassassin($response, $transaction) and return; return; } sub autolearn_naughty { my ($self, $response, $transaction) = @_; my $learn = $self->{_args}{autolearn} or return; if ($learn ne 'naughty' && $learn ne 'any') { $self->log(LOGDEBUG, "skipping naughty autolearn"); return; } if ( $self->is_naughty() && $response->{result} eq 'Innocent') { $self->log(LOGINFO, "training naughty FN message as spam"); $self->train_error_as_spam($transaction); return 1; } $self->log(LOGDEBUG, "falling through naughty autolearn"); return; } sub autolearn_karma { my ($self, $response, $transaction) = @_; my $learn = $self->{_args}{autolearn} or return; return if ($learn ne 'karma' && $learn ne 'any'); my $karma = $self->connection->notes('karma'); return if !defined $karma; if ($karma < -2 && $response->{result} eq 'Innocent') { $self->log(LOGINFO, "training bad karma ($karma) FN as spam"); $self->train_error_as_spam($transaction); return 1; } if ($karma > 2 && $response->{result} eq 'Spam') { $self->log(LOGINFO, "training good karma ($karma) FP as ham"); $self->train_error_as_ham($transaction); return 1; } return; } sub autolearn_spamassassin { my ($self, $response, $transaction) = @_; my $learn = $self->{_args}{autolearn} or return; return if ($learn ne 'spamassassin' && $learn ne 'any'); my $sa = $transaction->notes('spamassassin'); if (!$sa || !$sa->{is_spam}) { if (!$self->is_naughty()) { $self->log(LOGERROR, "SA results missing"); # SA skips naughty } return; } if (!$sa->{autolearn}) { $self->log(LOGERROR, "SA autolearn unset"); return; } if ( $sa->{is_spam} eq 'Yes' && $sa->{autolearn} eq 'spam' && $response->{result} eq 'Innocent') { $self->log(LOGINFO, "training SA FN as spam"); $self->train_error_as_spam($transaction); return 1; }; if ( $sa->{is_spam} eq 'No' && $sa->{autolearn} eq 'ham' && $response->{result} eq 'Spam') { $self->log(LOGINFO, "training SA FP as ham"); $self->train_error_as_ham($transaction); return 1; } return; } qpsmtpd-0.94/plugins/earlytalker000066400000000000000000000153421240247602400170670ustar00rootroot00000000000000#!perl -w =head1 NAME earlytalker - Check that the client doesn't talk before we send the SMTP banner =head1 DESCRIPTION Checks to see if the remote host starts talking before we've issued a 2xx greeting. If so, we're likely looking at a direct-to-MX spam agent which pipelines its entire SMTP conversation, and will happily dump an entire spam into our mail log even if later tests deny acceptance. Depending on configuration, clients which behave in this way are either immediately disconnected with a deny or denysoft code, or else are issued this on all mail/rcpt commands in the transaction. =head1 CONFIGURATION =head2 wait [integer] The number of seconds to delay the initial greeting to see if the connecting host speaks first. The default is 1. Do not select a value that is too high, or you may be unable to receive mail from MTAs with short SMTP connect or greeting timeouts -- these are known to range as low as 30 seconds, and may in some cases be configured lower by mailserver admins. Network transit time must also be allowed for. =head2 reject Do we reject/deny connections to early talkers? earlytalker reject [ 0 | 1 ] Default: I =head2 reject_type [ temp | perm ] What type of rejection to send. A temporary rejection tells the remote server to try again later. A permanent error tells it to give up permanently. Default I. =head2 defer-reject [boolean] When an early-talker is detected, if this option is set to a true value, the SMTP greeting will be issued as usual, but all RCPT/MAIL commands will be issued a deny or denysoft (depending on the value of I). The default is to react at the SMTP greeting stage by issuing the apropriate response code and terminating the SMTP connection. earlytalker defer-reject [ 0 | 1 ] =head2 check-at [ CONNECT | DATA ] Specifies when to check for early talkers. You can specify this option multiple times to check more than once. The default is I only. =head2 loglevel Adjust the quantity of logging for this plugin. See docs/logging.pod =cut use strict; use warnings; use IO::Select; use Qpsmtpd::Constants; sub register { my ($self, $qp, @args) = @_; if (@args % 2) { $self->log(LOGERROR, "Unrecognized/mismatched arguments"); return; } my %check_at; for (0 .. $#args) { next if $_ % 2; if (lc($args[$_]) eq 'check-at') { my $val = $args[$_ + 1]; $check_at{uc($val)}++; } } if (!%check_at) { $check_at{CONNECT} = 1; } $self->{_args} = { 'wait' => 1, @args, 'check-at' => \%check_at, }; # backwards compat with old 'action' argument if (defined $self->{_args}{action} && !defined $self->{_args}{reject}) { $self->{_args}{reject} = $self->{_args}{action} =~ /^deny/i ? 1 : 0; } if (defined $self->{_args}{'defer-reject'} && !defined $self->{_args}{reject_type}) { $self->{_args}{reject_type} = $self->{_args}{action} == 'denysoft' ? 'temp' : 'perm'; } if (!defined $self->{_args}{reject_type}) { $self->{_args}{reject_type} = 'perm'; } # /end compat if ($qp->{conn} && $qp->{conn}->isa('Apache2::Connection')) { require APR::Const; APR::Const->import(qw(POLLIN SUCCESS)); $self->register_hook('connect', 'apr_connect_handler'); $self->register_hook('data', 'apr_data_handler'); } else { $self->register_hook('connect', 'connect_handler'); $self->register_hook('data', 'data_handler'); } $self->register_hook('mail', 'mail_handler') if $self->{_args}{'defer-reject'}; $self->{_args}{reject} = 1 if !defined $self->{_args}{reject}; } sub apr_connect_handler { my ($self, $transaction) = @_; return DECLINED unless $self->{_args}{'check-at'}{CONNECT}; return DECLINED if $self->is_immune(); my $c = $self->qp->{conn} or return DECLINED; my $socket = $c->client_socket or return DECLINED; my $timeout = $self->{_args}{'wait'} * 1_000_000; my $rc = $socket->poll($c->pool, $timeout, APR::Const::POLLIN()); if ($rc == APR::Const::SUCCESS()) { if ($self->{_args}{'defer-reject'}) { $self->connection->notes('earlytalker', 1); return DECLINED; } return $self->log_and_deny(); } return $self->log_and_pass(); } sub apr_data_handler { my ($self, $transaction) = @_; return DECLINED unless $self->{_args}{'check-at'}{DATA}; return DECLINED if $self->is_immune(); my $c = $self->qp->{conn} or return DECLINED; my $socket = $c->client_socket or return DECLINED; my $timeout = $self->{_args}{'wait'} * 1_000_000; my $rc = $socket->poll($c->pool, $timeout, APR::Const::POLLIN()); if ($rc == APR::Const::SUCCESS()) { return $self->log_and_deny(); } return $self->log_and_pass(); } sub connect_handler { my ($self, $transaction) = @_; my $in = new IO::Select; return DECLINED unless $self->{_args}{'check-at'}{CONNECT}; return DECLINED if $self->is_immune(); # senders with good karma skip the delay my $karma = $self->connection->notes('karma_history'); if (defined $karma && $karma > 5) { $self->log(LOGINFO, "skip, karma $karma"); return DECLINED; } $in->add(\*STDIN) or return DECLINED; if (!$in->can_read($self->{_args}{'wait'})) { return $self->log_and_pass(); } if (!$self->{_args}{'defer-reject'}) { return $self->log_and_deny(); } $self->connection->notes('earlytalker', 1); $self->adjust_karma(-1); return DECLINED; } sub data_handler { my ($self, $transaction) = @_; my $in = new IO::Select; return DECLINED unless $self->{_args}{'check-at'}{DATA}; return DECLINED if $self->is_immune(); $in->add(\*STDIN) or return DECLINED; if (!$in->can_read($self->{_args}{'wait'})) { return $self->log_and_pass(); } return $self->log_and_deny(); } sub log_and_pass { my $self = shift; my $ip = $self->qp->connection->remote_ip || 'remote host'; $self->log(LOGINFO, "pass, not spontaneous"); return DECLINED; } sub log_and_deny { my $self = shift; my $ip = $self->qp->connection->remote_ip || 'remote host'; $self->connection->notes('earlytalker', 1); $self->adjust_karma(-1); my $log_mess = "remote started talking before we said hello"; my $smtp_msg = 'Connecting host started transmitting before SMTP greeting'; return $self->get_reject($smtp_msg, $log_mess); } sub mail_handler { my ($self, $transaction) = @_; return DECLINED unless $self->connection->notes('earlytalker'); return $self->log_and_deny(); } qpsmtpd-0.94/plugins/fcrdns000066400000000000000000000215301240247602400160230ustar00rootroot00000000000000#!perl -w =head1 NAME Forward Confirmed RDNS - http://en.wikipedia.org/wiki/FCrDNS =head1 DESCRIPTION Determine if the SMTP sender has matching forward and reverse DNS. Sets the connection note fcrdns. =head1 WHY IT WORKS The reverse DNS of zombie PCs is out of the spam operators control. Their only way to pass this test is to limit themselves to hosts with matching forward and reverse DNS. At present, this presents a significant hurdle. =head1 VALIDATION TESTS =over 4 =item has_reverse_dns Determine if the senders IP address resolves to a hostname. =item has_forward_dns If the remote IP has a PTR hostname(s), see if that host has an A or AAAA. If so, see if any of the host IPs (A or AAAA records) match the remote IP. Since the dawn of SMTP, having matching DNS has been a standard expected and oft required of mail servers. While requiring matching DNS is prudent, requiring an exact match will reject valid email. This often hinders the use of FcRDNS. While testing this plugin, I noticed that mx0.slc.paypal.com sends mail from an IP that reverses to mx1.slc.paypal.com. While that's technically an error, so too would rejecting that connection. To avoid false positives, matches are extended to the first 3 octets of the IP and the last two labels of the FQDN. The following are considered a match: 192.0.1.2, 192.0.1.3 foo.example.com, bar.example.com This allows FcRDNS to be used without rejecting mail from orgs with pools of servers where the HELO name and IP don't exactly match. This list includes Yahoo, Gmail, PayPal, cheaptickets.com, exchange.microsoft.com, etc. =back =head1 CONFIGURATION =head2 timeout [seconds] Default: 5 The number of seconds before DNS queries timeout. =head2 reject [ 0 | 1 | naughty ] Default: 1 0: do not reject 1: reject naughty: naughty plugin handles rejection =head2 reject_type [ temp | perm | disconnect ] Default: disconnect What type of rejection should be sent? See docs/config.pod =head2 loglevel Adjust the quantity of logging for this plugin. See docs/logging.pod =head1 RFC 1912, RFC 5451 From Wikipedia summary: 1. First a reverse DNS lookup (PTR query) is performed on the IP address, which returns a list of zero or more PTR records. (has_reverse_dns) 2. For each domain name returned in the PTR query results, a regular 'forward' DNS lookup (type A or AAAA query) is then performed on that domain name. (has_forward_dns) 3. Any A or AAAA record returned by the second query is then compared against the original IP address (check_ip_match), and if there is a match, then the FCrDNS check passes. =head1 iprev # https://www.ietf.org/rfc/rfc5451.txt 2.4.3. "iprev" Results The result values are used by the "iprev" method, defined in Section 3, are as follows: pass: The DNS evaluation succeeded, i.e., the "reverse" and "forward" lookup results were returned and were in agreement. fail: The DNS evaluation failed. In particular, the "reverse" and "forward" lookups each produced results but they were not in agreement, or the "forward" query completed but produced no result, e.g., a DNS RCODE of 3, commonly known as NXDOMAIN, or an RCODE of 0 (NOERROR) in a reply containing no answers, was returned. temperror: The DNS evaluation could not be completed due to some error that is likely transient in nature, such as a temporary DNS error, e.g., a DNS RCODE of 2, commonly known as SERVFAIL, or other error condition resulted. A later attempt may produce a final result. permerror: The DNS evaluation could not be completed because no PTR data are published for the connecting IP address, e.g., a DNS RCODE of 3, commonly known as NXDOMAIN, or an RCODE of 0 (NOERROR) in a reply containing no answers, was returned. This prevented completion of the evaluation. =head1 AUTHOR 2013 - Matt Simerson =cut use strict; use warnings; use Qpsmtpd::Constants; sub register { my ($self, $qp) = (shift, shift); $self->{_args} = {@_}; $self->{_args}{reject_type} = 'temp'; $self->{_args}{timeout} ||= 5; $self->{_args}{ptr_hosts} = {}; if (!defined $self->{_args}{reject}) { $self->{_args}{reject} = 0; } $self->init_resolver() or return; $self->register_hook('connect', 'connect_handler'); } sub connect_handler { my ($self) = @_; return DECLINED if $self->is_immune(); # run a couple cheap tests before the more expensive DNS tests foreach my $test (qw/ invalid_localhost is_not_fqdn /) { $self->$test() or return DECLINED; } $self->has_reverse_dns() or return DECLINED; $self->has_forward_dns() or return DECLINED; $self->log(LOGINFO, "pass"); return DECLINED; } sub invalid_localhost { my ($self) = @_; return 1 if lc $self->qp->connection->remote_host ne 'localhost'; if ( $self->qp->connection->remote_ip ne '127.0.0.1' && $self->qp->connection->remote_ip ne '::1') { $self->adjust_karma(-1); $self->log(LOGINFO, "fail, not localhost"); return; } $self->adjust_karma(1); $self->log(LOGDEBUG, "pass, is localhost"); return 1; } sub is_not_fqdn { my ($self) = @_; my $host = $self->qp->connection->remote_host or return 1; return 1 if $host eq 'Unknown'; # QP assigns this to a "no DNS result" # Since QP looked it up, perform some quick validation if ($host !~ /\./) { # has no dots $self->adjust_karma(-1); $self->log(LOGINFO, "fail, not FQDN"); return; } if ($host =~ /[^a-zA-Z0-9\-\.]/) { $self->adjust_karma(-1); $self->log(LOGINFO, "fail, invalid FQDN chars"); return; } return 1; } sub has_reverse_dns { my ($self) = @_; my $res = $self->init_resolver(); my $ip = $self->qp->connection->remote_ip; my $query = $res->query($ip, 'PTR') or do { if ($res->errorstring eq 'NXDOMAIN') { $self->adjust_karma(-1); $self->store_auth_results("iprev=permerror"); $self->log(LOGINFO, "fail, no rDNS: " . $res->errorstring); return; } if ( $res->errorstring eq 'SERVFAIL' ) { $self->log(LOGINFO, "fail, error getting rDNS: " . $res->errorstring); $self->store_auth_results("iprev=temperror"); } elsif ( $res->errorstring eq 'NOERROR' ) { $self->log(LOGINFO, "fail, no PTR (NOERROR)" ); $self->store_auth_results("iprev=permerror"); } else { $self->store_auth_results("iprev=fail"); $self->log(LOGINFO, "fail, error getting rDNS: " . $res->errorstring); }; return; }; my $hits = 0; $self->{_args}{ptr_hosts} = {}; # reset hash for my $rr ($query->answer) { next if $rr->type ne 'PTR'; $hits++; $self->{_args}{ptr_hosts}{$rr->ptrdname} = 1; $self->log(LOGDEBUG, "PTR: " . $rr->ptrdname); } if (!$hits) { $self->adjust_karma(-1); $self->log(LOGINFO, "fail, no PTR records"); $self->store_auth_results("iprev=permerror"); return; } $self->log(LOGDEBUG, "has rDNS"); return 1; } sub has_forward_dns { my ($self) = @_; my $res = $self->init_resolver(); foreach my $host (keys %{$self->{_args}{ptr_hosts}}) { $host .= '.' if '.' ne substr($host, -1, 1); # fully qualify name my $query = $res->query($host) or do { if ($res->errorstring eq 'NXDOMAIN') { $self->store_auth_results("iprev=permerror"); $self->log(LOGDEBUG, "host $host does not exist"); next; } $self->store_auth_results("iprev=fail"); $self->log(LOGDEBUG, "query for $host failed (", $res->errorstring, ")"); next; }; my $hits = 0; foreach my $rr ($query->answer) { next unless $rr->type =~ /^(?:A|AAAA)$/; $hits++; $self->check_ip_match($rr->address) and return 1; } if ($hits) { $self->store_auth_results("iprev=fail"); $self->log(LOGDEBUG, "PTR host has forward DNS") if $hits; return 1; } } $self->adjust_karma(-1); $self->store_auth_results("iprev=fail"); $self->log(LOGINFO, "fail, no PTR hosts have forward DNS"); return; } sub check_ip_match { my $self = shift; my $ip = shift or return; if ($ip eq $self->qp->connection->remote_ip) { $self->log(LOGDEBUG, "forward ip match"); $self->store_auth_results("iprev=pass"); $self->adjust_karma(1); return 1; } # TODO: make this IPv6 compatible my $dns_net = join('.', (split(/\./, $ip))[0, 1, 2]); my $rem_net = join('.', (split(/\./, $self->qp->connection->remote_ip))[0, 1, 2]); if ($dns_net eq $rem_net) { $self->log(LOGNOTICE, "forward network match"); $self->store_auth_results("iprev=pass"); return 1; } return; } qpsmtpd-0.94/plugins/greylisting000066400000000000000000000434521240247602400171130ustar00rootroot00000000000000#!perl -w =head1 NAME greylisting - delay mail from unknown senders =head1 DESCRIPTION Plugin implementing the 'greylisting' algorithm proposed by Evan Harris in http://projects.puremagic.com/greylisting/. Greylisting is a form of denysoft filter, where unrecognised new connections are temporarily denied for some initial period, to foil spammers using fire-and-forget spamware, http_proxies, etc. Greylisting tracks incoming connections using a triplet (see TRIPLET). It has configurable timeout periods (black/grey/white) to control whether connections are allowed, instead of using connection counts or rates. Automatic whitelisting is enabled for relayclients, whitelisted hosts, whitelisted senders, TLS connections, p0f matches, and geoip matches. =head1 TRIPLETS In greylisting, I, I, and I are referred to as the triplet that connections are deferred based on. This plugin allows tracking on any or all of the three, using only the IP address by default. A simple dbm database is used for tracking connections. How that works is best explained by example: A new connection arrives from the host shvj1.jpmchase.com. The sender is chase@alerts.chase.com and the recipient is londonwhale@example.com. This is the first connection for that triplet so the connection is deferred for I minutes. After the timeout, but before the I elapses, shvj1.jpmchase.com retries and successfully delivers the mail. For the next I days, emails for that triplet are not delayed. The next day, shvj1.jpmchase.com tries to deliver a new email from alerts@alerts.chase.com to jdimon@example.com. Since this triplet is new, it will be delayed as our initial connection in the last scenario was. This delay could end up costing over US $4B. By default, this plugin does not enable the sender or recipient in the triplet. Once an email from a remote server has been delivered to anyone on our server, that remote server is whitelisted for any sender and any recipient. This is a policy that delays less mail and is less likely to impoverish your bank. =head1 CONFIG The following parameters can be passed to greylisting: =head2 remote_ip Include the remote ip in the connection triplet? Default: 1 =head2 sender Include the sender in the connection triplet? Default: 0. =head2 recipient Include the recipient in the connection triplet? Default: 0. =head2 deny_late Whether to defer denials during the 'mail' hook or later during 'data_post' e.g. to allow per-recipient logging. Default: 0. =head2 black_timeout The initial period during which we issue DENYSOFTs for connections from an unknown (or timed out) 'connection triplet'. Default: 50 minutes. =head2 grey_timeout The subsequent 'grey' period, after the initial black blocking period, when we will accept a delivery from a formerly-unknown connection triplet. If a new connection is received during this time, we will record a successful delivery against this IP address, which whitelists it for future deliveries (see following). Default: 3 hours 20 minutes. =head2 white_timeout The period after which a known connection triplet will be considered stale, and we will issue DENYSOFTs again. New deliveries reset the timestamp on the address and renew this timeout. Default: 36 days. =head2 reject Whether to issue deferrals (DENYSOFT) for black connections. Having reject disabled is useful for seeding the database and testing without impacting deliveries. It is recommended to begin with I for a week or two before enabling I. Default: 1 =head2 db_dir Path to a directory in which the greylisting DB will be stored. This directory must be writable by the qpsmtpd user. By default, the first usable directory from the following list will be used: =over 4 =item /var/lib/qpsmtpd/greylisting =item I/var/db (where BINDIR is the location of the qpsmtpd binary) =item I/config =back =head2 per_recipient Flag to indicate whether to use per-recipient configs. =head2 per_recipient_db Flag to indicate whether to use per-recipient greylisting databases (default is to use a shared database). Per-recipient configuration directories, if determined, supercede I. =head2 nfslock Flag to indicate the database is stored on NFS. Uses File::NFSLock instead of flock. =head2 p0f Enable greylisting only when certain p0f criteria is met. The required argument is a comma delimited list of key/value pairs. The keys are the following p0f TCP fingerprint elements: genre, detail, uptime, link, and distance. To greylist emails from computers whose remote OS is windows: greylisting p0f genre,windows To greylist only windows computers on DSL links more than 3 network hops away: greylisting p0f genre,windows,link,dsl,distance,3 =head2 geoip Do not greylist connections that are in the comma separated list of countries. greylisting geoip US,UK Prior to adding GeoIP support, I greylisted all connections from windows computers. That deters the vast majority of spam connections, but it also delays legit mail from @msn, @live.com, and a small handful of other servers. Since adding geoip support, I haven't seen a single valid mail delivery delayed. =head2 loglevel Adjust the quantity of logging for this plugin. See docs/logging.pod =head1 AUTHOR Written by Gavin Carr . nfslock feature by JT Moree - 2007-01-22 p0f feature by Matt Simerson - 2010-05-03 geoip, loglevel, reject added. Refactored into subs - Matt Simerson - 2012-05 =cut use strict; use warnings; use Qpsmtpd::Constants; my $VERSION = '0.11'; BEGIN { @AnyDBM_File::ISA = qw(DB_File GDBM_File NDBM_File) } use AnyDBM_File; use Fcntl qw(:DEFAULT :flock LOCK_EX LOCK_NB); use Net::IP; my $DENYMSG = "This mail is temporarily denied"; my ($QPHOME) = ($0 =~ m!(.*?)/([^/]+)$!); my $DB = "greylist.dbm"; my %PERMITTED_ARGS = map { $_ => 1 } qw(per_recipient remote_ip sender recipient black_timeout grey_timeout white_timeout deny_late db_dir nfslock p0f reject loglevel geoip upgrade ); my %DEFAULTS = ( remote_ip => 1, sender => 0, recipient => 0, reject => 1, black_timeout => 50 * 60, # 50m grey_timeout => 3 * 3600 + 20 * 60, # 3h:20m white_timeout => 36 * 3600 * 24, # 36 days nfslock => 0, p0f => undef, ); sub register { my ($self, $qp, %arg) = @_; my $config = { %DEFAULTS, map { split /\s+/, $_, 2 } $self->qp->config('denysoft_greylist'), %arg }; if (my @bad = grep { !exists $PERMITTED_ARGS{$_} } sort keys %$config) { $self->log(LOGALERT, "invalid parameter(s): " . join(',', @bad)); } # backwards compatibility with deprecated 'mode' setting if (defined $config->{mode} && !defined $config->{reject}) { $config->{reject} = $config->{mode} =~ /testonly|off/i ? 0 : 1; } $self->{_args} = $config; unless ($config->{recipient} || $config->{per_recipient}) { $self->register_hook('mail', 'mail_handler'); } else { $self->register_hook('rcpt', 'rcpt_handler'); } $self->prune_db(); if ($self->{_args}{upgrade}) { $self->convert_db(); } } sub mail_handler { my ($self, $transaction, $sender) = @_; my ($status, $msg) = $self->greylist($transaction, $sender); return DECLINED if $status != DENYSOFT; if (!$self->{_args}{deny_late}) { return (DENYSOFT, $msg); } $transaction->notes('greylist', $msg); return DECLINED; } sub rcpt_handler { my ($self, $transaction, $rcpt) = @_; # Load per_recipient configs my $config = { %{$self->{_args}}, map { split /\s+/, $_, 2 } $self->qp->config('denysoft_greylist', {rcpt => $rcpt}) }; # Check greylisting my $sender = $transaction->sender; my ($status, $msg) = $self->greylist($transaction, $sender, $rcpt, $config); if ($status == DENYSOFT) { # Deny here (per-rcpt) unless this is a <> sender, for smtp probes return DENYSOFT, $msg if $sender->address; $transaction->notes('greylist', $msg); } return DECLINED; } sub hook_data { my ($self, $transaction) = @_; return DECLINED unless $transaction->notes('greylist'); # Decline if ALL recipients are whitelisted if (($transaction->notes('whitelistrcpt') || 0) == scalar($transaction->recipients)) { $self->log(LOGWARN, "skip: all recipients whitelisted"); return DECLINED; } return DENYSOFT, $transaction->notes('greylist'); } sub greylist { my ($self, $transaction, $sender, $rcpt, $config) = @_; $config ||= $self->{_args}; $self->log(LOGDEBUG, "config: " . join(',', map { $_ . '=' . $config->{$_} } sort keys %$config) ); return DECLINED if $self->is_immune(); return DECLINED if !$self->is_p0f_match(); return DECLINED if $self->geoip_match(); my $db = $self->get_db_location(); my $lock = $self->get_db_lock($db) or return DECLINED; my $tied = $self->get_db_tie($db, $lock) or return DECLINED; my $key = $self->get_db_key($sender, $rcpt) or return DECLINED; my $fmt = "%s:%d:%d:%d"; # new IP or entry timed out - record new if (!$tied->{$key}) { $tied->{$key} = sprintf $fmt, time, 1, 0, 0; $self->log(LOGWARN, "fail: initial DENYSOFT, unknown"); return $self->cleanup_and_return($tied, $lock); } my ($ts, $new, $black, $white) = split /:/, $tied->{$key}; $self->log(LOGDEBUG, "ts: " . localtime($ts) . ", now: " . localtime); if ($white) { # white IP - accept unless timed out if (time - $ts < $config->{white_timeout}) { $tied->{$key} = sprintf $fmt, time, $new, $black, ++$white; $self->log(LOGINFO, "pass: white, $white deliveries"); return $self->cleanup_and_return($tied, $lock, DECLINED); } else { $self->log(LOGINFO, "key $key has timed out (white)"); } } # Black IP - deny, but don't update timestamp if (time - $ts < $config->{black_timeout}) { $tied->{$key} = sprintf $fmt, $ts, $new, ++$black, 0; $self->log(LOGWARN, "fail: black DENYSOFT - $black deferred connections"); return $self->cleanup_and_return($tied, $lock); } # Grey IP - accept unless timed out elsif (time - $ts < $config->{grey_timeout}) { $tied->{$key} = sprintf $fmt, time, $new, $black, 1; $self->log(LOGWARN, "pass: updated grey->white"); return $self->cleanup_and_return($tied, $lock, DECLINED); } $self->log(LOGWARN, "pass: timed out (grey)"); return $self->cleanup_and_return($tied, $lock, DECLINED); } sub cleanup_and_return { my ($self, $tied, $lock, $return_val) = @_; untie $tied; close $lock; return $return_val if defined $return_val; # explicit override return DECLINED if defined $self->{_args}{reject} && !$self->{_args}{reject}; return (DENYSOFT, $DENYMSG); } sub get_db_key { my $self = shift; my $sender = shift || $self->qp->transaction->sender; my $rcpt = shift || ($self->qp->transaction->recipients)[0]; my @key; if ($self->{_args}{remote_ip}) { my $nip = Net::IP->new($self->qp->connection->remote_ip); push @key, $nip->intip; # convert IP to integer } push @key, $sender->address || '' if $self->{_args}{sender}; push @key, $rcpt->address if $rcpt && $self->{_args}{recipient}; if (!scalar @key) { $self->log(LOGERROR, "enable one of remote_ip, sender, or recipient!"); return; } return join ':', @key; } sub get_db_tie { my ($self, $db, $lock) = @_; tie(my %db, 'AnyDBM_File', $db, O_CREAT | O_RDWR, 0600) or do { $self->log(LOGCRIT, "tie to database $db failed: $!"); close $lock; return; }; return \%db; } sub get_db_location { my $self = shift; my $transaction = $self->qp->transaction; my $config = $self->{_args}; if ($config->{db_dir} && $config->{db_dir} =~ m{^([-a-zA-Z0-9./_]+)$}) { $config->{db_dir} = $1; } # Setup database location my $dbdir; if ($config->{per_recipient_db}) { $dbdir = $transaction->notes('per_rcpt_configdir'); } my @candidate_dirs = ( $dbdir, $config->{db_dir}, "/var/lib/qpsmtpd/greylisting", "$QPHOME/var/db", "$QPHOME/config", '.' ); for my $d (@candidate_dirs) { next if !$d || !-d $d; # impossible $dbdir = $d; last; # first match wins } my $db = "$dbdir/$DB"; if (!-f $db && -f "$dbdir/denysoft_greylist.dbm") { $db = "$dbdir/denysoft_greylist.dbm"; # old DB name } $self->log(LOGDEBUG, "using $db as greylisting database"); return $db; } sub get_db_lock { my ($self, $db) = @_; return $self->get_db_lock_nfs($db) if $self->{_args}{nfslock}; # Check denysoft db open(my $lock, ">$db.lock") or do { $self->log(LOGCRIT, "opening lockfile failed: $!"); return; }; flock($lock, LOCK_EX) or do { $self->log(LOGCRIT, "flock of lockfile failed: $!"); close $lock; return; }; return $lock; } sub get_db_lock_nfs { my ($self, $db) = @_; require File::NFSLock; ### set up a lock - lasts until object looses scope my $nfslock = new File::NFSLock { file => "$db.lock", lock_type => LOCK_EX | LOCK_NB, blocking_timeout => 10, # 10 sec stale_lock_timeout => 30 * 60, # 30 min } or do { $self->log(LOGCRIT, "nfs lockfile failed: $!"); return; }; open(my $lock, "+<$db.lock") or do { $self->log(LOGCRIT, "opening nfs lockfile failed: $!"); return; }; return $lock; } sub convert_db { my $self = shift; my $db = $self->get_db_location(); my $lock = $self->get_db_lock($db) or return DECLINED; my $tied = $self->get_db_tie($db, $lock) or return DECLINED; my $count = keys %$tied; my $converted = 0; foreach my $key (keys %$tied) { my (@parts) = split /:/, $key; next if $parts[0] =~ /^[\d]+$/; # already converted $converted++; my $nip = Net::IP->new($parts[0]); $parts[0] = $nip->intip; # convert IP to integer my $new_key = join ':', @parts; $tied->{$new_key} = $tied->{$key}; delete $tied->{$key}; } untie $tied; close $lock; $self->log(LOGINFO, "converted $converted of $count DB entries"); return $self->cleanup_and_return($tied, $lock, DECLINED); } sub prune_db { my $self = shift; my $db = $self->get_db_location(); my $lock = $self->get_db_lock($db) or return DECLINED; my $tied = $self->get_db_tie($db, $lock) or return DECLINED; my $count = keys %$tied; my $pruned = 0; foreach my $key (keys %$tied) { my ($ts, $new, $black, $white) = split /:/, $tied->{$key}; my $age = time - $ts; next if $age < $self->{_args}{white_timeout}; $pruned++; delete $tied->{$key}; } untie $tied; close $lock; $self->log(LOGINFO, "pruned $pruned of $count DB entries"); return $self->cleanup_and_return($tied, $lock, DECLINED); } sub p0f_match { my $self = shift; return if !$self->{_args}{p0f}; my $p0f = $self->connection->notes('p0f'); if (!$p0f || !ref $p0f) { # p0f fingerprint info not found $self->LOGINFO(LOGERROR, "p0f info missing"); return; } my %valid_matches = map { $_ => 1 } qw( genre detail uptime link distance ); my %requested_matches = split(/\,/, $self->{_args}{p0f}); foreach my $key (keys %requested_matches) { next if !$key; if (!defined $valid_matches{$key}) { $self->log(LOGERROR, "discarding invalid match key ($key)"); next; } my $value = $requested_matches{$key}; next if !defined $value; # bad config setting? next if !defined $p0f->{$key}; # p0f didn't detect the value if ($key eq 'distance' && $p0f->{$key} > $value) { $self->log(LOGDEBUG, "p0f distance match ($value)"); return 1; } if ($key eq 'genre' && $p0f->{$key} =~ /$value/i) { $self->log(LOGDEBUG, "p0f genre match ($value)"); return 1; } if ($key eq 'uptime' && $p0f->{$key} < $value) { $self->log(LOGDEBUG, "p0f uptime match ($value)"); return 1; } if ($key eq 'link' && $p0f->{$key} =~ /$value/i) { $self->log(LOGDEBUG, "p0f link match ($value)"); return 1; } } $self->log(LOGINFO, "skip: no p0f match"); return; } sub geoip_match { my $self = shift; return if !$self->{_args}{geoip}; my $country = $self->connection->notes('geoip_country'); my $c_name = $self->connection->notes('geoip_country_name') || ''; if (!$country) { $self->LOGINFO(LOGNOTICE, "skip: no geoip country"); return; } my @countries = split /,/, $self->{_args}{geoip}; foreach (@countries) { $self->LOGINFO(LOGINFO, "pass: geoip country match ($_, $c_name)"); return 1 if lc $_ eq lc $country; } $self->LOGINFO(LOGINFO, "skip: no geoip match ($c_name)"); return; } qpsmtpd-0.94/plugins/headers000066400000000000000000000217201240247602400161600ustar00rootroot00000000000000#!perl -w =head1 NAME headers - validate message headers =head1 DESCRIPTION Checks for missing or empty values in the From or Date headers. Make sure no singular headers are duplicated. Singular headers are: Date From Sender Reply-To To Cc Bcc Message-Id In-Reply-To References Subject Optionally test if the Date header is too many days in the past or future. If I or I are not defined, they are not tested. If the remote IP is whitelisted, header validation is skipped. =head1 CONFIGURATION The following optional settings exist: =head2 require headers require [ From | Date | From,Date | From,Date,Subject,Message-ID,Received ] A comma separated list of headers to require. Default: From =head3 Requiring the Date header As of 2012, requiring a valid date header will almost certainly cause the loss of valid mail. The JavaMail sender used by some banks, photo processing services, health insurance companies, bounce senders, and others do send messages without a Date header. For this reason, and despite RFC 5322, the default is not to require Date. However, if the date header is present, and I and/or I are defined, it will be validated. =head2 future The number of days in the future beyond which messages are invalid. headers [ future 1 ] =head2 past The number of days in the past beyond which a message is invalid. The Date header is added by the MUA, so there are many valid reasons a message may have an older date in the header. It could have been delayed by the client, the sending server, connectivity problems, recipient server problem, recipient server configuration, etc. The I setting should take those factors into consideration. I would be surprised if a valid message ever had a date header older than a week. headers [ past 5 ] =head2 reject Determine if the connection is denied. Use the I option when first enabling the plugin, and then watch your logs to see what would have been rejected. When you are no longer concerned that valid messages will be rejected, enable with I. headers reject [ 0 | 1 ] Default: 1 =head2 reject_type Whether to issue a permanent or temporary rejection. The default is permanent. headers reject_type [ temp | perm ] Using a temporary rejection is a cautious way to enable rejections. It allows an administrator to watch for a trial period and assure no valid messages are rejected. If a deferral of valid mail is noticed, I can be set to permit the deferred message to be delivered. Default: perm =head2 loglevel Adjust the quantity of logging for this plugin. See docs/logging.pod =head1 TODO =head1 SEE ALSO https://tools.ietf.org/html/rfc5322 =head1 AUTHOR 2012 - Matt Simerson =head1 ACKNOWLEDGEMENTS based in part upon check_basicheaders by Jim Winstead Jr. Singular headers idea from Haraka's data.rfc5322_header_checks.js by Steve Freegard =cut use strict; use warnings; use Qpsmtpd::Constants; use Date::Parse qw(str2time); my @required_headers = qw/ From /; # <- to be RFC 5322 compliant, add Date here #my @should_headers = qw/ Message-ID /; my @singular_headers = qw/ Date From Sender Reply-To To Cc Bcc Message-Id In-Reply-To References Subject /; sub register { my ($self, $qp) = (shift, shift); $self->log(LOGWARN, "invalid arguments") if @_ % 2; $self->{_args} = {@_}; $self->{_args}{reject_type} ||= 'perm'; # set default if (!defined $self->{_args}{reject}) { $self->{_args}{reject} = 1; # set default } if ($self->{_args}{require}) { @required_headers = split /,/, $self->{_args}{require}; } } sub hook_data_post { my ($self, $transaction) = @_; if ($transaction->data_size == 0) { return $self->get_reject("You must send some data first", "no data"); } my $header = $transaction->header or do { return $self->get_reject("Headers are missing", "missing headers"); }; return DECLINED if $self->is_immune(); my $errors = $self->has_required_headers( $header ) || 0; $errors += $self->has_singular_headers( $header ); my $err_msg = $self->invalid_date_range(); if ($err_msg) { return $self->get_reject($err_msg, $err_msg); } if ( $errors ) { return $self->get_reject($self->get_reject_type(), "RFC 5322 validation errors" ); }; $self->log(LOGINFO, 'pass'); return (DECLINED); } sub has_required_headers { my ($self, $header) = @_; my $errors = 0; foreach my $h (@required_headers) { next if $header->get($h); $errors++; $self->adjust_karma(-1); $self->is_naughty(1) if $self->{args}{reject}; $self->store_deferred_reject("We require a valid $h header"); $self->log(LOGINFO, "fail, no $h header" ); } return $errors; }; sub has_singular_headers { my ($self, $header) = @_; my $errors = 0; foreach my $h (@singular_headers) { next if !$header->get($h); # doesn't exist my @qty = $header->get($h); next if @qty == 1; # only 1 header $errors++; $self->adjust_karma(-1); $self->is_naughty(1) if $self->{args}{reject}; $self->store_deferred_reject( "Only one $h header allowed. See RFC 5322, Section 3.6", ); $self->log(LOGINFO, "fail, too many $h headers" ); } return $errors; }; sub invalid_date_range { my $self = shift; return if !$self->transaction->header; my $date = shift || $self->transaction->header->get('Date') or return; chomp $date; my $msg_ts = str2time($date) or do { $self->log(LOGINFO, "skip, date not parseable ($date)"); return; }; my $past = $self->{_args}{past}; if ($past && $msg_ts < time - ($past * 24 * 3600)) { $self->log(LOGINFO, "fail, date too old ($date)"); $self->adjust_karma(-1); return "The Date header is too far in the past"; } my $future = $self->{_args}{future}; if ($future && $msg_ts > time + ($future * 24 * 3600)) { $self->log(LOGINFO, "fail, date in future ($date)"); $self->adjust_karma(-1); return "The Date header is too far in the future"; } return; } __END__ =head1 SMTP HEADERS http://forum.unifiedemail.net/default.aspx?g=posts&t=68 =head2 From: The eMail address, and optionally the name of the author(s). In many eMail clients not changeable except through changing account settings. =head2 To: The eMail address(es), and optionally name(s) of the message's recipient(s). Indicates primary recipients (multiple allowed), for secondary recipients see Cc: and Bcc: below. =head2 Subject: A brief summary of the topic of the message. Certain abbreviations are commonly used in the subject, including "RE:" and "FW:". =head2 Date: The local time and date when the message was written. Like the From: field, many email clients fill this in automatically when sending. The recipient's client may then display the time in the format and time zone local to him/her. =head2 Message-ID: Also an automatically generated field; used to prevent multiple delivery and for reference in In-Reply-To: (see below). =head2 Bcc: Blind Carbon Copy; addresses added to the SMTP delivery list but not (usually) listed in the message data, remaining invisible to other recipients. =head2 Cc: Carbon copy; Many eMail clients will mark eMail in your inbox differently depending on whether you are in the To: or Cc: list. =head2 Content-Type: Information about how the message is to be displayed, usually a MIME type. =head2 In-Reply-To: Message-ID of the message that this is a reply to. Used to link related messages together. =head2 Precedence: Commonly with values "bulk", "junk", or "list"; used to indicate that automated "vacation" or "out of office" responses should not be returned for this mail, e.g. to prevent vacation notices from being sent to all other subscribers of a mailinglist. =head2 Received: Tracking information generated by mail servers that have previously handled a message, in reverse order (last handler first). =head2 References: Message-ID of the message that this is a reply to, and the message-id of the message the previous was reply a reply to, etc. =head2 Reply-To: Address that should be used to reply to the message. =head2 Sender: Address of the actual sender acting on behalf of the author listed in the From: field (secretary, list manager, etc.). =head2 Return-Path: When the delivery SMTP server makes the "final delivery" of a message, it inserts a return-path line at the beginning of the mail data. Thisuse of return-path is required; mail systems MUST support it. The return-path line preserves the information in the from the MAIL command. =head2 Error-To: Indicates where error messages should be sent. In the absence of this line, they go to the Sender:, and absent that, the From: address. =head2 X-* No standard header field will ever begin with the characters "X-", so application developers are free to use them for their own purposes. =cut qpsmtpd-0.94/plugins/helo000066400000000000000000000357621240247602400155070ustar00rootroot00000000000000#!perl -w =head1 NAME helo - validate the HELO message presented by a connecting host. =head1 DESCRIPTION Validate the HELO hostname. This plugin includes a suite of optional tests, selectable by the I setting. The policy section details which tests are enforced by each policy option. It sets the connection notes helo_forward_match and helo_reverse_match when I or I are used. Adds an X-HELO header with the HELO hostname to the message. Using I will reject a very large portion of the spam from hosts that have yet to get blacklisted. =head1 WHY IT WORKS The reverse DNS of the zombie PCs is out of the spam operators control. Their only way to get past these tests is to limit themselves to hosts with matching forward and reverse DNS, and then use the proper HELO hostname when spamming. At present, this presents a very high hurdle. =head1 HELO VALIDATION TESTS =over 4 =item is_in_badhelo Matches in the I config file, including yahoo.com and aol.com, which neither the real Yahoo or the real AOL use, but which spammers use a lot. Like qmail with the qregex patch, the B file can also contain perl regular expressions. In addition to normal regexp processing, a pattern can start with a ! character, and get a negated (!~) match. =item invalid_localhost Assure that if a sender uses the 'localhost' hostname, they are coming from the localhost IP. =item is_plain_ip Disallow plain IP addresses. They are neither a FQDN nor an address literal. =item is_address_literal [N.N.N.N] An address literal (an IP enclosed in brackets) is legal but rarely, if ever, encountered from legit senders. =item is_forged_literal If a literal is presented, make sure it matches the senders IP. =item is_not_fqdn Makes sure the HELO hostname contains at least one dot and has only those characters specifically allowed in domain names (RFC 1035). =item no_forward_dns Make sure the HELO hostname resolves. =item no_reverse_dns Make sure the senders IP address resolves to a hostname. =item no_matching_dns Make sure the HELO hostname has an A or AAAA record that matches the senders IP address, and make sure that the senders IP has a PTR that resolves to the HELO hostname. Per RFC 5321 section 4.1.4, it is impermissible to block a message I on the basis of the HELO hostname not matching the senders IP. Since the dawn of SMTP, having matching DNS has been a minimum standard expected and oft required of mail servers. While requiring matching DNS is prudent, requiring an exact match will reject valid email. While testing this plugin with rejection disabled, I noticed that mx0.slc.paypal.com sends email from an IP that reverses to mx1.slc.paypal.com. While that's technically an error, I believe it's an error to reject mail based on it. Especially since SLD and TLD match. To avoid snagging false positives, matches are extended to the first 3 octets of the IP and the last two labels of the FQDN. The following are considered a match: 192.0.1.2, 192.0.1.3 foo.example.com, bar.example.com This allows I to be used without rejecting mail from orgs with pools of servers where the HELO name and IP don't exactly match. This list includes Yahoo, Gmail, PayPal, cheaptickets.com, exchange.microsoft.com, and likely many more. =back =head1 CONFIGURATION =head2 policy [ lenient | rfc | strict ] Default: lenient =head3 lenient Runs the following tests: is_in_badhelo, invalid_localhost, is_forged_literal, and is_plain_ip. This setting is lenient enough not to cause problems for your Windows users. It is comparable to running check_spamhelo, but with the addition of regexp support, the prevention of forged localhost, forged IP literals, and plain IPs. =head3 rfc Per RFC 2821, the HELO hostname is the FQDN of the sending server or an address literal. When I is selected, all the lenient checks and the following are tested: is_not_fqdn, no_forward_dns, and no_reverse_dns. If you have Windows users that send mail via your server, do not choose I without setting I to 0 or naughty. Windows PCs often send unqualified HELO names and will have trouble sending mail. The B plugin defers the rejection, giving the user the opportunity to authenticate and bypass the rejection. =head3 strict Strict includes all the RFC tests and the following: no_matching_dns, and is_address_literal. I have yet to see an address literal being used by a hammy sender. But I am not certain that blocking them all is prudent. It is recommended that I be used with and that you examine your logs for false positives. =head2 badhelo Add domains, hostnames, or perl regexp patterns to the F config file; one per line. =head2 timeout [seconds] Default: 5 The number of seconds before DNS queries timeout. =head2 reject [ 0 | 1 | naughty ] Default: 1 0: do not reject 1: reject naughty: naughty plugin handles rejection =head2 reject_type [ temp | perm | disconnect ] Default: disconnect What type of rejection should be sent? See docs/config.pod =head2 loglevel Adjust the quantity of logging for this plugin. See docs/logging.pod =head1 RFC 2821 =head2 4.1.1.1 The HELO hostname "...contains the fully-qualified domain name of the SMTP client if one is available. In situations in which the SMTP client system does not have a meaningful domain name (e.g., when its address is dynamically allocated and no reverse mapping record is available), the client SHOULD send an address literal (see section 4.1.3), optionally followed by information that will help to identify the client system." =head2 2.3.5 The domain name, as described in this document and in [22], is the entire, fully-qualified name (often referred to as an "FQDN"). A domain name that is not in FQDN form is no more than a local alias. Local aliases MUST NOT appear in any SMTP transaction. =head1 RFC 5321 =head2 4.1.4 An SMTP server MAY verify that the domain name argument in the EHLO command actually corresponds to the IP address of the client. However, if the verification fails, the server MUST NOT refuse to accept a message on that basis. Information captured in the verification attempt is for logging and tracing purposes. Note that this prohibition applies to the matching of the parameter to its IP address only; see Section 7.9 for a more extensive discussion of rejecting incoming connections or mail messages. =head1 TODO is_forged_literal, if the forged IP is an internal IP, it's likely one of our clients that should have authenticated. Perhaps when we check back later in data_post, if they have added relay_client, then give back the karma. =head1 AUTHOR 2012 - Matt Simerson =head1 ACKNOWLEDGEMENTS badhelo processing from check_badhelo plugin badhelo regex processing idea from qregex patch additional check ideas from Haraka helo plugin =cut use strict; use warnings; use Qpsmtpd::Constants; sub register { my ($self, $qp) = (shift, shift); $self->{_args} = {@_}; $self->{_args}{reject_type} = 'disconnect'; $self->{_args}{policy} ||= 'lenient'; $self->{_args}{dns_timeout} ||= $self->{_args}{timeout} || 5; if (!defined $self->{_args}{reject}) { $self->{_args}{reject} = 1; } $self->populate_tests(); $self->init_resolver() or return; $self->register_hook('helo', 'helo_handler'); $self->register_hook('ehlo', 'helo_handler'); $self->register_hook('data_post', 'data_post_handler'); } sub helo_handler { my ($self, $transaction, $host) = @_; if (!$host) { $self->log(LOGINFO, "fail, tolerated, no helo host"); $self->adjust_karma(-2); return DECLINED; } return DECLINED if $self->is_immune(); foreach my $test (@{$self->{_helo_tests}}) { my @err = $self->$test($host); if (scalar @err) { $self->adjust_karma(-1); return $self->get_reject(@err); } } $self->log(LOGINFO, "pass"); return DECLINED; } sub data_post_handler { my ($self, $transaction) = @_; $transaction->header->delete('X-HELO'); $transaction->header->add('X-HELO', $self->qp->connection->hello_host, 0); return (DECLINED); } sub populate_tests { my $self = shift; my $policy = $self->{_args}{policy}; @{$self->{_helo_tests}} = qw/ is_in_badhelo invalid_localhost is_forged_literal is_plain_ip /; if ($policy eq 'rfc' || $policy eq 'strict') { push @{$self->{_helo_tests}}, qw/ is_not_fqdn no_forward_dns no_reverse_dns /; } if ($policy eq 'strict') { push @{$self->{_helo_tests}}, qw/ is_address_literal no_matching_dns /; } } sub is_in_badhelo { my ($self, $host) = @_; my $error = "I do not believe you are $host."; $host = lc $host; foreach my $bad ($self->qp->config('badhelo')) { if ($bad =~ /[\{\}\[\]\(\)\^\$\|\*\+\?\\\!]/) { # it's a regexp return $self->is_regex_match($host, $bad); } if ($host eq lc $bad) { return ($error, "in badhelo"); } } return; } sub is_regex_match { my ($self, $host, $pattern) = @_; my $error = "Your HELO hostname is not allowed"; #$self->log( LOGDEBUG, "is regex ($pattern)"); if (substr($pattern, 0, 1) eq '!') { $pattern = substr $pattern, 1; if ($host !~ /$pattern/) { #$self->log( LOGDEBUG, "matched ($pattern)"); return ($error, "badhelo pattern match ($pattern)"); } return; } if ($host =~ /$pattern/) { #$self->log( LOGDEBUG, "matched ($pattern)"); return ($error, "badhelo pattern match ($pattern)"); } return; } sub invalid_localhost { my ($self, $host) = @_; return if lc $host ne 'localhost'; if ($self->qp->connection->remote_ip ne '127.0.0.1') { #$self->log( LOGINFO, "fail, not localhost" ); return ("You are not localhost", "invalid localhost"); } $self->log(LOGDEBUG, "pass, is localhost"); return; } sub is_plain_ip { my ($self, $host) = @_; return if $host =~ /[^\d\.]+/; # has chars other than digits and a dot return if $host !~ m/^(\d{1,3}\.){3}\d{1,3}$/; $self->log(LOGDEBUG, "fail, plain IP"); return ("Plain IP is invalid HELO hostname (RFC 2821)", "plain IP"); } sub is_address_literal { my ($self, $host) = @_; return if $host !~ m/^\[(\d{1,3}\.){3}\d{1,3}\]$/; $self->log(LOGDEBUG, "fail, bracketed IP"); return ("RFC 2821 allows an address literal, but we do not", "bracketed IP"); } sub is_forged_literal { my ($self, $host) = @_; return if $host !~ m/^\[(\d{1,3}\.){3}\d{1,3}\]$/; # should we add exceptions for reserved internal IP space? (192.168,10., etc?) $host = substr $host, 1, -1; return if $host eq $self->qp->connection->remote_ip; return ("Forged IPs not accepted here", "forged IP literal"); } sub is_not_fqdn { my ($self, $host) = @_; return if $host =~ m/^\[(\d{1,3}\.){3}\d{1,3}\]$/; # address literal, skip if ($host !~ /\./) { # has no dots return ("HELO name is not fully qualified. Read RFC 2821", "not FQDN"); } if ($host =~ /[^a-zA-Z0-9\-\.]/) { return ("HELO name contains invalid FQDN characters. Read RFC 1035", "invalid FQDN chars"); } return; } sub no_forward_dns { my ($self, $host) = @_; return if $self->is_address_literal($host); my $res = $self->init_resolver(); $host = "$host." if $host !~ /\.$/; # fully qualify name my $query = $res->search($host); if (!$query) { if ($res->errorstring eq 'NXDOMAIN') { return ("HELO hostname does not exist", "no such host"); } $self->log(LOGERROR, "skip, query failed (", $res->errorstring, ")"); return; } my $hits = 0; foreach my $rr ($query->answer) { next unless $rr->type =~ /^(?:A|AAAA)$/; $self->check_ip_match($rr->address); $hits++; last if $self->connection->notes('helo_forward_match'); } if ($hits) { $self->log(LOGDEBUG, "pass, forward DNS") if $hits; return; } return ("HELO hostname did not resolve", "no forward DNS"); } sub no_reverse_dns { my ($self, $host, $ip) = @_; my $res = $self->init_resolver(); $ip ||= $self->qp->connection->remote_ip; my $query = $res->query($ip) or do { if ($res->errorstring eq 'NXDOMAIN') { return ("no rDNS for $ip", "no rDNS"); } $self->log(LOGINFO, $res->errorstring); return ("error getting reverse DNS for $ip", "rDNS " . $res->errorstring); }; my $hits = 0; for my $rr ($query->answer) { next if $rr->type ne 'PTR'; $self->log(LOGDEBUG, "PTR: " . $rr->ptrdname); $self->check_name_match(lc $rr->ptrdname, lc $host); $hits++; } if ($hits) { $self->log(LOGDEBUG, "has rDNS"); return; } return ("no reverse DNS for $ip", "no rDNS"); } sub no_matching_dns { my ($self, $host) = @_; # this is called iprev, or "Forward-confirmed reverse DNS" and is discussed # in RFC 5451. FCrDNS is done for the remote IP in the fcrdns plugin. Here # we do it on the HELO hostname. # consider adding status to Authentication-Results header if ( $self->connection->notes('helo_forward_match') && $self->connection->notes('helo_reverse_match')) { $self->log(LOGDEBUG, "foward and reverse match"); $self->adjust_karma(1); # a perfect match return; } if ($self->connection->notes('helo_forward_match')) { $self->log(LOGDEBUG, "name matches IP"); return; } if ($self->connection->notes('helo_reverse_match')) { $self->log(LOGDEBUG, "reverse matches name"); return; } $self->log(LOGINFO, "fail, no forward or reverse DNS match"); return ("That HELO hostname fails FCrDNS", "no matching DNS"); } sub check_ip_match { my $self = shift; my $ip = shift or return; if ($ip eq $self->qp->connection->remote_ip) { $self->log(LOGDEBUG, "forward ip match"); $self->connection->notes('helo_forward_match', 1); return; } my $dns_net = join('.', (split(/\./, $ip))[0, 1, 2]); my $rem_net = join('.', (split(/\./, $self->qp->connection->remote_ip))[0, 1, 2]); if ($dns_net eq $rem_net) { $self->log(LOGNOTICE, "forward network match"); $self->connection->notes('helo_forward_match', 1); } } sub check_name_match { my $self = shift; my ($dns_name, $helo_name) = @_; return if !$dns_name; return if split(/\./, $dns_name) < 2; # not a FQDN if ($dns_name eq $helo_name) { $self->log(LOGDEBUG, "reverse name match"); $self->connection->notes('helo_reverse_match', 1); return; } my $dns_dom = join('.', (split(/\./, $dns_name))[-2, -1]); my $helo_dom = join('.', (split(/\./, $helo_name))[-2, -1]); if ($dns_dom eq $helo_dom) { $self->log(LOGNOTICE, "reverse domain match"); $self->connection->notes('helo_reverse_match', 1); } } qpsmtpd-0.94/plugins/help000066400000000000000000000074351240247602400155040ustar00rootroot00000000000000#!perl -w =head1 NAME help - default help plugin for qpsmtpd =head1 DESCRIPTION The B plugin gives the answers for the help command. It can be configured to return C<502 Not implemented>. Without any arguments, the C is set to F<./help/>. =head1 OPTIONS =over 4 =item not_implemented (1|0) If this option is set (and the next argument is true), the plugin answers, that the B command is not implemented =item help_dir /path/to/help/files/ When a client requests help for C the file F is dumped to the client if it exists. =item COMMAND HELPFILE Any other argument pair is treated as command / help file pair. The file is expexted in the F sub directory. If the client calls C the contents of HELPFILE are dumped to him. =back =head1 NOTES The hard coded F path should be changed. =cut my %config = (); sub register { my ($self, $qp, %args) = @_; my ($file, $cmd); unless (%args) { $config{help_dir} = './help/'; } foreach (keys %args) { /^(\w+)$/ or $self->log(LOGWARN, "Invalid argument for the 'help' plugin $_"), next; $cmd = $1; if ($cmd eq 'not_implemented') { $config{'not_implemented'} = $args{'not_implemented'}; } elsif ($cmd eq 'help_dir') { $file = $args{$cmd}; $file =~ m#^([\w\.\-/]+)$# or $self->log(LOGERROR, "Invalid charachters in filename for command $cmd"), next; $config{'help_dir'} = $1; } else { $file = $args{$cmd}; $file =~ m#^([\w\.\-/]+)$# or $self->log(LOGERROR, "Invalid charachters in filename for command $cmd"), next; $file = $1; if ($file =~ m#/#) { -e $file or $self->log(LOGWARN, "No help file for command '$cmd'"), next; } else { $file = "help/$file"; if (-e "help/$file") { ## FIXME: path $file = "help/$file"; } else { $self->log(LOGWARN, "No help file for command '$cmd'"); next; } } $config{lc $cmd} = $file; } } return DECLINED; } sub hook_help { my ($self, $transaction, @args) = @_; my ($help, $cmd); if ($config{not_implemented}) { $self->qp->respond(502, "Not implemented."); return DONE; } return OK, "Try 'HELP COMMAND' for getting help on COMMAND" unless $args[0]; $cmd = lc $args[0]; unless ($cmd =~ /^(\w+)$/) { # else someone could request # "HELP ../../../../../../../../etc/passwd" $self->qp->respond(502, "Invalid command name"); return DONE; } $cmd = $1; if (exists $config{$cmd}) { $help = read_helpfile($config{$cmd}, $cmd) or $self->log(LOGERROR, "failed to open help file for $cmd: $!"), return OK, "No help available for SMTP command: $cmd"; } elsif (exists $config{'help_dir'} && -e $config{'help_dir'} . "/$cmd") { $help = read_helpfile($config{help_dir} . "/$cmd", $cmd) or $self->log(LOGERROR, "failed to open help file for $cmd: $!"), return OK, "No help available for SMTP command: $cmd"; } $help = "No help available for SMTP command: $cmd" # empty file unless $help; return OK, split(/\n/, $help); } sub read_helpfile { my ($file, $cmd) = @_; my $help; open HELP, $file or return undef; { local $/ = undef; $help = ; }; close HELP; return $help; } qpsmtpd-0.94/plugins/hosts_allow000066400000000000000000000072771240247602400171160ustar00rootroot00000000000000#!perl -w =head1 NAME hosts_allow - decide if a host is allowed to connect =head1 DESCRIPTION The B module decides before the SMTP-Greeting if a host is allowed to connect. It checks for too many (running) connections from one host (see -m/--max-from-ip options in qpsmtpd-forkserver) and the config file I. The plugin takes no config/plugin arguments. This plugin only works with the forkserver and prefork deployment models. It does not work with the tcpserver deployment model. See SEE ALSO below. =head1 CONFIG The I config file contains lines with two or three items. The first is an IP address or a network/mask pair. The second is a (valid) return code from Qpsmtpd::Constants. The last is a comment which will be returned to the connecting client if the return code is DENY or DENYSOFT (and of course DENY_DISCONNECT and DENYSOFT_DISCONNECT). Example: 192.168.3.4 DECLINED 192.168.3.0/24 DENY Sorry, known spam only source This would exclude 192.168.3.4 from the DENY of 192.168.3.0/24. =head1 SEE ALSO To get similar functionality for the tcpserver deployment model, use tcpserver's -x feature. Create a tcp.smtp file with entries like this: 70.65.227.235:deny 183.7.90.207:deny :allow compile the tcp.smtp file like this: /usr/local/bin/tcprules tcp.smtp.cdb tcp.smtp.tmp < tcp.smtp and add the file to the chain of arguments to tcpserver in your run file. See also: http://cr.yp.to/ucspi-tcp.html =cut use strict; use warnings; use Qpsmtpd::Constants; use Socket; sub hook_pre_connection { my ($self, $transaction, %args) = @_; # remote_ip => inet_ntoa($iaddr), # remote_port => $port, # local_ip => inet_ntoa($laddr), # local_port => $lport, # max_conn_ip => $MAXCONNIP, # child_addrs => [values %childstatus], my $remote = $args{remote_ip}; my $max = $args{max_conn_ip}; my $karma = $self->connection->notes('karma_history'); if ($max) { my $num_conn = 1; # seed with current value my $raddr = inet_aton($remote); foreach my $rip (@{$args{child_addrs}}) { ++$num_conn if (defined $rip && $rip eq $raddr); } $max = $self->karma_bump($karma, $max) if defined $karma; if ($num_conn > $max) { my $err_mess = "too many connections from $remote"; $self->log(LOGINFO, "fail: $err_mess ($num_conn > $max)"); return (DENYSOFT, "$err_mess, try again later"); } } my @r = $self->in_hosts_allow($remote); return @r if scalar @r; $self->log(LOGDEBUG, "pass"); return (DECLINED); } sub in_hosts_allow { my $self = shift; my $remote = shift; foreach ($self->qp->config('hosts_allow')) { s/^\s*//; # trim leading whitespace my ($ipmask, $const, $message) = split /\s+/, $_, 3; next unless defined $const; my ($net, $mask) = split /\//, $ipmask, 2; $mask = 32 if !defined $mask; $mask = pack "B32", "1" x ($mask) . "0" x (32 - $mask); if (join('.', unpack('C4', inet_aton($remote) & $mask)) eq $net) { $const = Qpsmtpd::Constants::return_code($const) || DECLINED; if ($const =~ /deny/i) { $self->log(LOGINFO, "fail, $message"); } $self->log(LOGDEBUG, "pass, $const, $message"); return ($const, $message); } } return; } sub karma_bump { my ($self, $karma, $max) = @_; if ($karma > 5) { $self->log(LOGDEBUG, "connect limit +3 for positive karma"); return $max + 3; } if ($karma <= 0) { $self->log(LOGINFO, "connect limit 1, karma $karma"); return 1; } return $max; } qpsmtpd-0.94/plugins/http_config000066400000000000000000000024511240247602400170510ustar00rootroot00000000000000#!perl -w =head1 NAME http_config =head1 DESCRIPTION Example config plugin. Gets configuration data via http requests. =head1 CONFIG http_config is configured at plugin loading time via the plugins config. Load the plugin with a list of urls like the following (on one line) http_config http://localhost/~smtpd/config/ http://www.example.com/cgi-bin/qp?config= Looking to config "me", qpsmtpd will try loading http://localhost/~smtpd/config/me and if failing that try http://www.example.com/cgi-bin/qp?config=me =head1 BUGS http_config doesn't do any caching. It should do some simple caching to be used in production. =cut use LWP::Simple qw(get); my @urls; sub register { my ($self, $qp, @args) = @_; @urls = @args; } sub hook_config { my ($self, $transaction, $config) = @_; $self->log(LOGNOTICE, "http_config called with $config"); for my $url (@urls) { $self->log(LOGDEBUG, "http_config loading from $url"); my @config = split /[\r\n]+/, (get "$url$config" || ""); chomp @config; @config = grep { $_ and $_ !~ m/^\s*#/ and $_ =~ m/\S/ } @config; close CF; # $self->log(LOGNOTICE, "returning http_config for $config ",Data::Dumper->Dump([\@config], [qw(config)])); return (OK, @config) if @config; } return DECLINED; } qpsmtpd-0.94/plugins/ident/000077500000000000000000000000001240247602400157235ustar00rootroot00000000000000qpsmtpd-0.94/plugins/ident/geoip000066400000000000000000000244121240247602400167540ustar00rootroot00000000000000#!perl -w =head1 NAME geoip - provide geographic information about mail senders. =head1 SYNOPSIS Use MaxMind's GeoIP databases and the Geo::IP perl module to report geographic information about incoming connections. =head1 DESCRIPTION This plugin saves geographic information in the following connection notes: geoip_country - 2 char country code geoip_country_name - english name of country geoip_continent - 2 char continent code geoip_city - english name of city geoip_distance - distance in kilometers And adds entries like this to your logs: (connect) ident::geoip: NA, US, United States, 1319 km (connect) ident::geoip: AS, IN, India, 13862 km (connect) ident::geoip: fail: no results (connect) ident::geoip: NA, CA, Canada, 2464 km (connect) ident::geoip: NA, US, United States, 2318 km (connect) ident::geoip: AS, PK, Pakistan, 12578 km (connect) ident::geoip: AS, TJ, Tajikistan, 11965 km (connect) ident::geoip: EU, AT, Austria, 8745 km (connect) ident::geoip: AS, IR, Iran, Islamic Republic of, 12180 km (connect) ident::geoip: EU, BY, Belarus, 9030 km (connect) ident::geoip: AS, CN, China, 11254 km (connect) ident::geoip: NA, PA, Panama, 3163 km Calculating the distance has three prerequsites: 1. The MaxMind city database (free or subscription) 2. The Math::Complex perl module 3. The IP address of this mail server (see CONFIG) Other plugins can utilize the geographic notes to alter the connection, reject, greylist, etc. =head1 CONFIG The following options can be appended in this plugins config/plugins entry. =head2 distance Enables geodesic distance calculation. Will calculate the distance "as the crow flies" from the remote mail server. Accepts a single argument, the IP address to calculate the distance from. This will typically be the public IP of your mail server. ident/geoip [ distance 192.0.1.5 ] Default: none. (no distance calculations) =head2 too_far Assign negative karma to connections further than this many km. Default: none =head2 db_dir The path to the GeoIP database directory. ident/geoip [ db_dir /etc/GeoIP ] Default: /usr/local/share/GeoIP =head1 LIMITATIONS The distance calculations are more concerned with being fast than accurate. The MaxMind location data is collected from whois and is of limited accuracy. MaxMind offers more accurate data for a fee. For distance calculations, the earth is considered a perfect sphere. In reality, it is not. Accuracy should be within 1%. This plugin does not update the GeoIP databases. You may want to. =head1 CHANGES 2012-06 - Matt Simerson - added GeoIP City support, continent, distance 2012-05 - Matt Simerson - added geoip_country_name note, added tests =head1 SEE ALSO MaxMind: http://www.maxmind.com/ Databases: http://geolite.maxmind.com/download/geoip/database It may become worth adding support for Geo::IPfree, which uses another data source: http://software77.net/geo-ip/ =head1 ACKNOWLEDGEMENTS Stevan Bajic, the DSPAM author, who suggested SNARE, which describes using geodesic distance to determine spam probability. The research paper on SNARE can be found here: http://smartech.gatech.edu/bitstream/handle/1853/25135/GT-CSE-08-02.pdf =cut use strict; use warnings; use Qpsmtpd::Constants; #use Geo::IP; # eval'ed in register() #use Math::Trig; # eval'ed in set_distance_gc sub register { my ($self, $qp, @args) = @_; $self->log(LOGERROR, "Bad arguments") if @args % 2; $self->{_args} = {@args}; $self->{_args}{db_dir} ||= '/usr/local/share/GeoIP'; eval 'use Geo::IP'; if ($@) { warn "could not load Geo::IP"; $self->log(LOGERROR, "could not load Geo::IP"); return; } # Note that opening the GeoIP DB only in register has caused problems before: # https://github.com/smtpd/qpsmtpd/commit/29ea9516806e9a8ca6519fcf987dbd684793ebdd#plugins/ident/geoip # Opening the DB anew for every connection is horribly inefficient. # Instead, attempt to reopen upon connect if the DB connection fails. $self->open_geoip_db(); $self->init_my_country_code(); $self->register_hook('connect', 'connect_handler'); } sub connect_handler { my $self = shift; # reopen the DB if Geo::IP failed due to DB update $self->open_geoip_db(); my $c_code = $self->set_country_code() or do { $self->log(LOGINFO, "skip, no results"); return DECLINED; }; $self->qp->connection->notes('geoip_country', $c_code); my $c_name = $self->set_country_name(); my ($city, $continent_code, $distance) = ''; if ($self->{_my_country_code}) { $continent_code = $self->set_continent($c_code); $city = $self->set_city_gc(); $distance = $self->set_distance_gc(); } my @msg_parts; push @msg_parts, $continent_code if $continent_code && $continent_code ne '--'; push @msg_parts, $c_code if $c_code; #push @msg_parts, $c_name if $c_name; push @msg_parts, $city if $city; if ($distance) { push @msg_parts, "\t$distance km"; if ($self->{_args}{too_far} && $distance > $self->{_args}{too_far}) { $self->adjust_karma(-1); } } $self->log(LOGINFO, join(", ", @msg_parts)); return DECLINED; } sub open_geoip_db { my $self = shift; # this might detect if the DB connection failed. If not, this is where # to add more code to do it. return if (defined $self->{_geoip_city} || defined $self->{_geoip}); # The methods for using GeoIP work differently for the City vs Country DB # save the handles in different locations my $db_dir = $self->{_args}{db_dir}; foreach my $db (qw/ GeoIPCity GeoLiteCity /) { if (-f "$db_dir/$db.dat") { $self->log(LOGDEBUG, "using db $db"); $self->{_geoip_city} = Geo::IP->open("$db_dir/$db.dat"); } } # can't think of a good reason to load country if city data is present if (!$self->{_geoip_city}) { $self->log(LOGDEBUG, "using default db"); $self->{_geoip} = Geo::IP->new(); # loads default Country DB } } sub init_my_country_code { my $self = shift; my $ip = $self->{_args}{distance} or return; $self->{_my_country_code} = $self->get_country_code($ip); } sub set_country_code { my $self = shift; return $self->get_country_code_gc() if $self->{_geoip_city}; my $remote_ip = $self->qp->connection->remote_ip; my $code = $self->get_country_code(); $self->qp->connection->notes('geoip_country', $code); return $code; } sub get_country_code { my $self = shift; my $ip = shift || $self->qp->connection->remote_ip; return $self->get_country_code_gc($ip) if $self->{_geoip_city}; return $self->{_geoip}->country_code_by_addr($ip); } sub get_country_code_gc { my $self = shift; my $ip = shift || $self->qp->connection->remote_ip; $self->{_geoip_record} = $self->{_geoip_city}->record_by_addr($ip) or return; return $self->{_geoip_record}->country_code; } sub set_country_name { my $self = shift; return $self->set_country_name_gc() if $self->{_geoip_city}; my $remote_ip = $self->qp->connection->remote_ip; my $name = $self->{_geoip}->country_name_by_addr($remote_ip) or return; $self->qp->connection->notes('geoip_country_name', $name); return $name; } sub set_country_name_gc { my $self = shift; return if !$self->{_geoip_record}; my $remote_ip = $self->qp->connection->remote_ip; my $name = $self->{_geoip_record}->country_name() or return; $self->qp->connection->notes('geoip_country_name', $name); return $name; } sub set_continent { my $self = shift; return $self->set_continent_gc() if $self->{_geoip_city}; my $c_code = shift or return; my $continent = $self->{_geoip}->continent_code_by_country_code($c_code) or return; $self->qp->connection->notes('geoip_continent', $continent); return $continent; } sub set_continent_gc { my $self = shift; return if !$self->{_geoip_record}; my $continent = $self->{_geoip_record}->continent_code() or return; $self->qp->connection->notes('geoip_continent', $continent); return $continent; } sub set_city_gc { my $self = shift; return if !$self->{_geoip_record}; my $remote_ip = $self->qp->connection->remote_ip; my $city = $self->{_geoip_record}->city() or return; $self->qp->connection->notes('geoip_city', $city); return $city; } sub set_distance_gc { my $self = shift; return if !$self->{_geoip_record}; my ($self_lat, $self_lon) = $self->get_my_lat_lon() or return; my ($sender_lat, $sender_lon) = $self->get_sender_lat_lon() or return; eval 'use Math::Trig qw(great_circle_distance deg2rad)'; if ($@) { $self->log(LOGERROR, "can't calculate distance, Math::Trig not installed"); return; } # Notice the 90 - latitude: phi zero is at the North Pole. sub NESW { deg2rad($_[0]), deg2rad(90 - $_[1]) } my @me = NESW($self_lon, $self_lat); my @sender = NESW($sender_lon, $sender_lat); my $km = great_circle_distance(@me, @sender, 6378); $km = sprintf("%.0f", $km); $self->qp->connection->notes('geoip_distance', $km); #$self->log( LOGINFO, "distance $km km"); return $km; } sub get_my_lat_lon { my $self = shift; return if !$self->{_geoip_city}; if ($self->{_latitude} && $self->{_longitude}) { return ($self->{_latitude}, $self->{_longitude}); # cached } my $ip = $self->{_args}{distance} or return; my $record = $self->{_geoip_city}->record_by_addr($ip) or do { $self->log(LOGERROR, "no record for my Geo::IP location"); return; }; $self->{_latitude} = $record->latitude(); $self->{_longitude} = $record->longitude(); if (!$self->{_latitude} || !$self->{_longitude}) { $self->log(LOGNOTICE, "could not get my lat/lon"); } return ($self->{_latitude}, $self->{_longitude}); } sub get_sender_lat_lon { my $self = shift; my $lat = $self->{_geoip_record}->latitude(); my $lon = $self->{_geoip_record}->longitude(); if (!$lat || !$lon) { $self->log(LOGNOTICE, "could not get sender lat/lon"); return; } return ($lat, $lon); } qpsmtpd-0.94/plugins/ident/p0f000066400000000000000000000251411240247602400163360ustar00rootroot00000000000000#!perl -w =head1 NAME p0f - A TCP Fingerprinting Identification Plugin =head1 SYNOPSIS Use TCP fingerprint info (remote computer OS, network distance, etc) to implement more sophisticated anti-spam policies. =head1 DESCRIPTION This p0f module inserts a I connection note with information deduced from the TCP fingerprint. The note typically includes at least the link, detail, distance, uptime, genre. Here's a p0f v2 example: genre => FreeBSD detail => 6.x (1) uptime => 1390 link => ethernet/modem distance => 17 Which was parsed from this p0f fingerprint: 24.18.227.2:39435 - FreeBSD 6.x (1) (up: 1390 hrs) -> 208.75.177.101:25 (distance 17, link: ethernet/modem) When using p0f v3, the following additional values may also be available in the I connection note: =over 4 magic, status, first_seen, last_seen, total_conn, uptime_min, up_mod_days, last_nat, last_chg, distance, bad_sw, os_match_q, os_name, os_flavor, http_name, http_flavor, link_type, and language. =back =head1 MOTIVATION This p0f plugin provides a way to make sophisticated policies for email messages. For example, the vast majority of email connections to my server from Windows computers are spam (>99%). But, I have clients with Exchange servers so I can't block email from all Windows computers. Same goes for greylisting. Finance companies (AmEx, BoA, etc) send notices that they don't queue and retry. They deliver immediately or never. Enabling greylisting means maintaining manual whitelists or losing valid messages. While I'm not willing to use greylisting for every connection, and I'm not willing to block connections from Windows computers, I am willing to greylist all email from Windows computers. =head1 CONFIGURATION Configuration consists of two steps: starting p0f and configuring this plugin. =head2 start p0f Create a startup script for p0f that creates a communication socket when your server starts up. p0f v2 example: p0f -u qpsmtpd -d -q -Q /tmp/.p0f_socket2 'dst port 25' -o /dev/null chown qpsmtpd /tmp/.p0f_socket2 p0f v3 example: p0f -u qpsmtpd -d -s /tmp/.p0f_socket3 'dst port 25' chown qpsmtpd /tmp/.p0f_socket3 =head2 configure p0f plugin add an entry to config/plugins to enable p0f: ident/p0f /tmp/.p0f_socket3 It's even possible to run both versions of p0f simultaneously: ident/p0f:2 /tmp/.p0f_socket2 version 2 ident/p0f:3 /tmp/.p0f_socket3 =head2 local_ip Use I to override the IP address of your mail server. This is useful if your mail server runs on a private IP behind a firewall. My mail server has the IP 127.0.0.6, but the world knows my mail server as 208.75.177.101. Example config/plugins entry with local_ip override: ident/p0f /tmp/.p0f_socket local_ip 208.75.177.101 =head2 version The version settings specifies the version of p0f you are running. This plugin supports p0f versions 2 and 3. If version is not defined, version 3 is assumed. Example entry specifying p0f version 2 ident/p0f /tmp/.p0f_socket version 2 =head2 smite_os Assign -1 karma to senders whose OS match the regex pattern supplied. I only recommend using with this p0f 3, as it's OS database is far more reliable than p0f v2. Example entry: ident/p0f /tmp/.p0f_socket smite_os windows =head1 Environment requirements p0f v3 requires only the remote IP. p0f v2 requires four pieces of information to look up the p0f fingerprint: local_ip, local_port, remote_ip, and remote_port. TcpServer.pm has been has been updated to provide that information when running under djb's tcpserver. The async, forkserver, and prefork models will likely require some additional changes to make sure these fields are populated. =head1 ACKNOWLEDGEMENTS Version 2 code heavily based upon the p0fq.pl included with the p0f distribution. =head1 AUTHORS 2004 - Robert Spier ( original author ) 2010 - Matt Simerson - added local_ip option 2012 - Matt Simerson - refactored, added v3 support =cut use strict; use warnings; use Qpsmtpd::Constants; use IO::Socket; use Net::IP; my $QUERY_MAGIC_V2 = 0x0defaced; my $QUERY_MAGIC_V3 = 0x50304601; my $RESP_MAGIC_V3 = 0x50304602; my $P0F_STATUS_BADQUERY = 0x00; my $P0F_STATUS_OK = 0x10; my $P0F_STATUS_NOMATCH = 0x20; sub register { my ($self, $qp, $p0f_socket, %args) = @_; $p0f_socket =~ /(.*)/; # untaint $self->{_args}->{p0f_socket} = $1; foreach (keys %args) { $self->{_args}->{$_} = $args{$_}; } } sub hook_connect { my ($self, $qp) = @_; my $p0f_version = $self->{_args}{version} || 3; if ($p0f_version == 3) { my $response = $self->query_p0f_v3() or return DECLINED; $self->test_v3_response($response) or return DECLINED; $self->store_v3_results($response); } else { my $response = $self->query_p0f_v2() or return DECLINED; $self->test_v2_response($response) or return DECLINED; $self->store_v2_results($response); } return DECLINED; } sub get_v2_query { my $self = shift; my $local_ip = $self->{_args}{local_ip} || $self->qp->connection->local_ip; my $src = new Net::IP($self->qp->connection->remote_ip) or $self->log(LOGERROR, "skip, " . Net::IP::Error()), return; my $dst = new Net::IP($local_ip) or $self->log(LOGERROR, "skip, " . NET::IP::Error()), return; return pack("L L L N N S S", $QUERY_MAGIC_V2, 1, rand ^ 42 ^ time, $src->intip(), $dst->intip(), $self->qp->connection->remote_port, $self->qp->connection->local_port); } sub get_v3_query { my $self = shift; my $src_ip = $self->qp->connection->remote_ip or do { $self->log(LOGERROR, "skip, unable to determine remote IP"); return; }; if ($src_ip =~ /:/) { # IPv6 my @bits = split(/\:/, $src_ip); return pack("L C C C C C C C C C C C C C C C C C", $QUERY_MAGIC_V3, 0x06, @bits); } my @octets = split(/\./, $src_ip); return pack("L C C16", $QUERY_MAGIC_V3, 0x04, @octets); } sub query_p0f_v3 { my $self = shift; my $p0f_socket = $self->{_args}{p0f_socket} or do { $self->log(LOGERROR, "skip, socket not defined in config."); return; }; my $query = $self->get_v3_query() or return; # Open the connection to p0f my $sock; eval { $sock = IO::Socket::UNIX->new(Peer => $p0f_socket, Type => SOCK_STREAM); }; if (!$sock) { $self->log(LOGERROR, "skip, could not open socket: $@"); return; } $sock->autoflush(1); # paranoid redundancy $sock->connected or do { $self->log(LOGERROR, "skip, socket not connected: $!"); return; }; my $sent = $sock->send($query, 0) or do { $self->log(LOGERROR, "skip, send failed: $!"); return; }; print $sock $query ; # yes, this is redundant, but I get no response from p0f otherwise $self->log(LOGDEBUG, "sent $sent byte request"); my $response; $sock->recv($response, 232); my $length = length $response; $self->log(LOGDEBUG, "received $length byte response"); close $sock; return $response; } sub query_p0f_v2 { my $self = shift; my $p0f_socket = $self->{_args}->{p0f_socket}; my $query = $self->get_v2_query() or return; # Open the connection to p0f socket(SOCK, PF_UNIX, SOCK_STREAM, 0) or $self->log(LOGERROR, "socket: $!"), return; connect(SOCK, sockaddr_un($p0f_socket)) or $self->log(LOGERROR, "connect: $! ($p0f_socket)"), return; defined syswrite SOCK, $query or $self->log(LOGERROR, "write: $!"), close SOCK, return; my $response; defined sysread SOCK, $response, 1024 or $self->log(LOGERROR, "read: $!"), close SOCK, return; close SOCK; return $response; } sub test_v2_response { my ($self, $response) = @_; # Extract part of the p0f response my ($magic, $id, $type) = unpack("L L C", $response); # $self->log(LOGERROR, $response); if ($magic != $QUERY_MAGIC_V2) { $self->log(LOGERROR, "skip, Bad response magic."); return; } if ($type == 1) { $self->log(LOGERROR, "skip, p0f did not honor our query"); return; } elsif ($type == 2) { $self->log(LOGWARN, "skip, connection not in the cache"); return; } return 1; } sub test_v3_response { my ($self, $response) = @_; my ($magic, $status) = unpack("L L", $response); # check the magic response value (a p0f constant) if ($magic != $RESP_MAGIC_V3) { $self->log(LOGERROR, "skip, Bad response magic."); return; } # check the response status if ($status == $P0F_STATUS_BADQUERY) { $self->log(LOGERROR, "skip, bad query"); return; } elsif ($status == $P0F_STATUS_NOMATCH) { $self->log(LOGINFO, "skip, no match"); return; } if ($status == $P0F_STATUS_OK) { $self->log(LOGDEBUG, "pass, query ok"); return 1; } return; } sub store_v2_results { my ($self, $response) = @_; my ( $magic, $id, $type, $genre, $detail, $dist, $link, $tos, $fw, $nat, $real, $score, $mflags, $uptime ) = unpack("L L C Z20 Z40 c Z30 Z30 C C C s S N", $response); my $p0f = { genre => $genre, detail => $detail, distance => $dist, link => $link, uptime => $uptime, }; $self->connection->notes('p0f', $p0f); $self->log(LOGINFO, $genre . " (" . $detail . ")"); $self->log(LOGERROR, "error: $@") if $@; return $p0f; } sub store_v3_results { my ($self, $response) = @_; my @labels = qw/ magic status first_seen last_seen total_conn uptime_min up_mod_days last_nat last_chg distance bad_sw os_match_q os_name os_flavor http_name http_flavor link_type language /; my @values = unpack("L L L L L L L L L s C C A32 A32 A32 A32 A32 A32 A32", $response); my %r; foreach my $i (0 .. (scalar @labels - 1)) { next if !defined $values[$i]; next if !defined $values[$i]; $r{$labels[$i]} = $values[$i]; } if ($r{os_name}) { # compat with p0f v2 $r{genre} = "$r{os_name} $r{os_flavor}"; $r{link} = $r{link_type} if $r{link_type}; $r{uptime} = $r{uptime_min} if $r{uptime_min}; } if ($r{genre} && $self->{_args}{smite_os}) { my $sos = $self->{_args}{smite_os}; $self->adjust_karma(-1) if $r{genre} =~ /$sos/i; } $self->connection->notes('p0f', \%r); $self->log(LOGINFO, "$r{os_name} $r{os_flavor}"); $self->log(LOGDEBUG, join(' ', @values)); $self->log(LOGERROR, "error: $@") if $@; return \%r; } qpsmtpd-0.94/plugins/karma000066400000000000000000000456651240247602400156560ustar00rootroot00000000000000#!perl -w =head1 NAME karma - reward nice and penalize naughty mail senders =head1 SYNOPSIS Karma tracks sender history, allowing us to provide differing levels of service to naughty, nice, and unknown senders. =head1 DESCRIPTION Karma records the number of nice, naughty, and total connections from mail senders. After sending a naughty message, if a sender has more naughty than nice connections, they are penalized for I. Connections from senders in the penalty box are rejected per the settings in I. Karma provides other plugins with a karma value they can use to be more lenient, strict, or skip processing entirely. Karma is small, fast, and ruthlessly efficient. Karma can be used to craft custom connection policies such as these two examples: =over 4 Hi there, well known and well behaved sender. Please help yourself to greater concurrency (hosts_allow), multiple recipients (karma), and no delays (early_sender). Hi there, naughty sender. You get a max concurrency of 1, max recipients of 2, and SMTP delays. =back =head1 CONFIG =head2 negative How negative a senders karma can get before we penalize them for sending a naughty message. Karma is the number of nice - naughty connections. Default: 1 Examples: negative 1: 0 nice - 1 naughty = karma -1, penalize negative 1: 1 nice - 1 naughty = karma 0, okay negative 2: 1 nice - 2 naughty = karma -1, okay negative 2: 1 nice - 3 naughty = karma -2, penalize With the default negative limit of one, there's a very small chance you could penalize a "mostly good" sender. Raising it to 2 reduces that possibility to improbable. =head2 penalty_days The number of days a naughty sender is refused connections. Use a decimal value to penalize for portions of days. karma penalty_days 1 Default: 1 =head2 reject karma reject [ 0 | 1 | connect | naughty ] I<0> will not reject any connections. I<1> will reject naughty senders. I is the most efficient setting. To reject at any other connection hook, use the I setting and the B plugin. =head2 db_dir Path to a directory in which the DB will be stored. This directory must be writable by the qpsmtpd user. If unset, the first usable directory from the following list will be used: =over 4 =item /var/lib/qpsmtpd/karma =item I/var/db (where BINDIR is the location of the qpsmtpd binary) =item I/config =back =head2 loglevel Adjust the quantity of logging for this plugin. See docs/logging.pod =head1 BENEFITS Karma reduces the resources wasted by naughty mailers. When used with I, naughty senders are disconnected in about 0.1 seconds. The biggest gains to be had are by having heavy plugins (spamassassin, dspam, virus filters) set the B connection note (see KARMA) when they encounter naughty senders. Reasons to send servers to the penalty box could include sending a virus, early talking, or sending messages with a very high spam score. This plugin does not penalize connections with transaction notes I or I set. These notes would have been set by the B, B, and B plugins. Obviously, those plugins must run before B for that to work. =head1 KARMA No attempt is made by this plugin to determine karma. It is up to other plugins to reward well behaved senders with positive karma and smite poorly behaved senders with negative karma. See B After the connection ends, B will record the result. Mail servers whose naughty connections exceed nice ones are sent to the penalty box. Servers in the penalty box will be tersely disconnected for I. Here is an example connection from an IP in the penalty box: 73122 Connection from smtp.midsetmediacorp.com [64.185.226.65] 73122 (connect) ident::geoip: US, United States 73122 (connect) ident::p0f: Windows 7 or 8 73122 (connect) earlytalker: pass: 64.185.226.65 said nothing spontaneous 73122 (connect) relay: skip: no match 73122 (connect) karma: fail 73122 550 You were naughty. You are cannot connect for 0.99 more days. 73122 click, disconnecting 73122 (post-connection) connection_time: 1.048 s. If we only set negative karma, we will almost certainly penalize servers we want to receive mail from. For example, a Yahoo user sends an egregious spam to a user on our server. Now nobody on our server can receive email from that Yahoo server for I. This should happen approximately 0% of the time if we are careful to also set positive karma. =head1 KARMA HISTORY Karma maintains a history for each IP. When a senders history has decreased below -5 and they have never sent a good message, they get a karma bonus. The bonus tacks on an extra day of blocking for every naughty message they send. Example: an unknown sender delivers a spam. They get a one day penalty_box. After 5 days, 5 spams, 5 penalties, and 0 nice messages, they get a six day penalty. The next offense gets a 7 day penalty, and so on. =head1 USING KARMA To get rid of naughty connections as fast as possible, run karma before other connection plugins. Plugins that trigger DNS lookups or impose time delays should run after B. In this example, karma runs before all but the ident plugins. 89011 Connection from Unknown [69.61.27.204] 89011 (connect) ident::geoip: US, United States 89011 (connect) ident::p0f: Linux 3.x 89011 (connect) karma: fail, 1 naughty, 0 nice, 1 connects 89011 550 You were naughty. You are penalized for 0.99 more days. 89011 click, disconnecting 89011 (post-connection) connection_time: 0.118 s. 88798 cleaning up after 89011 Unlike RBLs, B only penalizes IPs that have sent us spam, and only when those senders have sent us more spam than ham. =head1 USING KARMA IN OTHER PLUGINS This plugin sets the connection note I. Your plugin can use the senders karma to be more gracious or rude to senders. The value of I is the number of nice connections minus naughty ones. The higher the number, the better you should treat the sender. To alter a connections karma based on its behavior, do this: $self->adjust_karma( -1 ); # lower karma (naughty) $self->adjust_karma( 1 ); # raise karma (good) =head1 EFFECTIVENESS In the first 24 hours, B rejected 8% of all connections. After one week of running with I, karma has rejected 15% of all connections. This plugins effectiveness results from the propensity of naughty senders to be repeat offenders. Limiting them to a single offense per day(s) greatly reduces the resources they can waste. Of the connections that had previously passed all other checks and were caught only by spamassassin and/or dspam, B rejected 31 percent. Since spamassassin and dspam consume more resources than others plugins, this plugin seems to be a very big win. =head1 DATABASE Connection summaries are stored in a database. The database key is the integer value of the remote IP. The DB value is a : delimited list containing a penalty box start time (if the server is/was on timeout) and the count of naughty, nice, and total connections. The database can be listed and searched with the karma_tool script. =head1 BUGS & LIMITATIONS This plugin is reactionary. Like the FBI, it doesn't do anything until after a crime has been committed. There is little to be gained by listing servers that are already on DNS blacklists, send to invalid users, earlytalkers, etc. Those already have very lightweight tests. =head1 TODO * Avoid storing results for DNSBL listed IPs * some type of ASN integration, for tracking karma of 'neighborhoods' =head1 AUTHOR 2013 - MS - Addeded penalty for spammy TLDs 2012 - Matt Simerson - msimerson@cpan.org =head1 ACKNOWLEDGEMENTS Gavin Carr's DB implementation in the greylisting plugin. =cut use strict; use warnings; use Qpsmtpd::Constants; BEGIN { @AnyDBM_File::ISA = qw(DB_File GDBM_File NDBM_File) } use AnyDBM_File; use Fcntl qw(:DEFAULT :flock LOCK_EX LOCK_NB); use Net::IP; sub register { my ($self, $qp) = (shift, shift); $self->log(LOGERROR, "Bad arguments") if @_ % 2; $self->{_args} = {@_}; $self->{_args}{negative} ||= 1; $self->{_args}{penalty_days} ||= 1; $self->{_args}{reject_type} ||= 'disconnect'; if (!defined $self->{_args}{reject}) { $self->{_args}{reject} = 'naughty'; } #$self->prune_db(); # keep the DB compact $self->register_hook('connect', 'connect_handler'); $self->register_hook('mail', 'from_handler'); $self->register_hook('rcpt', 'rcpt_handler'); $self->register_hook('data', 'data_handler'); $self->register_hook('data_post', 'data_handler'); $self->register_hook('disconnect', 'disconnect_handler'); } sub hook_pre_connection { my ($self, $transaction, %args) = @_; $self->connection->notes('karma_history', 0); my $remote_ip = $args{remote_ip}; my $db = $self->get_db_location(); my $lock = $self->get_db_lock($db) or return DECLINED; my $tied = $self->get_db_tie($db, $lock) or return DECLINED; my $key = $self->get_db_key($remote_ip) or do { $self->log(LOGINFO, "skip, unable to get DB key"); return DECLINED; }; if (!$tied->{$key}) { $self->log(LOGDEBUG, "pass, no record"); return $self->cleanup_and_return($tied, $lock); } my ($penalty_start_ts, $naughty, $nice, $connects) = $self->parse_db_record($tied->{$key}); $self->calc_karma($naughty, $nice); return $self->cleanup_and_return($tied, $lock); } sub connect_handler { my $self = shift; $self->connection->notes('karma', 0); # default return DECLINED if $self->is_immune(); my $db = $self->get_db_location(); my $lock = $self->get_db_lock($db) or return DECLINED; my $tied = $self->get_db_tie($db, $lock) or return DECLINED; my $key = $self->get_db_key() or do { $self->log(LOGINFO, "skip, unable to get DB key"); return DECLINED; }; if (!$tied->{$key}) { $self->log(LOGINFO, "pass, no record"); return $self->cleanup_and_return($tied, $lock); } my ($penalty_start_ts, $naughty, $nice, $connects) = $self->parse_db_record($tied->{$key}); my $summary = "$naughty naughty, $nice nice, $connects connects"; my $karma = $self->calc_karma($naughty, $nice); if (!$penalty_start_ts) { $self->log(LOGINFO, "pass, no penalty ($summary)"); return $self->cleanup_and_return($tied, $lock); } my $days_old = (time - $penalty_start_ts) / 86400; if ($days_old >= $self->{_args}{penalty_days}) { $self->log(LOGINFO, "pass, penalty expired ($summary)"); return $self->cleanup_and_return($tied, $lock); } $tied->{$key} = join(':', $penalty_start_ts, $naughty, $nice, ++$connects); $self->cleanup_and_return($tied, $lock); my $left = sprintf "%.2f", $self->{_args}{penalty_days} - $days_old; my $mess = "You were naughty. You cannot connect for $left more days."; return $self->get_reject($mess, $karma); } sub from_handler { my ($self,$transaction, $sender, %args) = @_; # test if sender has placed an illegal (RFC (2)821) space in envelope from my $full_from = $self->connection->notes('envelope_from'); $self->illegal_envelope_format( $full_from ); my %spammy_tlds = ( map { $_ => 4 } qw/ info pw /, map { $_ => 3 } qw/ tw biz /, map { $_ => 2 } qw/ cl br fr be jp no se sg /, ); foreach my $tld ( keys %spammy_tlds ) { my $len = length $tld; my $score = $spammy_tlds{$tld} or next; $len ++; if ( $sender->host && ".$tld" eq substr($sender->host,-$len,$len) ) { $self->log(LOGINFO, "penalizing .$tld envelope sender"); $self->adjust_karma(-$score); }; }; return DECLINED; }; sub rcpt_handler { my ($self,$transaction, $recipient, %args) = @_; $self->illegal_envelope_format( $self->connection->notes('envelope_rcpt'), ); my $count = $self->connection->notes('recipient_count') || 0; $count++; if ( $count > 1 ) { $self->log(LOGINFO, "recipients c: $count ($recipient)"); $self->connection->notes('recipient_count', $count); }; return DECLINED if $self->is_immune(); my $recipients = scalar $self->transaction->recipients or do { $self->log(LOGDEBUG, "info, no recipient count"); return DECLINED; }; $self->log(LOGINFO, "recipients t: $recipients ($recipient)"); my $history = $self->connection->notes('karma_history'); if ( $history > 0 ) { $self->log(LOGINFO, "info, good history"); return DECLINED; }; my $karma = $self->connection->notes('karma'); if ( $karma > 0 ) { $self->log(LOGINFO, "info, good connection"); return DECLINED; }; # limit # of recipients if host has negative or unknown karma return (DENY, "too many recipients for karma $karma (h: $history)"); } sub data_handler { my ($self, $transaction) = @_; return DECLINED if $self->is_immune(); return DECLINED if $self->is_naughty(); # let naughty do it # cutting off a naughty sender at DATA prevents having to receive the message my $karma = $self->connection->notes('karma'); if ( $karma < -4 ) { # bad karma return $self->get_reject("very bad karma: $karma"); }; return DECLINED; } sub disconnect_handler { my $self = shift; my $karma = $self->connection->notes('karma') or do { $self->log(LOGDEBUG, "no karma"); return DECLINED; }; my $db = $self->get_db_location(); my $lock = $self->get_db_lock($db) or return DECLINED; my $tied = $self->get_db_tie($db, $lock) or return DECLINED; my $key = $self->get_db_key(); my ($penalty_start_ts, $naughty, $nice, $connects) = $self->parse_db_record($tied->{$key}); my $history = ($nice || 0) - $naughty; my $log_mess = ''; if ($karma < -2) { # they achieved at least 2 strikes $history--; my $negative_limit = 0 - $self->{_args}{negative}; if ($history <= $negative_limit) { if ($nice == 0 && $history < -5) { $log_mess = ", penalty box bonus!"; $penalty_start_ts = sprintf "%s", time + abs($history) * 86400; } else { $penalty_start_ts = sprintf "%s", time; } $log_mess = "negative, sent to penalty box" . $log_mess; } else { $log_mess = "negative"; } } elsif ($karma > 2) { $nice++; $log_mess = "positive"; } else { $log_mess = "neutral"; } $self->log(LOGINFO, $log_mess . ", (msg: $karma, his: $history)"); $tied->{$key} = join(':', $penalty_start_ts, $naughty, $nice, ++$connects); return $self->cleanup_and_return($tied, $lock); } sub illegal_envelope_format { my ($self, $addr) = @_; # test if envelope address has an illegal (RFC (2)821) space if ( uc substr($addr,0,6) ne 'FROM:<' && uc substr($addr,0,4) ne 'TO:<' ) { $self->log(LOGINFO, "illegal envelope address format: $addr" ); $self->adjust_karma(-2); }; }; sub parse_db_record { my ($self, $value) = @_; my $penalty_start_ts = my $naughty = my $nice = my $connects = 0; if ($value) { ($penalty_start_ts, $naughty, $nice, $connects) = split /:/, $value; $penalty_start_ts ||= 0; $nice ||= 0; $naughty ||= 0; $connects ||= 0; } return ($penalty_start_ts, $naughty, $nice, $connects); } sub calc_karma { my ($self, $naughty, $nice) = @_; return 0 if (!$naughty && !$nice); my $karma = ($nice || 0) - ($naughty || 0); $self->connection->notes('karma_history', $karma); $self->adjust_karma(1) if $karma > 10; return $karma; } sub cleanup_and_return { my ($self, $tied, $lock, $return_val) = @_; untie $tied; close $lock; return ($return_val) if defined $return_val; # explicit override return (DECLINED); } sub get_db_key { my $self = shift; my $ip = shift || $self->qp->connection->remote_ip; my $nip = Net::IP->new($ip) or do { $self->log(LOGERROR, "skip, unable to determine remote IP"); return; }; return $nip->intip; # convert IP to an int } sub get_db_tie { my ($self, $db, $lock) = @_; tie(my %db, 'AnyDBM_File', $db, O_CREAT | O_RDWR, 0600) or do { $self->log(LOGCRIT, "error, tie to database $db failed: $!"); close $lock; return; }; return \%db; } sub get_db_location { my $self = shift; # Setup database location my ($QPHOME) = ($0 =~ m!(.*?)/([^/]+)$!); my @candidate_dirs = ( $self->{args}{db_dir}, "/var/lib/qpsmtpd/karma", "$QPHOME/var/db", "$QPHOME/config", '.' ); my $dbdir; for my $d (@candidate_dirs) { next if !$d || !-d $d; # impossible $dbdir = $d; last; # first match wins } my $db = "$dbdir/karma.dbm"; $self->log(LOGDEBUG, "using $db as karma database"); return $db; } sub get_db_lock { my ($self, $db) = @_; return $self->get_db_lock_nfs($db) if $self->{_args}{nfslock}; # Check denysoft db open(my $lock, ">$db.lock") or do { $self->log(LOGCRIT, "error, opening lockfile failed: $!"); return; }; flock($lock, LOCK_EX) or do { $self->log(LOGCRIT, "error, flock of lockfile failed: $!"); close $lock; return; }; return $lock; } sub get_db_lock_nfs { my ($self, $db) = @_; require File::NFSLock; ### set up a lock - lasts until object looses scope my $nfslock = new File::NFSLock { file => "$db.lock", lock_type => LOCK_EX | LOCK_NB, blocking_timeout => 10, # 10 sec stale_lock_timeout => 30 * 60, # 30 min } or do { $self->log(LOGCRIT, "error, nfs lockfile failed: $!"); return; }; open(my $lock, "+<$db.lock") or do { $self->log(LOGCRIT, "error, opening nfs lockfile failed: $!"); return; }; return $lock; } sub prune_db { my $self = shift; my $db = $self->get_db_location(); my $lock = $self->get_db_lock($db) or return DECLINED; my $tied = $self->get_db_tie($db, $lock) or return DECLINED; my $count = keys %$tied; my $pruned = 0; foreach my $key (keys %$tied) { my $ts = $tied->{$key}; my $days_old = (time - $ts) / 86400; next if $days_old < $self->{_args}{penalty_days} * 2; delete $tied->{$key}; $pruned++; } untie $tied; close $lock; $self->log(LOGINFO, "pruned $pruned of $count DB entries"); return $self->cleanup_and_return($tied, $lock, DECLINED); } qpsmtpd-0.94/plugins/karma_tool000077500000000000000000000165131240247602400167040ustar00rootroot00000000000000#!/usr/bin/perl package Karma; use strict; use warnings; BEGIN { @AnyDBM_File::ISA = qw(DB_File GDBM_File NDBM_File) } use AnyDBM_File; use Data::Dumper; use Fcntl qw(:DEFAULT :flock LOCK_EX LOCK_NB); use Net::IP qw(:PROC); use POSIX qw(strftime); my $self = bless({args => {db_dir => 'config'},}, 'Karma'); my $command = $ARGV[0]; if (!$command) { $self->usage(); } elsif ($command eq 'capture') { $self->capture($ARGV[1]); } elsif ($command eq 'release') { $self->release($ARGV[1]); } elsif ($command eq 'prune') { $self->prune_db($ARGV[1] || 7); } elsif ($command eq 'search' && is_ip($ARGV[1])) { $self->show_ip($ARGV[1]); } elsif ($command eq 'list' | $command eq 'search') { $self->main(); } exit(0); sub usage { print < ] and returns a list of matching IPs capture [ IP ] sends an IP to the penalty box release [ IP ] remove an IP from the penalty box prune takes no arguments. prunes database of entries older than 7 days EO_HELP ; } sub capture { my $self = shift; my $ip = shift or return; is_ip($ip) or do { warn "not an IP: $ip\n"; return; }; my $db = $self->get_db_location(); my $lock = $self->get_db_lock($db) or return; my $tied = $self->get_db_tie($db, $lock) or return; my $key = $self->get_db_key($ip); my ($penalty_start_ts, $naughty, $nice, $connects) = split /:/, $tied->{$key}; $tied->{$key} = join(':', time, $naughty + 1, $nice, $connects); return $self->cleanup_and_return($tied, $lock); } sub release { my $self = shift; my $ip = shift or return; is_ip($ip) or do { warn "not an IP: $ip\n"; return; }; my $db = $self->get_db_location(); my $lock = $self->get_db_lock($db) or return; my $tied = $self->get_db_tie($db, $lock) or return; my $key = $self->get_db_key($ip); my ($penalty_start_ts, $naughty, $nice, $connects) = split /:/, $tied->{$key}; $tied->{$key} = join(':', 0, 0, $nice, $connects); return $self->cleanup_and_return($tied, $lock); } sub show_ip { my $self = shift; my $ip = shift or return; my $db = $self->get_db_location(); my $lock = $self->get_db_lock($db) or return; my $tied = $self->get_db_tie($db, $lock) or return; my $key = $self->get_db_key($ip); my ($penalty_start_ts, $naughty, $nice, $connects) = split /:/, $tied->{$key}; $naughty ||= 0; $nice ||= 0; $connects ||= 0; my $time_human = ''; if ($penalty_start_ts) { $time_human = strftime "%a %b %e %H:%M", localtime $penalty_start_ts; } my $hostname = `dig +short -x $ip` || ''; chomp $hostname; print " IP Address Penalty Naughty Nice Connects Hostname\n"; printf(" %-18s %24s %3s %3s %3s %-30s\n", $ip, $time_human, $naughty, $nice, $connects, $hostname); } sub main { my $self = shift; my $db = $self->get_db_location(); my $lock = $self->get_db_lock($db) or return; my $tied = $self->get_db_tie($db, $lock) or return; my %totals; print " IP Address Penalty Naughty Nice Connects Hostname\n"; foreach my $r (sort keys %$tied) { my $ip = ip_bintoip(ip_inttobin($r, 4), 4); my ($penalty_start_ts, $naughty, $nice, $connects) = split /:/, $tied->{$r}; $naughty ||= ''; $nice ||= ''; $connects ||= ''; my $time_human = ''; if ($command eq 'search') { my $search = $ARGV[1]; if ($search eq 'nice') { next if !$nice; } elsif ($search eq 'naughty') { next if !$naughty; } elsif ($search eq 'both') { next if !$naughty || !$nice; } elsif (is_ip($ARGV[1]) && $search ne $ip) { next; } } if ($penalty_start_ts) { $time_human = strftime "%a %b %e %H:%M", localtime $penalty_start_ts; } my $hostname = ''; if ($naughty && $nice) { #$hostname = `dig +short -x $ip`; chomp $hostname; } printf(" %-18s %24s %3s %3s %3s %30s\n", $ip, $time_human, $naughty, $nice, $connects, $hostname); $totals{naughty} += $naughty if $naughty; $totals{nice} += $nice if $nice; $totals{connects} += $connects if $connects; } print Dumper(\%totals); } sub is_ip { my $ip = shift || $ARGV[0]; new Net::IP($ip) or return; return 1; } sub cleanup_and_return { my ($self, $tied, $lock) = @_; untie $tied; close $lock; } sub get_db_key { my $self = shift; my $nip = Net::IP->new(shift) or return; return $nip->intip; # convert IP to an int } sub get_db_tie { my ($self, $db, $lock) = @_; tie(my %db, 'AnyDBM_File', $db, O_CREAT | O_RDWR, 0600) or do { warn "tie to database $db failed: $!"; close $lock; return; }; return \%db; } sub get_db_location { my $self = shift; # Setup database location my @candidate_dirs = ( $self->{args}{db_dir}, "/var/lib/qpsmtpd/karma", "./var/db", "./config", '.' ); my $dbdir; for my $d (@candidate_dirs) { next if !$d || !-d $d; # impossible $dbdir = $d; last; # first match wins } my $db = "$dbdir/karma.dbm"; print "using karma db at $db\n"; return $db; } sub get_db_lock { my ($self, $db) = @_; return $self->get_db_lock_nfs($db) if $self->{_args}{nfslock}; # Check denysoft db open(my $lock, ">$db.lock") or do { warn "opening lockfile failed: $!"; return; }; flock($lock, LOCK_EX) or do { warn "flock of lockfile failed: $!"; close $lock; return; }; return $lock; } sub get_db_lock_nfs { my ($self, $db) = @_; require File::NFSLock; ### set up a lock - lasts until object looses scope my $nfslock = new File::NFSLock { file => "$db.lock", lock_type => LOCK_EX | LOCK_NB, blocking_timeout => 10, # 10 sec stale_lock_timeout => 30 * 60, # 30 min } or do { warn "nfs lockfile failed: $!"; return; }; open(my $lock, "+<$db.lock") or do { warn "opening nfs lockfile failed: $!"; return; }; return $lock; } sub prune_db { my $self = shift; my $prune_days = shift; my $db = $self->get_db_location(); my $lock = $self->get_db_lock($db) or return; my $tied = $self->get_db_tie($db, $lock) or return; my $count = keys %$tied; my $pruned = 0; foreach my $key (keys %$tied) { my ($ts, $naughty, $nice, $connects) = split /:/, $tied->{$key}; my $days_old = (time - $ts) / 86400; next if $days_old < $prune_days; delete $tied->{$key}; $pruned++; } untie $tied; close $lock; warn "pruned $pruned of $count DB entries"; return $self->cleanup_and_return($tied, $lock); } qpsmtpd-0.94/plugins/loadcheck000066400000000000000000000104341240247602400164620ustar00rootroot00000000000000#!/usr/bin/perl =head1 NAME loadcheck =head1 DESCRIPTION Only takes email transactions if the system load is at or below a specified level. If this is running on a system that provides /kern/loadavg or /proc/loadavg it will be used instead of the 'uptime' command. Once a load value is determined, it is cached for a period of time. See the cache_time below. Since fork/exec is expensive in perl, if using the 'uptime' method, use cache_time to avoid increasing your load on every connection. =head1 CONFIG max_load This is the 1 minute system load where we won't take transactions if our load is higher than this value. (Default: 7) cache_time A recently determined load value will be cached and used for the assigned number of seconds. (Default: 10) uptime The path to the command 'uptime' if different than the default. (Default: /usr/bin/uptime) Example: loadcheck cache_time 30 loadcheck max_load 7 uptime /usr/bin/uptime =head1 SEE ALSO Original version: http://www.nntp.perl.org/group/perl.qpsmtpd/2006/01/msg4422.html Variant with caching: http://www.nntp.perl.org/group/perl.qpsmtpd/2006/03/msg4710.html Steve Kemp's announcement of an alternate load limiter: http://www.nntp.perl.org/group/perl.qpsmtpd/2008/03/msg7814.html =head1 AUTHOR Written by Peter Eisch . =head1 CHANGES v0.03 - msimerson - 2014-03-21 * refactored "find the way to get load avg" out of loadcheck (every connection) into get_load_method which is run in register. If we can't get the load average, don't register the hook. * added BSD::getloadavg method (tested on FreeBSD) v0.02 - github@rsiddall - resurrected from list archives =cut my $VERSION = 0.03; sub register { my ($self, $qp, @args) = @_; $self->{_args} = { @args }; $self->{_args}{max_load} ||= 7; $self->{_args}{uptime} ||= '/usr/bin/uptime'; $self->{_args}{cache_time} ||= 10; $self->{_load} = -1; $self->{_time} = 0; $self->{_method} = $self->get_load_method(); # only register the hook if we can measure load if (ref $self->{_method} eq 'CODE') { $self->register_hook("connect", "loadcheck"); } } sub loadcheck { my ($self, $transaction) = @_; if (time() > ($self->{_time} + $self->{_args}{cache_time})) { # cache value expired, update $self->{_method}->(); $self->{_time} = time(); }; if ($self->{_load} > $self->{_args}{max_load}) { $self->log(LOGERROR, "local load too high: $self->{_load}"); return (DENYSOFT, "Server load too high, please try again later."); } return (DECLINED, "continuing with load: $self->{_load}"); } sub get_load_method { my ($self) = @_; eval "use BSD::getloadavg;"; if (!$@) { return sub { require BSD::getloadavg; $self->{_load} = (getloadavg())[0]; $self->log(LOGDEBUG, "BSD::getloadavg reported: $self->{_load}"); } } if (-r '/kern/loadavg') { # *BSD return sub { open(LD, '<', "/kern/loadavg"); # contains fix-point scaling value my $res = ; close LD; my @vals = split(/ /, $res); $self->{_load} = ($vals[0] / $vals[3]); $self->log(LOGDEBUG, "/kern/loadavg reported: $self->{_load}"); } } if (-r '/proc/loadavg') { # *inux return sub { open(LD, "<", "/proc/loadavg"); # contains decimal value my $res = ; # contains fix-point scaling value close LD; $self->{_load} = (split(/ /, $res))[0]; $self->log(LOGDEBUG, "/proc/loadavg reported: $self->{_load}"); } } if (-x $self->{_args}{uptime}) { return sub { # the various formats returned: # 10:33AM up 2:06, 1 user, load averages: 6.55, 3.76, 2.48 # 12:29am 2 users, load average: 0.05, 0.05, 0.06 # 12:30am up 5 days, 12:43, 1 user, load average: 0.00, 0.00, 0.00 my $res = `$self->{_args}{uptime}`; if ($res =~ /aver\S+: (\d+\.\d+)/) { $self->{_load} = $1; $self->log(LOGDEBUG, "$self->{_args}{uptime} reported: $self->{_load}"); } } } $self->log(LOGERROR, "unable to acquire system load"); return; }; qpsmtpd-0.94/plugins/logging/000077500000000000000000000000001240247602400162465ustar00rootroot00000000000000qpsmtpd-0.94/plugins/logging/adaptive000066400000000000000000000127501240247602400177730ustar00rootroot00000000000000#!perl -w # Adaptive logging plugin - logs at one level for successful messages and # one level for DENY'd messages sub register { my ($self, $qp, %args) = @_; $self->{_minlevel} = LOGERROR; if (defined($args{accept})) { if ($args{accept} =~ /^\d+$/) { $self->{_minlevel} = $args{accept}; } else { $self->{_minlevel} = log_level($args{accept}); } } $self->{_maxlevel} = LOGWARN; if (defined($args{reject})) { if ($args{reject} =~ /^\d+$/) { $self->{_maxlevel} = $args{reject}; } else { $self->{_maxlevel} = log_level($args{reject}); } } $self->{_prefix} = '`'; if (defined $args{prefix} and $args{prefix} =~ /^(.+)$/) { $self->{_prefix} = $1; } # If you want to capture this log entry with this plugin, you need to # wait until after you register the plugin $self->log(LOGINFO, 'Initializing logging::adaptive plugin'); } sub hook_logging { # wlog my ($self, $transaction, $trace, $hook, $plugin, @log) = @_; # Don't log your own log entries! If this is the only logging plugin # then these lines will not be logged at all. You can safely comment # out this line and it will not cause an infinite loop. return DECLINED if defined $plugin and $plugin eq $self->plugin_name; if (defined $self->{_maxlevel} && $trace <= $self->{_maxlevel}) { warn join( " ", $$ . ( defined $plugin ? " $plugin plugin:" : defined $hook ? " running plugin ($hook):" : "" ), @log ), "\n" unless $log[0] =~ /logging::adaptive/; push @{$transaction->{_log}}, [$trace, $hook, $plugin, @log] if (defined $self->{_minlevel} && $trace <= $self->{_minlevel}); } return DECLINED; } sub hook_deny { # dlog my ($self, $transaction, $prev_hook, $return, $return_text) = @_; $self->{_denied} = 1; } sub hook_reset_transaction { # slog # fires when a message is accepted my ($self, $transaction, @args) = @_; return DECLINED if $self->{_denied}; foreach my $row (@{$transaction->{_log}}) { next unless scalar @$row; # skip over empty log lines my ($trace, $hook, $plugin, @log) = @$row; warn join( " ", $$, $self->{_prefix} . ( defined $plugin ? " $plugin plugin:" : defined $hook ? " running plugin ($hook):" : "" ), @log ), "\n" if ($trace <= $self->{_minlevel}); } return DECLINED; } =head1 NAME adaptive - An adaptive logging plugin for qpsmtpd =head1 DESCRIPTION A qpsmtpd plugin for logging at different levels depending on success or failure of any given message. =head1 INSTALL AND CONFIG Place this plugin in the plugin/logging directory beneath the standard qpsmtpd installation. Edit the config/logging file and add a line like this: logging/adaptive [accept minlevel] [reject maxlevel] [prefix char] where the optional parameters are: =over 4 =item B This is the level at which messages which are accepted will be logged. You can use either the loglevel number (as shown in config.sample/loglevels) or you can use the text form (from the same file). Typically, you would set this to LOGERROR (4) so that the FROM and TO lines would be logged (with the default installation). If absent, it will be set to LOGERROR (4). =item B This is the level which messages which are rejected for any reason will be logged. This would typically be set as high as reasonable, to document why a message may have been rejected. If absent, it defaults to LOGWARN (5), which is probably not high enough for most sites. =item B In order to visually distinguish the accepted from rejected lines, all log lines from a accepted message will be prefixed with the character listed here (directly after the PID). You can use anything you want as a prefix, but it is recommended that it be short (preferably just a single character) to minimize the amount of bloat in the log file. If absent, the prefix defaults to the left single quote (`). =back =head1 TYPICAL USAGE If you are using multilog to handle your logging, you can replace the system provided log/run file with something like this: #! /bin/sh export LOGDIR=./main mkdir -p $LOGDIR/failed exec multilog t n10 \ '-*` *' $LOGDIR/detailed \ '-*' '+*` *' $LOGDIR/accepted which will have the following effects: =over 4 =item 1. All lines will be logged into the ./mail/detailed folder =item 2. Log lines for messages that are accepted will go to ./main/accepted =back You may want to use the s####### option to multilog to ensure that the log files are large enough to maintain a proper amount of history. Depending on your site load, it is useful to have at least a week and preferrably three weeks of accepted messages. You can also use the n## option to have more log history files maintained. =head1 AUTHOR John Peacock =head1 COPYRIGHT AND LICENSE Copyright (c) 2005 John Peacock This plugin is licensed under the same terms as the qpsmtpd package itself. Please see the LICENSE file included with qpsmtpd for details. =cut qpsmtpd-0.94/plugins/logging/apache000066400000000000000000000060701240247602400174150ustar00rootroot00000000000000#!perl -w =head1 NAME logging/apache - logging plugin for qpsmtpd which logs to the apache error log =cut # more POD at the end use strict; use warnings FATAL => 'all'; use Apache2::Log; use Apache2::RequestUtil (); use Qpsmtpd::Constants; sub register { my ($self, $qp) = @_; die "Not running under Apache::Qpsmtpd" unless ($qp->{conn} && $qp->{conn}->isa('Apache2::Connection')); my $rr = Apache2::RequestRec->new($self->qp->{conn}); $self->{_log} = $rr->log if $rr; $self->log(LOGINFO, 'Initializing logging::apache plugin'); } sub hook_logging { my ($self, $transaction, $trace, $hook, $plugin, @log) = @_; # Don't log your own log entries! If this is the only logging plugin # then these lines will not be logged at all. You can safely comment # out this line and it will not cause an infinite loop. return DECLINED if defined $plugin and $plugin eq $self->plugin_name; unless ($self->{_log}) { my $rr = Apache2::RequestRec->new($self->qp->{conn}); unless ($rr) { warn "no Apache2::RequestRec?... logmsg was: ", join(" ", @log); return DECLINED; } $self->{_log} = $rr->log; } # luckily apache uses the same log levels as qpsmtpd... ($trace = lc Qpsmtpd::Constants::log_level($trace)) =~ s/^log//; $trace = 'emerg' # ... well, nearly... if $trace eq 'radar'; my $log = $self->{_log}; unless ($log->can($trace)) { # ... but you never know if it changes $log->emerg("Can't log with level '$trace', logmsg was: ", join(" ", @log)); return DECLINED; } $log->$trace( join( " ", $$ . ( defined $plugin ? " $plugin plugin:" : defined $hook ? " running plugin ($hook):" : "" ), @log ) ); # no \n at the end! return DECLINED; } =head1 DESCRIPTION The logging/apache plugin uses the apache logging mechanism to write its messages to the apache error log. =head1 INSTALL AND CONFIG Place this plugin in the plugin/logging directory beneath the standard qpsmtpd installation. Edit the config/logging file and add a line like this: logging/apache To change what is shown in the logs, change the I directive in the virtual host config for Qpsmtpd and maybe change the I log file: PerlSetVar QpsmtpdDir /path/to/qpsmtpd PerlModule Apache::Qpsmtpd PerlProcessConnectionHandler Apache::Qpsmtpd LogLevel debug ErrorLog /var/log/apache2/qpsmtpd.log =head1 AUTHOR Hanno Hecker =head1 COPYRIGHT AND LICENSE Copyright (c) 2007 Hanno Hecker This plugin is licensed under the same terms as the qpsmtpd package itself. Please see the LICENSE file included with qpsmtpd for details. =cut qpsmtpd-0.94/plugins/logging/connection_id000066400000000000000000000051001240247602400210000ustar00rootroot00000000000000#!perl -w # this is a simple 'connection_id' plugin like the default builtin logging # # It demonstrates that a logging plugin can call ->log itself as well # as how to ignore log entries from itself sub register { my ($self, $qp, $loglevel) = @_; die "The connection ID feature is currently unsupported"; $self->{_level} = LOGWARN; if (defined($loglevel)) { if ($loglevel =~ /^\d+$/) { $self->{_level} = $loglevel; } else { $self->{_level} = log_level($loglevel); } } # If you want to capture this log entry with this plugin, you need to # wait until after you register the plugin $self->log(LOGINFO, 'Initializing logging::connection_id plugin'); } sub hook_logging { my ($self, $transaction, $trace, $hook, $plugin, @log) = @_; # Don't log your own log entries! If this is the only logging plugin # then these lines will not be logged at all. You can safely comment # out this line and it will not cause an infinite loop. return DECLINED if defined $plugin and $plugin eq $self->plugin_name; my $connection = $self->qp && $self->qp->connection; # warn "connection = $connection\n"; warn join( " ", ($connection ? $connection->id : "???") . ( defined $plugin ? " $plugin plugin:" : defined $hook ? " running plugin ($hook):" : "" ), @log ), "\n" if ($trace <= $self->{_level}); return DECLINED; } =head1 NAME connection_id - plugin to demo use of the connection id =head1 DESCRIPTION A qpsmtpd plugin which replicates the built in logging functionality, which is to send all logging messages to STDERR below a specific log level. This plugin differs from logging/warn only by using the connection id instead of the pid to demonstrate the effect of different algorithms. =head1 INSTALL AND CONFIG Place this plugin in the plugin/logging directory beneath the standard qpsmtpd installation. Edit the config/logging file and add a line like this: logging/connection_id [loglevel] where the optional parameters C is either the numeric or text representation of the maximum log level, as shown in the L file. =head1 AUTHOR John Peacock =head1 COPYRIGHT AND LICENSE Copyright (c) 2005 John Peacock This plugin is licensed under the same terms as the qpsmtpd package itself. Please see the LICENSE file included with qpsmtpd for details. =cut qpsmtpd-0.94/plugins/logging/devnull000066400000000000000000000001541240247602400176420ustar00rootroot00000000000000#!perl -w # this is a simple 'drop packets on the floor' plugin sub hook_logging { return DECLINED; } qpsmtpd-0.94/plugins/logging/file000066400000000000000000000176061240247602400171220ustar00rootroot00000000000000#!perl -w =head1 NAME file - Simple log-to-file logging for qpsmtpd =head1 DESCRIPTION The 'file' logging plugin for qpsmtpd records qpsmtpd log messages into a file (or a named pipe, if you prefer.) =head1 CONFIGURATION To enable the logging plugin, add a line of this form to the qpsmtpd plugins configuration file: =over logging/file [loglevel I] [reopen] [nosplit] [tsformat I] I For example: logging/file loglevel LOGINFO /var/log/qpsmtpd.log logging/file /var/log/qpsmtpd.log.%Y-%m-%d logging/file loglevel LOGCRIT reopen |/usr/local/sbin/page-sysadmin logging/file loglevel LOGDEBUG tsformat %FT%T /var/log/qpsmtpd.log =back Multiple instances of the plugin can be configured by appending :I for any integer(s) I, to log to multiple files simultaneously, e.g. to log critical errors and normally verbose logs elsewhere. The filename or command given can include strftime conversion specifiers, which can be used to substitute time and date information into the logfile. The file will be reopened whenever this output changes (for example, with a format of qpsmtpd.log.%Y-%m-%d-%h, the log would be reopened once per hour). The list of supported conversion specifiers depends on the strftime() implementation of your C library. See strftime(3) for details. Additionally, %i will be expanded to a (hopefully) unique session-id; if %i is used, a new logfile will be started for each SMTP connection. The following optional configuration setting can be supplied: =over =item nosplit If specified, the output file or pipe will be reopened at once once per connection, and only prior to the first log output. This prevents logs for sessions that span log intervals being split across multiple logfiles. Without this option, the log will be reopened only when its output filename changes; if strftime specifiers are not used, the log will not be reopened at all. =item reopen Forces the log output to be reopened once per connection, as soon as something is available to be logged. This can be combined with a high log severity (see I below) to facilitate SMTP service alarms with Nagios or a similar monitoring agent. =item loglevel I The internal log level below which messages will be logged. The I given should be chosen from the list below. Priorities count downward (for example, if LOGWARN were selected, LOGERROR, LOGCRIT and LOGEMERG messages would be logged as well). =item tsformat I By default qpsmtpd will prepend log items with the date and time as given in the format by perl's C function. If you prefer another format then you can specify a tsformat parameter. =over =item B =item B =item B =item B =item B =item B =item B =item B =back =back The chosen I should be writable by the user running qpsmtpd; it will be created it did not already exist, and appended to otherwise. =head1 AUTHORS Devin Carraway , with contributions by Peter J. Holzer . =head1 LICENSE Copyright (c) 2005-2006, Devin Carraway Copyright (c) 2006, Peter J. Holzer. This plugin is licensed under the same terms as the qpsmtpd package itself. Please see the LICENSE file included with qpsmtpd for details. =cut use strict; use warnings; use IO::File; use Sys::Hostname; use POSIX qw(strftime); use Qpsmtpd::Constants; sub register { my ($self, $qp, @args) = @_; my %args; $self->{_loglevel} = LOGWARN; $self->{_tsformat} = '%a %b %d %T %Y'; # same as scalar localtime while (1) { last if !@args; if (lc $args[0] eq 'loglevel') { shift @args; my $ll = shift @args; if (!defined $ll) { warn "Malformed arguments to logging/file plugin"; return; } if ($ll =~ /^(\d+)$/) { $self->{_loglevel} = $1; } elsif ($ll =~ /^(LOG\w+)$/) { $self->{_loglevel} = log_level($1); defined $self->{_loglevel} or $self->{_loglevel} = LOGWARN; } } elsif (lc $args[0] eq 'nosplit') { shift @args; $self->{_nosplit} = 1; } elsif (lc $args[0] eq 'reopen') { shift @args; $self->{_reopen} = 1; } elsif (lc $args[0] eq 'tsformat') { shift @args; my $format = shift @args; $self->{_tsformat} = $format; } else { last } } unless (@args && $args[0]) { warn "Malformed arguments to syslog plugin"; return; } my $output = join(' ', @args); if ($output =~ /^\s*\|(.*)/) { $self->{_log_pipe} = 1; $self->{_log_format} = $1; } else { $output =~ /^(.*)/; # detaint $self->{_log_format} = $1; } $self->{_current_output} = ''; $self->{_session_counter} = 0; 1; } sub log_output { my ($self, $transaction) = @_; my $output = $self->{_log_format}; $output =~ s/%i/($transaction->notes('logging-session-id') || 'parent')/ge; $output = strftime $output, localtime; $output; } sub open_log { my ($self, $output, $qp) = @_; if ($self->{_log_pipe}) { unless ($self->{_f} = new IO::File "|$output") { warn "Error opening log output to command $output: $!"; return undef; } } else { unless ($self->{_f} = new IO::File ">>$output") { warn "Error opening log output to path $output: $!"; return undef; } } $self->{_current_output} = $output; $self->{_f}->autoflush(1); 1; } # Reopen the output iff the interpolated output filename has changed # from the one currently open, or if reopening was selected and we haven't # yet done so during this session. # # Returns true if the file was reopened, zero if not, undef on error. sub maybe_reopen { my ($self, $transaction) = @_; my $new_output = $self->log_output($transaction); if ( !$self->{_current_output} || $self->{_current_output} ne $new_output || ($self->{_reopen} && !$transaction->notes('file-reopened-this-session')) ) { unless ($self->open_log($new_output, $transaction)) { return undef; } $transaction->notes('file-reopened-this-session', 1); return 1; } return 0; } sub hook_connect { my ($self, $transaction) = @_; $transaction->notes('file-logged-this-session', 0); $transaction->notes('file-reopened-this-session', 0); $transaction->notes( 'logging-session-id', sprintf("%08d-%04d-%d", scalar time, $$, ++$self->{_session_counter}) ); return DECLINED; } sub hook_disconnect { my ($self) = @_; if ($self->{reopen_} && $self->{_f}) { $self->{_f} = undef; } return DECLINED; } sub hook_logging { my ($self, $transaction, $trace, $hook, $plugin, @log) = @_; return DECLINED if !defined $self->{_loglevel} or $trace > $self->{_loglevel}; return DECLINED if defined $plugin and $plugin eq $self->plugin_name; # Possibly reopen the log iff: # - It's not already open # - We're allowed to split sessions across logfiles # - We haven't logged anything yet this session # - We aren't in a session if ( !$self->{_f} || !$self->{_nosplit} || !$transaction || !$transaction->notes('file-logged-this-session')) { unless (defined $self->maybe_reopen($transaction)) { return DECLINED; } $transaction->notes('file-logged-this-session', 1) if $transaction; } my $f = $self->{_f}; print $f strftime($self->{_tsformat}, localtime), ' ', hostname(), '[', $$, ']: ', @log, "\n"; return DECLINED; } qpsmtpd-0.94/plugins/logging/syslog000066400000000000000000000100771240247602400175160ustar00rootroot00000000000000#!perl -w =head1 NAME syslog - Syslog logging plugin for qpsmtpd =head1 DESCRIPTION The syslog plugin for qpsmtpd passes qpsmtpd log messages into the standard UNIX syslog facility, mapping qpsmtpd priorities to syslog priorities. =head1 CONFIGURATION To enable the logging plugin, add a line of this form to the qpsmtpd plugins configuration file: =over logging/syslog [loglevel l] [priority p] [ident str] [facility f] [logsock t] For example: logging/syslog loglevel LOGINFO priority LOG_NOTICE =back The following optional configuration settings can be supplied: =over =item B The internal log level below which messages will be logged. Priorities count downward as follows: =over =item B =item B =item B =item B =item B =item B =item B =item B =back =item B Normally, log messages will be mapped from the above log levels into the syslog(3) log levels of their corresponding names. This will cause various messages to appear or not in syslog outputs according to your syslogd configuration (typically /etc/syslog.conf). However, if the B setting is used, all messages will be logged at that priority regardless of what the original priority might have been. =item B The ident string that will be attached to messages logged via this plugin. The default is 'qpsmtpd'. =item B The syslog facility to which logged mesages will be directed. See syslog(3) for details. The default is LOG_MAIL. =item B The syslog socket where messages should be sent via syslogsock(). The valid options are 'udp', 'tcp', 'unix', 'stream' and 'console'. Not all are available on all systems. See Sys::Syslog for details. The default is the above list in that order. To select specific sockets, use a comma to separate the types. =over logsock udp,unix logsock stream =back =back =head1 AUTHOR Devin Carraway Peter Eisch (logsock support) =head1 LICENSE Copyright (c) 2005, Devin Carraway. This plugin is licensed under the same terms as the qpsmtpd package itself. Please see the LICENSE file included with qpsmtpd for details. =cut use strict; use warnings; use Qpsmtpd::Constants; use Sys::Syslog qw(:DEFAULT setlogsock); sub register { my ($self, $qp, @args) = @_; my %args; if (@args % 2 == 0) { %args = @args; } else { warn "Malformed arguments to syslog plugin"; return; } my $ident = 'qpsmtpd'; my $logopt = 'pid'; my $facility = 'LOG_MAIL'; $self->{_loglevel} = LOGWARN; if ($args{loglevel}) { if ($args{loglevel} =~ /^(\d+)$/) { $self->{_loglevel} = $1; } elsif ($args{loglevel} =~ /^(LOG\w+)$/) { $self->{_loglevel} = log_level($1) || LOGWARN; } } if ($args{priority}) { if ($args{priority} =~ /^(\d+|LOG\w+)$/) { $self->{_priority} = $1; } } if ($args{ident} && $args{ident} =~ /^([\w\-.]+)$/) { $ident = $1; } if ($args{facility} && $args{facility} =~ /^(\w+)$/) { $facility = $1; } if ($args{logsock}) { my @logopt = split(/,/, $args{logsock}); setlogsock(@logopt); } unless (openlog $ident, $logopt, $facility) { warn "Error opening syslog output"; return; } } my %priorities_ = ( 0 => 'LOG_EMERG', 1 => 'LOG_ALERT', 2 => 'LOG_CRIT', 3 => 'LOG_ERR', 4 => 'LOG_WARNING', 5 => 'LOG_NOTICE', 6 => 'LOG_INFO', 7 => 'LOG_DEBUG', ); sub hook_logging { my ($self, $transaction, $trace, $hook, $plugin, @log) = @_; return DECLINED if $trace > $self->{_loglevel}; return DECLINED if defined $plugin and $plugin eq $self->plugin_name; my $priority = $self->{_priority} ? $self->{_priority} : $priorities_{$trace}; syslog $priority, '%s', join(' ', @log); return DECLINED; } qpsmtpd-0.94/plugins/logging/transaction_id000066400000000000000000000047471240247602400212060ustar00rootroot00000000000000#!perl -w # this is a simple 'transaction_id' plugin like the default builtin logging # # It demonstrates that a logging plugin can call ->log itself as well # as how to ignore log entries from itself sub register { my ($self, $qp, $loglevel) = @_; die "The transaction ID feature is currently unsupported"; $self->{_level} = LOGWARN; if (defined($loglevel)) { if ($loglevel =~ /^\d+$/) { $self->{_level} = $loglevel; } else { $self->{_level} = log_level($loglevel); } } # If you want to capture this log entry with this plugin, you need to # wait until after you register the plugin $self->log(LOGINFO, 'Initializing logging::transaction_id plugin'); } sub hook_logging { my ($self, $transaction, $trace, $hook, $plugin, @log) = @_; # Don't log your own log entries! If this is the only logging plugin # then these lines will not be logged at all. You can safely comment # out this line and it will not cause an infinite loop. return DECLINED if defined $plugin and $plugin eq $self->plugin_name; warn join( " ", ($transaction ? $transaction->id : "???") . ( defined $plugin ? " $plugin plugin:" : defined $hook ? " running plugin ($hook):" : "" ), @log ), "\n" if ($trace <= $self->{_level}); return DECLINED; } =head1 NAME transaction_id - plugin to demo use of the transaction id =head1 DESCRIPTION A qpsmtpd plugin which replicates the built in logging functionality, which is to send all logging messages to STDERR below a specific log level. This plugin differs from logging/warn only by using the transaction id instead of the pid to demonstrate the effect of different algorithms. =head1 INSTALL AND CONFIG Place this plugin in the plugin/logging directory beneath the standard qpsmtpd installation. Edit the config/logging file and add a line like this: logging/transaction_id [loglevel] where the optional parameters C is either the numeric or text representation of the maximum log level, as shown in the L file. =head1 AUTHOR John Peacock =head1 COPYRIGHT AND LICENSE Copyright (c) 2005 John Peacock This plugin is licensed under the same terms as the qpsmtpd package itself. Please see the LICENSE file included with qpsmtpd for details. =cut qpsmtpd-0.94/plugins/logging/warn000066400000000000000000000041211240247602400171360ustar00rootroot00000000000000#!perl -w =head1 NAME warn - Default logging plugin for qpsmtpd =head1 DESCRIPTION A qpsmtpd plugin which replicates the built in logging functionality, which is to send all logging messages to STDERR below a specific log level. It demonstrates that a logging plugin can call ->log itself as well as how to ignore log entries from itself =head1 INSTALL AND CONFIG Place this plugin in the plugin/logging directory beneath the standard qpsmtpd installation. Edit the config/logging file and add a line like this: logging/warn [loglevel] where the optional parameters C is either the numeric or text representation of the maximum log level, as shown in the L file. =head1 AUTHOR John Peacock =head1 COPYRIGHT AND LICENSE Copyright (c) 2005 John Peacock This plugin is licensed under the same terms as the qpsmtpd package itself. Please see the LICENSE file included with qpsmtpd for details. =cut sub register { my ($self, $qp, $loglevel) = @_; $self->{_level} = LOGWARN; if (defined($loglevel)) { if ($loglevel =~ /^\d+$/) { $self->{_level} = $loglevel; } else { $self->{_level} = log_level($loglevel); } } # If you want to capture this log entry with this plugin, you need to # wait until after you register the plugin $self->log(LOGINFO, 'Initializing logging::warn plugin'); } sub hook_logging { my ($self, $transaction, $trace, $hook, $plugin, @log) = @_; # Don't log your own log entries! If this is the only logging plugin # then these lines will not be logged at all. You can safely comment # out this line and it will not cause an infinite loop. return DECLINED if defined $plugin && $plugin eq $self->plugin_name; return DECLINED if $trace > $self->{_level}; my $prefix = defined $plugin && defined $hook ? " ($hook) $plugin:" : defined $plugin ? " $plugin:" : defined $hook ? " ($hook) running plugin:" : ''; warn join(' ', $$ . $prefix, @log), "\n"; return DECLINED; } qpsmtpd-0.94/plugins/loop000066400000000000000000000024011240247602400155110ustar00rootroot00000000000000#!perl -w =head1 NAME loop - Detect mail loops =head1 DESCRIPTION This plugin detects loops by counting "Received" and "Delivered-To" header lines. It's a kluge but it duplicates what qmail-smtpd does, and it does at least prevent messages from looping forever. =head1 CONFIGURATION Takes one optional parameter, the maximum number of "hops" ("Received" and lines plus "Delivered-To" lines) allowed. The default is 100, the same as in qmail-smtpd. =head1 AUTHOR Written by Keith C. Ivey =head1 LICENSE Released to the public domain, 17 June 2005. =cut use Qpsmtpd::DSN; sub init { my ($self, $qp, @args) = @_; $self->{_max_hops} = $args[0] || 100; if ($self->{_max_hops} !~ /^\d+$/) { $self->log(LOGWARN, "Invalid max_hops value -- using default"); $self->{_max_hops} = 100; } $self->log(LOGWARN, "Ignoring additional arguments") if @args > 1; } sub hook_data_post { my ($self, $transaction) = @_; my $hops = 0; $hops++ for $transaction->header->get('Received'), $transaction->header->get('Delivered-To'); if ($hops >= $self->{_max_hops}) { # default of too_many_hops is DENY, see comment in POD of Qpsmtpd::DSN return Qpsmtpd::DSN->too_many_hops(); } return DECLINED; } qpsmtpd-0.94/plugins/milter000066400000000000000000000161731240247602400160470ustar00rootroot00000000000000#!perl -w =head1 NAME milter =head1 DESCRIPTION This plugin allows you to attach to milter filters (yes, those written for sendmail) as though they were qpsmtpd plugins. In order to do this you need the C module from CPAN. =head1 CONFIG It takes two required parameters - a milter name (for logging) and the port to connect to on the localhost. This can also contain a hostname if the filter is on another machine: milter Brightmail 5513 or milter Brightmail bmcluster:5513 This plugin has so far only been tested with Brightmail's milter module. =cut use Net::Milter; use Qpsmtpd::Constants; no warnings; sub register { my ($self, $qp, @args) = @_; die "Invalid milter setup args: '@args'" unless @args > 1; my ($name, $port) = @args; my $host = '127.0.0.1'; if ($port =~ s/^(.*)://) { $host = $1; } $self->{name} = $name; $self->{host} = $host; $self->{port} = $port; } sub hook_disconnect { my ($self) = @_; my $milter = $self->connection->notes('milter') || return DECLINED; $milter->send_quit(); $self->connection->notes('spam', undef); $self->connection->notes('milter', undef); return DECLINED; } sub check_results { my ($self, $transaction, $where, @results) = @_; foreach my $result (@results) { next if $result->{action} eq 'continue'; $self->log(LOGINFO, "milter $self->{name} result action: $result->{action}"); if ($result->{action} eq 'reject') { die( "Rejected at $where by $self->{name} milter ($result->{explanation})"); } elsif ($result->{action} eq 'add') { if ($result->{header} eq 'body') { $transaction->body_write($result->{value}); } else { push @{$transaction->notes('milter_header_changes')->{add}}, [$result->{header}, $result->{value}]; } } elsif ($result->{action} eq 'delete') { push @{$transaction->notes('milter_header_changes')->{delete}}, $result->{header}; } elsif ($result->{action} eq 'accept') { # TODO - figure out what this is used for } elsif ($result->{action} eq 'replace') { push @{$transaction->notes('milter_header_changes')->{replace}}, [$result->{header}, $result->{value}]; } } } sub hook_connect { my ($self, $transaction) = @_; $self->log(LOGDEBUG, "milter $self->{name} opening connection to milter backend"); my $milter = Net::Milter->new(); $milter->open($self->{host}, $self->{port}, 'tcp'); $milter->protocol_negotiation(); $self->connection->notes(milter => $milter); $self->connection->notes( milter_header_changes => {add => [], delete => [], replace => [],}); my $remote_ip = $self->qp->connection->remote_ip; my $remote_host = $self->qp->connection->remote_host; $self->log(LOGDEBUG, "milter $self->{name} checking connect from $remote_host\[$remote_ip\]" ); eval { $self->check_results( $transaction, "connection", $milter->send_connect( $remote_host, 'tcp4', 0, $remote_ip ) ); }; $self->connection->notes('spam', $@) if $@; return DECLINED; } sub hook_helo { my ($self, $transaction) = @_; if (my $txt = $self->connection->notes('spam')) { return DENY, $txt; } my $milter = $self->connection->notes('milter'); my $helo = $self->qp->connection->hello; my $host = $self->qp->connection->hello_host; $self->log(LOGDEBUG, "milter $self->{name} checking HELO $host"); eval { $self->check_results($transaction, "HELO", $milter->send_helo($host)); }; return (DENY, $@) if $@; return DECLINED; } sub hook_mail { my ($self, $transaction, $address, %param) = @_; my $milter = $self->connection->notes('milter'); $self->log(LOGDEBUG, "milter $self->{name} checking MAIL FROM " . $address->format); eval { $self->check_results($transaction, "MAIL FROM", $milter->send_mail_from($address->format)); }; return (DENY, $@) if $@; return DECLINED; } sub hook_rcpt { my ($self, $transaction, $address, %param) = @_; my $milter = $self->connection->notes('milter'); $self->log(LOGDEBUG, "milter $self->{name} checking RCPT TO " . $address->format); eval { $self->check_results($transaction, "RCPT TO", $milter->send_rcpt_to($address->format)); }; return (DENY, $@) if $@; return DECLINED; } sub hook_data_post { my ($self, $transaction) = @_; my $milter = $self->connection->notes('milter'); $self->log(LOGDEBUG, "milter $self->{name} checking headers"); my $headers = $transaction->header(); # Mail::Header object foreach my $h ($headers->tags) { # munge these headers because milters prefer them this way $h =~ s/\b(\w)/\U$1/g; $h =~ s/\bid\b/ID/g; foreach my $val ($headers->get($h)) { # $self->log(LOGDEBUG, "milter $self->{name} checking header: $h: $val"); eval { $self->check_results($transaction, "header $h", $milter->send_header($h, $val)); }; return (DENY, $@) if $@; } } eval { $self->check_results($transaction, "end headers", $milter->send_end_headers()); }; return (DENY, $@) if $@; $transaction->body_resetpos; # skip past headers while (my $line = $transaction->body_getline) { $line =~ s/\r?\n//; $line =~ s/\s*$//; last unless length($line); } $self->log(LOGDEBUG, "milter $self->{name} checking body"); my $data = ''; while (my $line = $transaction->body_getline) { $data .= $line; if (length($data) > 60000) { eval { $self->check_results($transaction, "body", $milter->send_body($data)); }; return (DENY, $@) if $@; $data = ''; } } if (length($data)) { eval { $self->check_results($transaction, "body", $milter->send_body($data)); }; return (DENY, $@) if $@; $data = ''; } eval { $self->check_results($transaction, "end of DATA", $milter->send_end_body()); }; return (DENY, $@) if $@; my $milter_header_changes = $transaction->notes('milter_header_changes'); foreach my $add (@{$milter_header_changes->{add}}) { $headers->add($add->[0], $add->[1]); } foreach my $del (@{$milter_header_changes->{'delete'}}) { $headers->delete($del); } foreach my $repl (@{$milter_header_changes->{replace}}) { $headers->replace($repl->[0], $repl->[1]); } return DECLINED; } qpsmtpd-0.94/plugins/naughty000066400000000000000000000130211240247602400162170ustar00rootroot00000000000000#!perl -w =head1 NAME naughty - dispose of naughty connections =head1 SYNOPSIS Rather than immediately terminating naughty connections, plugins can flag the connection and dispose of it later. Examples are B, B, B, B, B, and B. =head1 BACKGROUND Historically, deferred rejection was based on the belief that malware will retry less if we disconnect after RCPT. Observations in 2012 suggest it makes no measurable difference when we disconnect. Disconnecting early will block connections from your users who are roaming, or whose IP space is voluntarily listed by their ISP. Deferring rejection until after the remote has had the ability to authenticate allows RBLs to be safely used on port 25 and 587. Some (much older) RFCs suggest deferring later. For these and other reasons, a few plugins implemented deferred rejection on their own. By having naughty, other plugins can be much simpler. =head1 DESCRIPTION Naughty provides the following: =head2 consistency With one change to the config of naughty, all plugins can reject their messages at the preferred time. I use this feature for spam filter training. When setting up a new server, I use 'naughty reject data_post' until after dspam is trained. Once the bayesian filters are trained, I change to 'naughty reject data', and avoid processing the message bodies. =head2 efficiency After a connection is marked as naughty, subsequent plugins can detect that and skip processing. Plugins like SpamAssassin and DSPAM can benefit from using naughty connections to train their filters. Since many connections are from blacklisted IPs, naughty significantly reduces the resources required to dispose of them. Over 80% of my connections are disposed of after after a few DNS queries (B or one DB query (B) and 0.01s of compute time. =head2 simplicity Rather than having plugins split processing across hooks, plugins can run to completion when they have the information they need, issue a I if warranted, and be done. This may help reduce the code divergence between the sync and async deployment models. =head2 authentication When a user authenticates, the naughty flag on their connection is cleared. This allows users to send email from IPs that fail connection tests such as B. Note that if I is set, connections will not get the chance to authenticate. To allow clients a chance to authenticate, I works well. =head1 HOW TO USE Set the connection note I to the message you wish to send the naughty sender during rejection. $self->connection->notes('naughty', $message); This happens for plugins automatically if they use the $self->get_reject() method and have set I in the plugin configuration. =head1 CONFIGURATION =head2 reject naughty reject [ connect | mail | rcpt | data | data_post ] The phase of the connection in which the naughty connection will be terminated. Keep in mind that if you choose rcpt and a plugin (like B) runs first, and B returns OK, then this plugin will not get called and the message will not get rejected. Solutions are to make sure B is listed before rcpt_ok in config/plugins or set naughty to run in a phase after the one you wish to complete. In this case, use data instead of rcpt to disconnect after rcpt_ok. The latter is particularly useful if your rcpt plugins skip naughty testing. In that case, any recipient is accepted for naughty connections, which inhibits spammers from detecting address validity. =head2 reject_type [ temp | perm | disconnect ] If the plugin that set naughty didn't specify, what type of rejection should be sent? See docs/config.pod =head2 loglevel Adjust the quantity of logging for this plugin. See docs/logging.pod =head1 EXAMPLES Here's how to use naughty and get_reject in your plugin: sub register { my ($self, $qp) = (shift, shift); $self->{_args} = { @_ }; $self->{_args}{reject} ||= 'naughty'; }; sub connect_handler { my ($self, $transaction) = @_; ... do a bunch of stuff ... return DECLINED if is_okay(); return $self->get_reject( $message, $optional_log_message ); }; =head1 AUTHOR 2012 - Matt Simerson - msimerson@cpan.org =cut use strict; use warnings; use Qpsmtpd::Constants; sub register { my ($self, $qp) = (shift, shift); $self->log(LOGERROR, "Bad arguments") if @_ % 2; $self->{_args} = {@_}; $self->{_args}{reject} ||= 'rcpt'; $self->{_args}{reject_type} ||= 'disconnect'; my $reject = lc $self->{_args}{reject}; my %hooks = map { $_ => 1 } qw/ connect mail rcpt data data_post hook_queue_post /; if (!$hooks{$reject}) { $self->log(LOGERROR, "fail, invalid hook $reject"); $self->register_hook('data_post', 'naughty'); return; } # just in case naughty doesn't disconnect, which can happen if a plugin # with the same hook returned OK before naughty ran, or .... if ($reject ne 'data_post' && $reject ne 'hook_queue_post') { $self->register_hook('data_post', 'naughty'); } $self->log(LOGDEBUG, "registering hook $reject"); $self->register_hook($reject, 'naughty'); } sub naughty { my $self = shift; my $naughty = $self->connection->notes('naughty') or do { $self->log(LOGINFO, 'pass'); return DECLINED; }; $self->log(LOGINFO, "disconnecting"); my $rtype = $self->connection->notes( 'naughty_reject_type' ); my $type = $self->get_reject_type( 'disconnect', $rtype ); return ($type, $naughty); } qpsmtpd-0.94/plugins/noop_counter000066400000000000000000000032321240247602400172550ustar00rootroot00000000000000#!perl -w =head1 NAME noop_counter - disconnect after too many consecutive NOOPs, example plugin for the hook_noop() =head1 DESCRIPTION The B counts the number of consecutive C commands given by a client and disconnects after a given number. Any other command than a C resets the counter. One argument may be given: the number of Cs after which the client will be disconnected. =head1 NOTE This plugin should be loaded early to be able to reset the counter on any other command. =cut sub register { my ($self, $qp, @args) = @_; $self->{_noop_count} = 0; $self->{_max_noop} = 3; if ($args[0] && $args[0] =~ /^\d+$/) { $self->{_max_noop} = shift @args; } } sub hook_noop { my ($self, $transaction, @args) = @_; ++$self->{_noop_count}; ### the following block is not used, RFC 2821 says we SHOULD ignore ### any arguments... so we MAY return an error if we want to :-) # return (DENY, "Syntax error, NOOP does not take any arguments") # if $args[0]; if ($self->{_noop_count} >= $self->{_max_noop}) { return (DENY_DISCONNECT, "Stop wasting my time, too many consecutive NOOPs"); } return (DECLINED); } sub reset_noop_counter { $_[0]->{_noop_count} = 0; return (DECLINED); } # and bind the counter reset to the hooks, QUIT not useful here: *hook_helo = *hook_ehlo = # HELO / EHLO *hook_mail = # MAIL FROM: *hook_rcpt = # RCPT TO: *hook_data = # DATA *hook_reset_transaction = # RSET *hook_vrfy = # VRFY *hook_help = # HELP \&reset_noop_counter; qpsmtpd-0.94/plugins/parse_addr_withhelo000066400000000000000000000032151240247602400205530ustar00rootroot00000000000000#!perl -w =head1 NAME parse_addr_withhelo =head1 SYNOPSIS strict RFC 821 forbids parameters after the MAIL FROM: and RCPT TO: load this plugin to enforce, else the default EHLO parsing with parameters is done. =cut use strict; use warnings; use Qpsmtpd::Constants; sub hook_mail_parse { my $self = shift; return (OK, \&_parse) if ($self->qp->connection->hello eq 'helo'); return (DECLINED); } sub hook_rcpt_parse { my $self = shift; return (OK, \&_parse) if ($self->qp->connection->hello eq 'helo'); return (DECLINED); } sub _parse { my ($self, $cmd, $line) = @_; $self->log(LOGDEBUG, "_parse() cmd=[$cmd], line=[$line]"); if ($cmd eq 'mail') { return (DENY, "Syntax error in command") unless ($line =~ s/^from:\s*//i); } else { # cmd eq 'rcpt' return (DENY, "Syntax error in command") unless ($line =~ s/^to:\s*//i); } if ($line =~ s/^(<.*>)\s*//) { my $addr = $1; return (DENY, "No parameters allowed in " . uc($cmd)) if ($line =~ /^\S/); return (OK, $addr, ()); } ## now, no <> are given $line =~ s/\s*$//; if ($line =~ /\@/) { return (DENY, "No parameters allowed in " . uc($cmd)) if ($line =~ /\@\S+\s+\S/); return (OK, $line, ()); } if ($cmd eq "mail") { return (OK, "<>") unless $line; # 'MAIL FROM:' -> 'MAIL FROM:<>' return (DENY, "Could not parse your MAIL FROM command"); } else { return (DENY, "Could not parse your RCPT TO command") unless $line =~ /^(postmaster|abuse)$/i; } } qpsmtpd-0.94/plugins/qmail_deliverable000066400000000000000000000165231240247602400202130ustar00rootroot00000000000000#!/usr/bin/perl =head1 NAME qmail_deliverable - Check that the recipient address is deliverable =head1 DESCRIPTION See the description of Qmail::Deliverable. This B uses the client/server interface and needs a running qmail-deliverabled. If no connection can be made, deliverability is simply assumed. The modules LWP (libwww-perl) and HTTP::Daemon, available from CPAN, are required for qmail-deliverabled and Qmail::Deliverable::Client. =head1 CONFIGURATION =over 4 =item server host:port Hostname (or IP address), and port (both!) of the qmail-deliverabled server. If none is specified, the default (127.0.0.1:8998) is used. =item server smtproutes:host:port If the specification is prepended by the literal text C, then for recipient domains listed in your /var/qmail/control/smtproutes use their respective hosts for the check. For other domains, the given host is used. The port has to be the same across all servers. Example: qmail_deliverable server smtproutes:127.0.0.1:8998 Use "smtproutes:8998" (no second colon) to simply skip the deliverability check for domains not listed in smtproutes. =item vpopmail_ext [ 0 | 1 ] Is vpopmail configured with the qmail-ext feature enabled? If so, this config option must be enabled in order for user-ext@example.org addresses to work. Default: 0 =item reject karma reject [ 0 | 1 | connect | naughty ] I<0> will not reject any connections. I<1> will reject naughty senders. I is the most efficient setting. To reject at any other connection hook, use the I setting and the B plugin. =back =head1 CAVEATS Given a null host in smtproutes, the normal MX lookup should be used. This plugin does not do this, because we don't want to harrass arbitrary servers. Connection failure is *faked* when there is no smtproute. =head1 LEGAL This software is released into the public domain, and does not come with warranty or guarantee of any kind. Use it at your own risk. =head1 AUTHOR Juerd <#####@juerd.nl> =head1 SEE ALSO L, L, L =cut ################################# ################################# BEGIN { use FindBin qw($Bin $Script); if (not $INC{'Qpsmtpd.pm'}) { my $dir = '$PLUGINS_DIRECTORY'; -d and $dir = $_ for qw( /home/qpsmtpd/plugins /home/smtp/qpsmtpd/plugins /usr/local/qpsmtpd/plugins /usr/local/share/qpsmtpd/plugins /usr/share/qpsmtpd/plugins ); my $file = "the 'plugins' configuration file"; -f and $file = $_ for qw( /home/qpsmtpd/config/plugins /home/smtp/qpsmtpd/config/plugins /usr/local/qpsmtpd/config/plugins /usr/local/etc/qpsmtpd/plugins /etc/qpsmtpd/plugins ); # "die" would print "BEGIN failed" garbage print STDERR <<"END"; This is a plugin for qpsmtpd and should not be run manually. To install the plugin: ln -s $Bin/$Script $dir/ And add "$Script server 127.0.0.1:8998" to $file, before rcpt_ok. For configuration instructions, read "man $Script" (Paths may vary.) END exit 255; } } ################################# ################################# use strict; use warnings; use Qpsmtpd::Constants; use Qmail::Deliverable::Client qw(deliverable); my %smtproutes; my $shared_domain; # global variable to be closed over by the SERVER callback sub register { my ($self, $qp, @args) = @_; if (@args % 2) { $self->log(LOGWARN, "Odd number of arguments, using default config"); } else { my %args = @args; if ($args{server} && $args{server} =~ /^smtproutes:/) { my ($fallback, $port) = $args{server} =~ /:(?:(.*?):?)(\d+)/; open my $fh, "/var/qmail/control/smtproutes" or warn "Could not read smtproutes"; for (readline $fh) { my ($domain, $mx) = /^(.*?) : \[? ( [^\]:\s]* )/x; $smtproutes{$domain} = $mx; } $Qmail::Deliverable::Client::SERVER = sub { my $server = _smtproute($shared_domain); return "$server:$port" if defined $server; return "$fallback:$port" if defined $fallback; return; }; } elsif ($args{server}) { $Qmail::Deliverable::Client::SERVER = $args{server}; } if ($args{vpopmail_ext}) { $Qmail::Deliverable::VPOPMAIL_EXT = $args{vpopmail_ext}; } if ($args{reject}) { $self->{_args}{reject} = $args{reject}; } } $self->register_hook("rcpt", "rcpt_handler"); } sub rcpt_handler { my ($self, $transaction, $rcpt) = @_; return DECLINED if $self->is_immune(); # requires QP 0.90+ my $address = $rcpt->address; $self->log(LOGDEBUG, "Checking deliverability for recipient '$address'"); $shared_domain = $rcpt->host; my $rv = deliverable $address; if (not defined $rv or not length $rv) { $self->log(LOGWARN, "error (unknown) checking '$address'"); return DECLINED; } my $k = 0; # known status code $self->log(LOGINFO, "error, permission failure"), $k++ if $rv == 0x11; $self->log(LOGINFO, "pass, qmail-command in dot-qmail"), $k++ if $rv == 0x12; $self->log(LOGINFO, "pass, bouncesaying with program"), $k++ if $rv == 0x13; if ($rv == 0x14) { my $s = $transaction->sender->address; if (!$s || $s eq '<>') { $self->adjust_karma(-1); return (DENY, "mailing lists do not accept null senders"); }; $self->log(LOGINFO, "pass, ezmlm list"); $k++; } $self->log(LOGINFO, "Temporarily undeliverable: group/world writable"), $k++ if $rv == 0x21; $self->log(LOGINFO, "Temporarily undeliverable: sticky home directory"), $k++ if $rv == 0x22; $self->log(LOGINFO, "error, $Qmail::Deliverable::Client::ERROR"), $k++ if $rv == 0x2f; $self->log(LOGINFO, "pass, normal delivery"), $k++ if $rv == 0xf1; $self->log(LOGINFO, "pass, vpopmail dir"), $k++ if $rv == 0xf2; $self->log(LOGINFO, "pass, vpopmail alias"), $k++ if $rv == 0xf3; $self->log(LOGINFO, "pass, vpopmail catchall"), $k++ if $rv == 0xf4; $self->log(LOGINFO, "pass, vpopmail vuser"), $k++ if $rv == 0xf5; $self->log(LOGINFO, "pass, vpopmail qmail-ext"), $k++ if $rv == 0xf6; $self->log(LOGINFO, "error, SHOULD NOT HAPPEN"), $k++ if $rv == 0xfe; $self->log(LOGINFO, "fail, address not local"), $k++ if $rv == 0xff; if ($rv) { $self->log(LOGINFO, sprintf("error, unknown: 0x%02x", $rv)) if not $k; return DECLINED; } $self->adjust_karma(-1); return $self->get_reject("Sorry, no mailbox by that name. qd (#5.1.1)"); } sub _smtproute { my ($domain) = @_; my @parts = split /\./, $domain; if (exists $smtproutes{$domain}) { return undef if $smtproutes{$domain} eq ""; return $smtproutes{$domain}; } for (reverse 1 .. @parts) { my $wildcard = join "", map ".$_", @parts[-$_ .. -1]; if (exists $smtproutes{$wildcard}) { return undef if $smtproutes{$wildcard} eq ""; return $smtproutes{$wildcard}; } } return undef if not exists $smtproutes{""}; return undef if $smtproutes{""} eq ""; return $smtproutes{""}; } qpsmtpd-0.94/plugins/queue/000077500000000000000000000000001240247602400157445ustar00rootroot00000000000000qpsmtpd-0.94/plugins/queue/exim-bsmtp000066400000000000000000000117051240247602400177600ustar00rootroot00000000000000#!perl -w =head1 NAME exim-bsmtp =head1 DESCRIPTION This plugin enqueues mail from qpsmtpd into Exim via BSMTP =head1 INSTALLATION The qpsmtpd user B be configured in the I setting in your Exim configuration. If it is not, queueing will still work, but sender addresses will not be honored by exim, which will make all mail appear to originate from the smtpd user itself. =head1 CONFIGURATION The plugin accepts configuration settings in space-delimited name/value pairs. For example: queue/exim-bsmtp exim_path /usr/sbin/exim4 =over 4 =item exim_path I The path to use to execute the Exim BSMTP receiver; by default this is I. The commandline switch '-bS' will be added (this is actually redundant with rsmtp, but harmless). =back =head1 LICENSE Copyright (c) 2004 by Devin Carraway Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions: The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. =cut use strict; use warnings; use IO::File; use Sys::Hostname qw(hostname); use File::Temp qw(tempfile); use Qpsmtpd::Constants; sub register { my ($self, $qp, %args) = @_; $self->{_exim_path} = $args{exim_path} || '/usr/sbin/rsmtp'; $self->{_exim_path} = $1 if $self->{_exim_path} =~ /(.*)/; unless (-x $self->{_exim_path}) { $self->log(LOGERROR, "Could not find exim at $self->{_exim_path};" . " please set exim_path in config/plugins" ); return undef; } } sub hook_queue { my ($self, $transaction) = @_; unless ($transaction->header) { $self->log(LOGERROR, "No header parsed for transaction; can't enqueue"); return (DENY, 'Mail unqueuable'); } my $tmp_dir = $self->qp->config('spool_dir') || '/tmp'; $tmp_dir = $1 if ($tmp_dir =~ /(.*)/); my ($tmp, $tmpfn) = tempfile("exim-bsmtp.$$.XXXXXX", DIR => $tmp_dir); unless ($tmp && $tmpfn) { $self->log(LOGERROR, "Couldn't create tempfile: $!"); return (DECLINED, 'Internal error enqueueing mail'); } print $tmp "HELO ", hostname(), "\n", "MAIL FROM:<", ($transaction->sender->address || ''), ">\n"; print $tmp "RCPT TO:<", ($_->address || ''), ">\n" for $transaction->recipients; print $tmp "DATA\n", $transaction->header->as_string; $transaction->body_resetpos; while (my $line = $transaction->body_getline) { $line =~ s/^\./../; print $tmp $line; } print $tmp ".\nQUIT\n"; close $tmp; my $cmd = "$self->{_exim_path} -bS < $tmpfn"; $self->log(LOGDEBUG, "executing cmd $cmd"); my $exim = new IO::File "$cmd|"; unless ($exim) { $self->log(LOGERROR, "Could not execute $self->{_exim_path}: $!"); unlink $tmpfn or $self->log(LOGERROR, "unlink: $tmpfn: $!"); return (DECLINED, "Internal error enqueuing mail"); } # Normally exim produces no output in BSMTP mode; anything that # does come out is an error worth logging. my $start = time; my ($bsmtp_error, $bsmtp_msg); while (<$exim>) { chomp; $self->log(LOGERROR, "exim: $_"); if (/(\d\d\d)\s(\S.*)/) { ($bsmtp_error, $bsmtp_msg) = ($1, $2); } } $self->log(LOGDEBUG, "BSMTP finished (" . (time - $start) . " sec)"); $exim->close; my $exit = $?; unlink $tmpfn or $self->log(LOGERROR, "unlink: $tmpfn: $!"); $self->log(LOGDEBUG, "Exitcode from exim: $exit"); if ($bsmtp_error && $bsmtp_error >= 400 && $bsmtp_error < 600) { $self->log(LOGERROR, "BSMTP enqueue failed; response $bsmtp_error" . " ($bsmtp_msg)"); return ($bsmtp_error < 400 ? DECLINED : DENY, $bsmtp_msg); } elsif (($exit >> 8) != 0 || $bsmtp_error) { $self->log(LOGERROR, 'BSMTP enqueue failed; exitcode ' . ($exit >> 8) . " from $self->{_exim_path} -bS" ); return (DECLINED, 'Internal error enqueuing mail'); } $self->log(LOGINFO, "Enqueued to exim via BSMTP"); return (OK, "Queued!"); } qpsmtpd-0.94/plugins/queue/maildir000066400000000000000000000137631240247602400173220ustar00rootroot00000000000000#!perl -w =head1 NAME queue/maildir =head1 DESCRIPTION This plugin delivers mails to a maildir spool. =head1 CONFIG It takes one required parameter, the location of the maildir. A second optional parameter delivers the mail into a sub directory named by the recipient of the mail B. Some substituions take place. Before replacing the parts descibed below, any character of the recipient address, which is not one of C<-A-Za-z0-9+_.,@=> is set to a C<_>. If a third parameter is given, it will be used as octal (!) permisson of the newly created files and directories, any execute bits will be stripped for files: Use C<770> to create group writable directories and files with mode C<0660>. =head2 Maildir spool directory substitutions =over 4 =item %l Replaced by the local part of the address (i.e. the username) =item %d Replaced by the domain part of the address (i.e. the domain name) =item %u Replaced by the full address. =cut # =item %% # # Replaced by a single percent sign (%) # # =cut =back Examples: if the plugin is loaded with the parameters queue/maildir /var/spool/qpdeliver %d/%l and the recipient is C the mails will be written to the C sub directory of C. With queue/maildir /var/spool/qpdeliver %u and a recipient of C the mail goes to C. =head1 NOTES Names of the substitution parameters and the replaced charachters are the same L supports, for more info see the C<--virtual-config-dir> option of L. When called with more than one parameter, this plugin is probably not usable with qpsmtpd-async. With the the second parameter being C<%d> it will still deliver one message for each recipient: With the two recpients C and C you get two messages in the C directory. =cut use File::Path qw(mkpath); use Sys::Hostname qw(hostname); use Time::HiRes qw(gettimeofday); sub register { my ($self, $qp, @args) = @_; if (@args > 0) { ($self->{_maildir}) = ($args[0] =~ m!([-/\w\.]+)!); } if (@args > 1) { ($self->{_subdirs}) = ($args[1] =~ m#^(.*\%[ldu].*)$#); unless ($self->{_subdirs}) { $self->log(LOGWARN, "WARNING: sub directory does not contain a " . "substitution parameter" ); return 0; } } if (@args > 2) { ($self->{_perms}) = ($args[2] =~ /^([0-7]{3})$/); unless ($self->{_perms}) { # 000 is unfortunately true ;-) $self->log(LOGWARN, "WARNING: mode is not an octal number"); return 0; } $self->{_perms} = oct($self->{_perms}); } $self->{_perms} = 0700 unless $self->{_perms}; unless ($self->{_maildir}) { $self->log(LOGWARN, "WARNING: maildir directory not specified"); return 0; } unless ($self->{_subdirs}) { # mkpath is influenced by umask... my $old_umask = umask 000; map { my $d = $self->{_maildir} . "/$_"; -e $d or mkpath $d, 0, $self->{_perms} } qw(cur tmp new); umask $old_umask; } my $hostname = (hostname =~ m/([\w\._\-]+)/)[0]; $self->{_hostname} = $hostname; } my $maildir_counter = 0; sub hook_queue { my ($self, $transaction) = @_; my ($rc, @msg); my $old_umask = umask($self->{_perms} ^ 0777); if ($self->{_subdirs}) { foreach my $addr ($transaction->recipients) { ($rc, @msg) = $self->deliver_user($transaction, $addr); unless ($rc == OK) { umask $old_umask; return ($rc, @msg); } } umask $old_umask; return (OK, @msg); # last @msg is the same like any other before... } $transaction->header->add('Delivered-To', $_->address, 0) for $transaction->recipients; ($rc, @msg) = $self->write_file($transaction, $self->{_maildir}); umask $old_umask; return ($rc, @msg); } sub write_file { my ($self, $transaction, $maildir, $addr) = @_; my ($time, $microseconds) = gettimeofday; $time = ($time =~ m/(\d+)/)[0]; $microseconds =~ s/\D//g; my $unique = "P$$" . "M$microseconds" . "Q" . $maildir_counter++; my $file = join ".", $time, $unique, $self->{_hostname}; open(MF, ">$maildir/tmp/$file") or $self->log(LOGWARN, "could not open $maildir/tmp/$file: $!"), return (DECLINED, "queue error (open)"); print MF "Return-Path: ", $transaction->sender->format, "\n"; print MF "Delivered-To: ", $addr->address, "\n" if $addr; # else it had been added before... $transaction->header->print(\*MF); $transaction->body_resetpos; while (my $line = $transaction->body_getline) { print MF $line; } close MF or $self->log(LOGWARN, "could not close $maildir/tmp/$file: $!") and return (DECLINED, "queue error (close)"); link "$maildir/tmp/$file", "$maildir/new/$file" or $self->log(LOGWARN, "could not link $maildir/tmp/$file to $maildir/new/$file: $!") and return (DECLINED, "queue error (link)"); unlink "$maildir/tmp/$file"; my $msg_id = $transaction->header->get('Message-Id') || ''; $msg_id =~ s/[\r\n].*//s; return (OK, "Queued! $msg_id"); } sub deliver_user { my ($self, $transaction, $addr) = @_; my $user = $addr->user; $user =~ tr/-A-Za-z0-9+_.,@=/_/c; my $host = $addr->host; $host =~ tr/-A-Za-z0-9+_.,@=/_/c; my $rcpt = $user . '@' . $host; my $subdir = $self->{_subdirs}; $subdir =~ s/\%l/$user/g; $subdir =~ s/\%d/$host/g; $subdir =~ s/\%u/$rcpt/g; # $subdir =~ s/\%%/%/g; my $maildir = $self->{_maildir} . "/$subdir"; my $old_umask = umask 000; map { my $d = $maildir . "/$_"; -e $d or mkpath $d, 0, $self->{_perms} } qw(cur tmp new); umask $old_umask; return $self->write_file($transaction, $maildir, $addr); } qpsmtpd-0.94/plugins/queue/postfix-queue000066400000000000000000000144671240247602400205210ustar00rootroot00000000000000#!perl -w =head1 NAME postfix-queue =head1 DESCRIPTION This plugin passes mails on to the postfix cleanup daemon. =head1 CONFIG The first optional parameter is the location of the cleanup socket. If it does not start with a ``/'', it is treated as a flag for cleanup (see below). The 'postfix_queue' plugin can also contain a list of cleanup socket paths and/or remote postfix cleanup service hosts specified in the form of 'address:port'. If set, the environment variable POSTFIXQUEUE overrides both of these settings. All other parameters are flags for cleanup, no flags are enabled by default. See below in ``POSTFIX COMPATIBILITY'' for flags understood by your postfix version. Supported by all postfix versions E= 2.1 are: =over 4 =item FLAG_FILTER Set the CLEANUP_FLAG_FILTER for cleanup. This enables the use of I, I or I in postfix' main.cf. =item FLAG_BCC_OK Setting this flag enables (for example) the I parameter =item FLAG_MAP_OK This flag enables the use of other recipient mappings (e.g. I) in postfix' cleanup. =item FLAG_MASK_EXTERNAL This flag mask combines FLAG_FILTER, FLAG_MILTER (only in postfix >= 2.3) FLAG_BCC_OK and FLAG_MAP_OK and is used by postfix for external messages. This is probably what you want to use. =back For more flags see below in ``POSTFIX COMPATIBILITY'', your postfix version (grep _FLAG_ src/global/cleanup_user.h) and/or lib/Qpsmtpd/Postfix/Constants.pm =head1 POSTFIX COMPATIBILITY The first version of this plugin was written for postfix 1.x. The next step for Postfix 2.1 (and later) was to add the FLAG_FILTER, FLAG_BCC_OK and FLAG_MAP_OK flags for submission to the cleanup deamon. This version can use all flags found in Postfix 2.x (up to 2.4 currently). Unknown flags are ignored by the cleanup daemon (just tested with postfix 2.1), so it should be safe to set flags just understood by later versions of postfix/cleanup. Even if all known flags can be set, some are not that useful when feeding the message from qpsmtpd, e.g. =head2 FLAG_NONE no effect =head2 FLAG_DISCARD DON'T USE, use another plugin which hooks the I and returns B just for the messages you want to drop. As long as this plugin does not support setting queue flags on the fly from other modules, this flag would drop ALL messages. Don't use! =head2 FLAG_BOUNCE Qpsmtpd should be configured not to accept bad messages... =head2 FLAG_HOLD Not useful in production setup, maybe in testing environment (untested, what real effects this has). =over 4 =item Flags known by postfix 1.1: FLAG_NONE - No special features FLAG_BOUNCE - Bounce bad messages FLAG_FILTER - Enable content filter =item Flags known by postfix 2.1, 2.2 all flags from postfix 1.1, plus the following: FLAG_HOLD - Place message on hold FLAG_DISCARD - Discard message silently FLAG_BCC_OK - Ok to add auto-BCC addresses FLAG_MAP_OK - Ok to map addresses FLAG_MASK_INTERNAL - alias for FLAG_MAP_OK FLAG_MASK_EXTERNAL - FILTER, BCC_OK and MAP_OK =item Flags known by postfix 2.3 all flags from postfix 2.1, up to FLAG_MASK_INTERNAL. New or changed: FLAG_MILTER - Enable Milter applications FLAG_FILTER_ALL - FILTER and MILTER FLAG_MASK_EXTERNAL - FILTER_ALL, BCC_OK, MAP_OK =item Flags known by postfix 2.4 currently (postfix-2.4-20061019) the same as 2.3 =back =head1 MAYBE IN FUTURE Settings the (additional) queue flags from another plugin. Currently at the beginning of I all flags are reset to the flags given as plugin parameters. =cut use Qpsmtpd::Postfix; use Qpsmtpd::Postfix::Constants; sub register { my ($self, $qp, @args) = @_; $self->log(LOGDEBUG, "using constants generated from Postfix" . "v$postfix_version"); $self->{_queue_flags} = 0; if (@args > 0) { if ($args[0] =~ m#^(/.+)#) { # untaint socket path $self->{_queue_socket} = $1; shift @args; } foreach (@args) { if ($self->can("CLEANUP_" . $_) and /^(FLAG_[A-Z0-9_]+)$/) { $_ = $1; $self->{_queue_flags} |= (eval "CLEANUP_$_;" || 0); #print STDERR "queue flag: $_: ".$self->{_queue_flags}."\n"; } else { $self->log(LOGWARN, "Ignoring unkown cleanup flag $_"); } } } else { $self->{_queue_socket} = "/var/spool/postfix/public/cleanup"; } $self->{_queue_socket_env} = $ENV{POSTFIXQUEUE} if $ENV{POSTFIXQUEUE}; } sub hook_queue { my ($self, $transaction) = @_; $transaction->notes('postfix-queue-flags', $self->{_queue_flags}); my @queue; @queue = ($self->{_queue_socket_env}) if $self->{_queue_socket_env}; @queue = $self->qp->config('cleanup_sockets') unless @queue; @queue = ($self->{_queue_socket} // ()) unless @queue; $transaction->notes('postfix-queue-sockets', \@queue) if @queue; # $self->log(LOGDEBUG, "queue-flags=".$transaction->notes('postfix-queue-flags')); my ($status, $qid, $reason) = Qpsmtpd::Postfix->inject_mail($transaction); if ($status) { # this split is needed, because if cleanup returns # CLEANUP_STAT_MASK_INCOMPLETE we might return DENY (CLEANUP_STAT_SIZE) # instead of DENYSOFT (CLEANUP_STAT_WRITE, CLEANUP_STAT_BAD, # CLEANUP_STAT_DEFER) ... n.b. this is the behaviour of 667. foreach my $key (keys %cleanup_soft) { my $stat = eval $key # keys have the same names as the constants or next; if ($status & $stat) { return (DENYSOFT, $reason || $cleanup_soft{$key}); } } foreach my $key (keys %cleanup_hard) { my $stat = eval $key # keys have the same names as the constants or next; if ($status & $stat) { return (DENY, $reason || $cleanup_hard{$key}); } } # we have no idea why we're here. return (DECLINED, $reason || "Unable to queue message ($status, $reason)"); } my $msg_id = $transaction->header->get('Message-Id') || ''; $msg_id =~ s/[\r\n].*//s; # don't allow newlines in the Message-Id here return (OK, "Queued! $msg_id (Queue-Id: $qid)"); } qpsmtpd-0.94/plugins/queue/qmail-queue000066400000000000000000000072611240247602400201220ustar00rootroot00000000000000#!perl -w =head1 NAME qmail-queue =head1 DESCRIPTION This is the most common plugin used to queue incoming mails. A variation of this plugin would maybe forward the mail via smtp. =head1 CONFIG It takes one optional parameter, the location of qmail-queue. This makes it easy to use a qmail-queue replacement. queue/qmail-queue /var/qmail/bin/another-qmail-queue If set the environment variable QMAILQUEUE overrides this setting. =cut use strict; use warnings; use Qpsmtpd::Constants; use POSIX (); sub register { my ($self, $qp, @args) = @_; if (@args > 0) { $self->{_queue_exec} = $args[0]; $self->log(LOGWARN, "WARNING: Ignoring additional arguments.") if @args > 1; } $self->{_queue_exec} ||= ($ENV{QMAIL} || '/var/qmail') . "/bin/qmail-queue"; $self->{_queue_exec} = $ENV{QMAILQUEUE} if $ENV{QMAILQUEUE}; } sub hook_queue { my ($self, $transaction) = @_; # these bits inspired by Peter Samuels "qmail-queue wrapper" pipe(MESSAGE_READER, MESSAGE_WRITER) or die "Could not create message pipe"; pipe(ENVELOPE_READER, ENVELOPE_WRITER) or die "Could not create envelope pipe"; local $SIG{PIPE} = sub { die 'SIGPIPE' }; my $child = fork(); !defined $child and die "Could not fork"; if ($child) { # Parent my $oldfh = select MESSAGE_WRITER; $| = 1; select ENVELOPE_WRITER; $| = 1; select $oldfh; close MESSAGE_READER or die "close msg reader fault"; close ENVELOPE_READER or die "close envelope reader fault"; $transaction->header->print(\*MESSAGE_WRITER); $transaction->body_resetpos; while (my $line = $transaction->body_getline) { print MESSAGE_WRITER $line; } close MESSAGE_WRITER; my @rcpt = map { "T" . $_->address } $transaction->recipients; my $from = "F" . ($transaction->sender->address || ""); print ENVELOPE_WRITER "$from\0", join("\0", @rcpt), "\0\0" or return (DECLINED, "Could not print addresses to queue"); close ENVELOPE_WRITER; waitpid($child, 0); my $exit_code = $? >> 8; $exit_code and return (DECLINED, "Unable to queue message ($exit_code)"); my $msg_id = $transaction->header->get('Message-Id') || ''; $msg_id =~ s/[\r\n].*//s; # don't allow newlines in the Message-Id here $msg_id = "<$msg_id>" unless $msg_id =~ /^<.*>$/; # surround in <>'s return (OK, "Queued! " . time . " qp $child $msg_id"); } elsif (defined $child) { # Child close MESSAGE_WRITER or exit 1; close ENVELOPE_WRITER or exit 2; # Untaint $self->{_queue_exec} my $queue_exec = $self->{_queue_exec}; if ($queue_exec =~ /^(\/[\/\-\_\.a-z0-9A-Z]*)$/) { $queue_exec = $1; } else { $self->log(LOGERROR, "FATAL ERROR: Unexpected characters in qmail-queue plugin argument" ); # This exit is ok as we're exiting a forked child process. exit 3; } # save the original STDIN and STDOUT in case exec() fails below open(SAVE_STDIN, "<&STDIN"); open(SAVE_STDOUT, ">&STDOUT"); POSIX::dup2(fileno(MESSAGE_READER), 0) or die "Unable to dup MESSAGE_READER: $!"; POSIX::dup2(fileno(ENVELOPE_READER), 1) or die "Unable to dup ENVELOPE_READER: $!"; my $ppid = getppid(); $self->log(LOGNOTICE, "(for $ppid) Queuing to $queue_exec"); my $rc = exec $queue_exec; # close the pipe close(MESSAGE_READER); close(MESSAGE_WRITER); exit 6; # we'll only get here if the exec fails } } qpsmtpd-0.94/plugins/queue/smtp-forward000066400000000000000000000107101240247602400203130ustar00rootroot00000000000000#!perl -w =head1 NAME smtp-forward =head1 DESCRIPTION This plugin forwards the mail via SMTP to a specified server, rather than delivering the email locally. It also supports the Postfix XCLIENT extension. =head1 CONFIG It takes one required parameter, the IP address or hostname to forward to. queue/smtp-forward 10.2.2.2 Optionally you can also add a port: queue/smtp-forward 10.2.2.2 9025 And a flag: queue/smtp-forward 10.2.2.2 9025 xclient =cut use Net::SMTP; use Net::Cmd qw//; sub init { my ($self, $qp, @args) = @_; if (@args <= 0) { die "No SMTP server specified in smtp-forward config"; }; if ($args[0] =~ /^([\.\w_-]+)$/) { $self->{_smtp_server} = $1; } else { die "Bad data in smtp server: $args[0]"; } $self->{_smtp_port} = 25; if (@args > 1 and $args[1] =~ /^(\d+)$/) { $self->{_smtp_port} = $1; } for (my $i = 2; $i < @args; $i++) { if ($args[$i] !~ /^(\w+)$/) { $self->log(LOGWARN, "WARNING: Rejecting invalid flag"); next; } my $flag = lc($1); $self->log(LOGWARN, "WARNING: Unknown flag $flag") unless $flag eq 'xclient'; $self->{_flags}{$flag} = 1; } } sub hook_queue { my ($self, $transaction) = @_; $self->log(LOGINFO, "forwarding to $self->{_smtp_server}:$self->{_smtp_port}"); my $smtp = Net::SMTP->new( $self->{_smtp_server}, Port => $self->{_smtp_port}, Timeout => 60, Hello => $self->qp->config("me"), ) || die $!; my $xcret = $self->xclient($smtp); return(DECLINED, $xcret) if defined $xcret; $smtp->mail($transaction->sender->address || "") or return (DECLINED, "Unable to queue message ($!)"); for ($transaction->recipients) { $smtp->to($_->address) or return (DECLINED, "Unable to queue message ($!)"); } $smtp->data() or return (DECLINED, "Unable to queue message ($!)"); $smtp->datasend($transaction->header->as_string) or return (DECLINED, "Unable to queue message ($!)"); $transaction->body_resetpos; while (my $line = $transaction->body_getline) { $smtp->datasend($line) or return (DECLINED, "Unable to queue message ($!)"); } $smtp->dataend() or return (DECLINED, "Unable to queue message ($!)"); my $qid = $smtp->message(); my @list = split(' ', $qid); $qid = pop(@list); $smtp->quit() or return (DECLINED, "Unable to queue message ($!)"); $self->log(LOGINFO, "finished queueing"); return (OK, "queued as $qid"); } sub xclient { my ($self, $smtp) = @_; return unless $self->{_flags}{xclient}; my $parts = $smtp->supports('XCLIENT'); if (!defined($parts)) { # what parts do they want? return "Unable to queue message (Server does not advertise XCLIENT support)"; }; my %haveparts; for my $part (split(/\s+/, $parts)) { next unless $part =~ /^(\w+)$/; $haveparts{uc($part)} = 1; } my $conn = $self->qp->connection; my @rparts; if ($haveparts{NAME}) { my $name = $conn->remote_host || '[UNAVAILABLE]'; $name = '[UNAVAILABLE]' if ($name eq 'Unknown'); push(@rparts, "NAME=$name"); } if ($haveparts{ADDR}) { my $ip = $conn->remote_ip; push(@rparts, "ADDR=$ip"); } if ($haveparts{PORT}) { my $port = $conn->remote_port; push(@rparts, "PORT=$port"); } my $hello_name = $self->connection->hello_host; $hello_name ||= '[UNAVAILABLE]'; if ($haveparts{HELO}) { push(@rparts, "HELO=$hello_name"); } my $hello = $conn->hello; if ($haveparts{PROTO} && defined($hello)) { my $proto = (uc($hello) eq 'EHLO') ? 'ESMTP' : 'SMTP'; push(@rparts, "PROTO=$proto"); } while (scalar(@rparts)) { my @items; my $cursz = 0; while (defined(my $item = $rparts[0])) { my $len = length($item); last if ($cursz + $len > 500); $cursz += $len; push(@items, shift @rparts); } last unless @items; if ($smtp->command('XCLIENT', @items)->response() != Net::Cmd::CMD_OK) { return "Unable to queue message (XCLIENT failed)"; } } $smtp->hello($hello_name) or return "Unable to queue message (HELLO after XCLIENT failed)"; return; } qpsmtpd-0.94/plugins/quit_fortune000066400000000000000000000007361240247602400172750ustar00rootroot00000000000000#!perl -w sub hook_quit { my $qp = shift->qp; # if she talks EHLO she is probably too sophisticated to enjoy the # fun, so skip it. return (DECLINED) if ($qp->connection->hello || '') eq "ehlo"; my $fortune = '/usr/games/fortune'; return DECLINED unless -e $fortune; my @fortune = `$fortune -s`; @fortune = map { chop; s/^/ \/ /; $_ } @fortune; $qp->respond(221, $qp->config('me') . " closing connection.", @fortune); return DONE; } qpsmtpd-0.94/plugins/random_error000066400000000000000000000034251240247602400172400ustar00rootroot00000000000000#!perl -w use strict; use warnings; use Qpsmtpd::Constants; =head1 NAME random_error =head1 DESCRIPTION This plugin randomly disconnects and issues DENYSOFTs. =head1 CONFIG one parameter is allowed, which is how often to error, as a percentage of messages. The default is 1. Use a negative number to disable. 2/5 of failures are DENYSOFT_DISCONNECT, 3/5 simply DENYSOFT. For use with other plugins, scribble the revised failure rate to $self->connection->notes('random_fail_%'); =cut sub register { my ($self, $qp, @args) = @_; die "Invalid args: '@args'" unless @args < 2; ($self->{__PACKAGE__ . '_how'}) = $args[0] || 1; } sub NEXT() { DECLINED } sub random_fail { my $fpct = $_[0]->connection->notes('random_fail_%'); =head1 calculating the probability of failure There are six tests a message must pass to reach the queueing stage, and we wish to provide random failure for each one, with the combined probability being out configuration argument. So we want to solve this equation: (1-x) ** 6 = ( 1 - input_number ) or x = 1 - ( (1 - input_number ) ** (1/6) ) =cut my $successp = 1 - ($fpct / 100); $_[0]->log(LOGINFO, "to fail, rand(1) must be more than " . ($successp**(1 / 6))); rand(1) < ($successp**(1 / 6)) and return NEXT; rand(5) < 2 and return (DENYSOFT_DISCONNECT, "random failure"); return (DENYSOFT, "random failure"); } sub hook_connect { $_[0]->connection->notes('random_fail_%', $_[0]->{__PACKAGE__ . '_how'}); goto &random_fail; } sub hook_helo { goto &random_fail; } sub hook_ehlo { goto &random_fail; } sub hook_mail { goto &random_fail; } sub hook_rcpt { goto &random_fail; } sub hook_data { goto &random_fail; } sub hook_data_post { goto &random_fail; } qpsmtpd-0.94/plugins/rcpt_map000066400000000000000000000121311240247602400163460ustar00rootroot00000000000000#!perl -w =head1 NAME rcpt_map - check recipients against recipient map =head1 DESCRIPTION B reads a list of adresses, return codes and comments from the supplied config file. Adresses are compared with I. The recipient addresses are checked against this list, and if the first matches, the return code from that line and the comment are returned to qpsmtpd. Return code can be any valid plugin return code from L. Matching is always done case insenstive. When the given map file changes on disk, it is re-read in the pre-connection hook. =head1 ARGUMENTS The C and C arguments are required. The default value of the C argument is C (see below why C<_>). =over 4 =item domain NAME If the recipient address does not match this domain name NAME, this plugin will return C =item file MAP Use the config file as map file, format as explained below =item default CODE[=MSG] Use CODE as default return code (and return MSG as message) if a recipient was B found in the map. Since we can't use spaces in MSG, every C<_> is replaced by a space, i.e. use C if you want a deny message C. =back =head1 CONFIG FILE The config file contains lines with an address, a return code and a comment, which will be returned to the sender, if the code is not OK or DECLINED. Example: # example_org_map - config for rcpt_map plugin me@example.org OK you@example.org OK info@example.org DENY User not found. =head1 NOTES We're currently running this plugin like shown in the following example. Excerpt from the C config file: ## list of valid users, config in /srv/qpsmtpd/config/rcpt_regexp ## ... except for "*@example.org": rcpt_regexp ## only for "@example.org": rcpt_map domain example.org file /srv/qpsmtpd/config/map_example_org And the C config file: ### "example.org" addresses are checked later by the rcpt_map ### plugin, return DECLINED here: /^.*\@example\.org$/ DECLINED ### all other domains just check for valid users, the validity ### of the domain is checked by the rcpt_ok plugin => never use ### something else than "DENY" or "DECLINED" here! /^(abuse|postmaster)\@/ DECLINED /^(me|you)\@/ DECLINED /^.*$/ DENY No such user. =head1 COPYRIGHT AND LICENSE Copyright (c) 2009 Hanno Hecker This plugin is licensed under the same terms as the qpsmtpd package itself. Please see the LICENSE file included with qpsmtpd for details. =cut use Qpsmtpd::Constants; our %map; sub register { my ($self, $qp, %args) = @_; foreach my $arg (qw(domain file default)) { next unless exists $args{$arg}; if ($arg eq "default") { my ($code, $msg) = split /=/, $args{$arg}; $code = Qpsmtpd::Constants::return_code($code); die "Not a valid constant for 'default' arg" unless defined $code; $msg or $msg = "No such user."; $msg =~ s/_/ /g; $self->{_default} = [$code, $msg]; } else { $self->{"_$arg"} = $args{$arg}; } } $self->{_default} or $self->{_default} = [DENY, "No such user."]; $self->{_file} or die "No map file given..."; $self->{_domain} or die "No domain name given..."; $self->{_domain} = lc $self->{_domain}; $self->log(LOGDEBUG, "Using map " . $self->{_file} . " for domain " . $self->{_domain}); %map = $self->read_map(1); die "Empty map file " . $self->{_file} unless keys %map; } sub hook_pre_connection { my $self = shift; my ($time) = (stat($self->{_file}))[9] || 0; if ($time > $self->{_time}) { my %temp = $self->read_map(); keys %temp or return DECLINED; %map = %temp; } return DECLINED; } sub read_map { my $self = shift; my %hash = (); open F, $self->{_file} or do { $_[0] ? die "ERROR opening: $!" : return (); }; ($self->{_time}) = (stat(F))[9] || 0; my $line = 0; while () { ++$line; s/^\s*//; next if /^#/; next unless $_; my ($addr, $code, $msg) = split / /, $_, 3; next unless $addr; unless ($code) { $self->log(LOGERROR, "No constant in line $line in " . $self->{_file}); next; } $code = Qpsmtpd::Constants::return_code($code); unless (defined $code) { $self->log(LOGERROR, "Not a valid constant in line $line in " . $self->{_file}); next; } $msg or $msg = "No such user."; $hash{$addr} = [$code, $msg]; } return %hash; } sub hook_rcpt { my ($self, $transaction, $recipient) = @_; return (DECLINED) unless $recipient->host && $recipient->user; return (DECLINED) unless lc($recipient->host) eq $self->{_domain}; my $rcpt = lc $recipient->user . '@' . lc $recipient->host; return (@{$self->{_default}}) unless exists $map{$rcpt}; return @{$map{$rcpt}}; } qpsmtpd-0.94/plugins/rcpt_ok000066400000000000000000000046471240247602400162170ustar00rootroot00000000000000#!perl -w =head1 NAME rcpt_ok =head1 SYNOPSIS Validate that we accept mail for a recipient using a qmail rcpthosts file =head1 DESCRIPTION Check the envelope recipient hostname and determine if we accept mail to that host. This is functionally identical to qmail's rcpthosts implementation, consulting both rcpthosts and morercpthosts.cdb. =head1 CONFIGURATION It should be configured as the _LAST_ recipient plugin! =cut use strict; use warnings; use Qpsmtpd::Constants; use Qpsmtpd::DSN; sub hook_rcpt { my ($self, $transaction, $recipient, %param) = @_; return (OK) if $self->is_immune(); # relay_client or whitelist # Allow 'no @' addresses for 'postmaster' and 'abuse' # qmail-smtpd will do this for all users without a domain, but we'll # be a bit more picky. Maybe that's a bad idea. my $host = $self->get_rcpt_host($recipient) or return (OK); return (OK) if $self->is_in_rcpthosts($host); return (OK) if $self->is_in_morercpthosts($host); # default of relaying_denied is obviously DENY, # we use the default "Relaying denied" message... return Qpsmtpd::DSN->relaying_denied(); } sub is_in_rcpthosts { my ($self, $host) = @_; my @rcpt_hosts = ($self->qp->config('me'), $self->qp->config('rcpthosts')); # Check if this recipient host is allowed for my $allowed (@rcpt_hosts) { $allowed =~ s/^\s*(\S+)/$1/; if ($host eq lc $allowed) { $self->log(LOGINFO, "pass: $host in rcpthosts"); return 1; } if (substr($allowed, 0, 1) eq '.' and $host =~ m/\Q$allowed\E$/i) { $self->log(LOGINFO, "pass: $host in rcpthosts as $allowed"); return 1; } } return; } sub is_in_morercpthosts { my ($self, $host) = @_; my $more_rcpt_hosts = $self->qp->config('morercpthosts', 'map'); if (exists $more_rcpt_hosts->{$host}) { $self->log(LOGINFO, "pass: $host found in morercpthosts"); return 1; } $self->log(LOGINFO, "fail: $host not in morercpthosts"); return; } sub get_rcpt_host { my ($self, $recipient) = @_; return if !$recipient; # Qpsmtpd::Address couldn't parse the recipient if ($recipient->host) { return lc $recipient->host; } # no host portion exists my $user = $recipient->user or return; if (lc $user eq 'postmaster' || lc $user eq 'abuse') { return $self->qp->config('me'); } return; } qpsmtpd-0.94/plugins/rcpt_regexp000066400000000000000000000060271240247602400170720ustar00rootroot00000000000000#!perl -w =head1 NAME rcpt_regexp - check recipients against a list of regular expressions =head1 DESCRIPTION B reads a list of regular expressions, return codes and comments from the I config file. If the regular expression does NOT match I, it is used as a string which is compared with I. The recipient addresses are checked against this list, and if the first matches, the return code from that line and the comment are returned to qpsmtpd. Return code can be any valid plugin return code from L. Matching is always done case insenstive. =head1 CONFIG FILE The config file I contains lines with a perl RE, including the "/"s, a return code and a comment, which will be returned to the sender, if the code is not OK or DECLINED. Example: # rcpt_regexp - config for rcpt_regexp plugin me@myhost.org OK Accepting mail /^user\d+\@doma\.in$/ OK Accepting mail info@myhost.com DENY User not found. /^unused\@.*/ DENY User not found. /^.*$/ DECLINED Fall through to next rcpt plugin =head1 NOTE The C config file should be writeable by trusted users only: the regexes are compiled with I. =head1 COPYRIGHT AND LICENSE Copyright (c) 2005 Hanno Hecker This plugin is licensed under the same terms as the qpsmtpd package itself. Please see the LICENSE file included with qpsmtpd for details. =cut use Qpsmtpd::Constants; sub hook_rcpt { my ($self, $transaction, $recipient) = @_; return (DECLINED) unless $recipient->host && $recipient->user; my $rcpt = lc $recipient->user . '@' . $recipient->host; my ($re, $const, $comment, $str, $ok, $err); foreach ($self->qp->config("rcpt_regexp")) { s/^\s*//; ($re, $const, $comment) = split /\s+/, $_, 3; $str = undef; if ($re =~ m#^/(.*)/$#) { $re = $1; $ok = eval { $re = qr/$re/i; }; if ($@) { ($err = $@) =~ s/\s*at \S+ line \d+\.\s*$//; $self->log(LOGWARN, "REGEXP '$re' not valid: $err"); next; } $re = $ok; } else { $str = lc $re; } unless (defined $const) { $self->(LOGWARN, "rcpt_regexp - no return code"); next; } $ok = $const; $const = Qpsmtpd::Constants::return_code($const); unless (defined $const) { $self->log(LOGWARN, "rcpt_regexp - '$ok' is not a valid " . "constant, ignoring this line" ); next; } if (defined $str) { next unless $str eq $rcpt; $self->log(LOGDEBUG, "String $str matched $rcpt, returning $ok"); } else { next unless $rcpt =~ $re; $self->log(LOGDEBUG, "RE $re matched $rcpt, returning $ok"); } return ($const, $comment); } return (DECLINED); } qpsmtpd-0.94/plugins/registry.txt000066400000000000000000000053511240247602400172350ustar00rootroot00000000000000# This file contains a list of every plugin used on this server. If you have # additional plugins running, add them here. # Fields are whitespace delimited. Columns are ordered by numeric plugin ID. # # the order of plugins in this file determines the order they appear in # summary output # #id name abb3 abb5 aliases # 201 hosts_allow alw allow 202 ident::geoip geo geoip 203 ident::p0f p0f p0f ident::p0f_3a0,ident::p0f_3a1 205 karma krm karma 206 dnsbl dbl dnsbl 207 relay rly relay check_relay,check_norelay,relay_only 208 fcrdns dns fcrdn 300 earlytalker ear early check_earlytalker 301 helo hlo helo check_spamhelo 302 tls tls tls 320 dont_require_anglebrackets rab drabs 321 unrecognized_commands cmd uncmd count_unrecognized_commands 322 noop nop noop noop_counter 323 random_error rnd rande 324 milter mlt mlter 325 content_log log colog # # Authentication # 400 auth::auth_vpopmail_sql avq avsql 401 auth::auth_vpopmaild avd vpopd 402 auth::auth_vpopmail avp vpop 403 auth::auth_checkpassword ack chkpw 404 auth::auth_cvs_unix_local acv cvsul 405 auth::auth_flat_file aff aflat 406 auth::auth_ldap_bind ald aldap 407 auth::authdeny dny adeny # # Sender / Envelope From # 500 badmailfrom bmf badmf check_badmailfrom,check_badmailfrom_patterns 501 badmailfromto bmt bfrto 502 rhsbl rbl rhsbl 504 resolvable_fromhost rfh rsvfh require_resolvable_fromhost 505 sender_permitted_from spf spf # # Recipient / Envelope To # 600 badrcptto bto badto check_badrcptto,check_badrcptto_patterns 601 rcpt_map rmp rcmap 602 rcpt_regex rcx rcrex 603 qmail_deliverable qmd qmd 605 rcpt_ok rok rcpok 608 bogus_bounce bog bogus check_bogus_bounce 609 greylisting gry greyl # # Content Filters # 700 headers hdr headr check_basicheaders 701 loop lop loop 702 uribl uri uribl 710 domainkeys dky dkey 711 dkim dkm dkim 712 dmarc dmc dmarc 720 spamassassin spm spama 721 dspam dsp dspam # # Anti-Virus Plugins # 770 virus::aveclient ave avirs 771 virus::bitdefender bit bitdf 772 virus::clamav cav clamv 773 virus::clamdscan clm clamd 774 virus::hbedv hbv hbedv 775 virus::kavscanner kav kavsc 776 virus::klez_filter klz vklez 777 virus::sophie sop sophe 778 virus::uvscan uvs uvscn # # Queue Plugins # 800 queue::qmail-queue qqm queue queue::qmail_2dqueue 801 queue::maildir qdr qudir 802 queue::postfix-queue qpf qupfx queue::postfix_2dqueue 803 queue::smtp-forward qfw qufwd queue::smtp_2dqueue 804 queue::exim-bsmtp qxm qexim queue::exim_2dbsmtp 900 quit_fortune for fortu 999 connection_time tim time qpsmtpd-0.94/plugins/relay000066400000000000000000000152601240247602400156630ustar00rootroot00000000000000#!perl -w =head1 SYNOPSIS relay - control whether relaying is permitted =head1 DESCRIPTION relay - check the following places to see if relaying is allowed: I<$ENV{RELAYCLIENT}> I, I, I The search order is as shown and cascades until a match is found or the list is exhausted. Note that I is the first file checked. A match there will override matches in the subsequent files. =head1 CONFIG Enable this plugin by adding it to config/plugins above the rcpt_* plugins # other plugins... relay # rcpt_* go here =head2 relayclients A list of IP addresses that are permitted to relay mail through this server. Each line in I is one of: - a full IP address - partial IP address terminated by a dot or colon for matching whole networks 192.168.42. 2001:db8:e431:ae06: ... - a network/mask, aka a CIDR block 10.1.0.0/24 2001:db8:e431:ae06::/64 ... =head2 morerelayclients Additional IP addresses that are permitted to relay. The syntax of the config file is identical to I except that CIDR (net/mask) entries are not supported. If you have many (>50) IPs allowed to relay, most should likely be listed in I where lookups are faster. =head2 norelayclients I allows specific clients, such as a mail gateway, to be denied relaying, even though they would be allowed by I. This is most useful when a block of IPs is allowed in relayclients, but several IPs need to be excluded. The file format is the same as morerelayclients. =head2 RELAY ONLY The relay only option restricts connections to only clients that have relay permission. All other connections are denied during the RCPT phase of the SMTP conversation. This option is useful when a server is used as the smart relay host for internal users and external/authenticated users, but should not be considered a normal inbound MX server. It should be configured to be run before other RCPT hooks! Only clients that have authenticated or are listed in the relayclient file will be allowed to send mail. To enable relay only mode, set the B option to any true value in I as shown: relay only 1 =head1 AUTHOR 2012 - Matt Simerson - Merged check_relay, check_norelay, and relayonly 2006 - relay_only - John Peackock 2005 - check_norelay - Copyright Gordon Rowell 2002 - check_relay - Ask Bjorn Hansen =head1 LICENSE This software is free software and may be distributed under the same terms as qpsmtpd itself. =cut use strict; use warnings; use Qpsmtpd::Constants; use Net::IP qw(:PROC); sub register { my ($self, $qp) = (shift, shift); $self->log(LOGERROR, "Bad arguments") if @_ % 2; $self->{_args} = {@_}; if ($self->{_args}{only}) { $self->register_hook('rcpt', 'relay_only'); } } sub is_in_norelayclients { my $self = shift; my %no_relay_clients = map { $_ => 1 } $self->qp->config('norelayclients'); my $ip = $self->qp->connection->remote_ip; while ($ip) { if (exists $no_relay_clients{$ip}) { $self->log(LOGINFO, "$ip in norelayclients"); return 1; } $ip =~ s/(\d|\w)+(:|\.)?$// or last; # strip off another octet } $self->log(LOGDEBUG, "no match in norelayclients"); return; } sub populate_relayclients { my $self = shift; foreach ($self->qp->config('relayclients')) { my ($network, $netmask) = ip_splitprefix($_); if ($netmask) { push @{$self->{_cidr_blocks}}, $_; next; } $self->{_octets}{$_} = 1; # no prefix, split } } sub is_in_cidr_block { my $self = shift; my $ip = $self->qp->connection->remote_ip or do { $self->log(LOGINFO, "err, no remote_ip?"); return; }; my $cversion = ip_get_version($ip); for (@{$self->{_cidr_blocks}}) { my ($network, $mask) = ip_splitprefix($_); # split IP & CIDR range my $rversion = ip_get_version($network); # get IP version (4 vs 6) my ($begin, $end) = ip_normalize($_, $rversion); # get pool start/end # expand the client address (zero pad it) before converting to binary my $bin_ip = ip_iptobin(ip_expand_address($ip, $cversion), $cversion) or next; next if !$begin || !$end; # probably not a netmask entry if ( ip_bincomp($bin_ip, 'gt', ip_iptobin($begin, $rversion)) && ip_bincomp($bin_ip, 'lt', ip_iptobin($end, $rversion))) { $self->log(LOGINFO, "pass, cidr match ($ip)"); return 1; } } $self->log(LOGDEBUG, "no cidr match"); return; } sub is_octet_match { my $self = shift; my $ip = $self->qp->connection->remote_ip; if ($ip eq '::1') { $self->log(LOGINFO, "pass, octet matched localhost ($ip)"); return 1; } my $more_relay_clients = $self->qp->config('morerelayclients', 'map'); my $ipv6 = $ip =~ /:/ ? 1 : 0; if ($ipv6 && $ip =~ /::/) { # IPv6 compressed notation $ip = Net::IP::ip_expand_address($ip, 6); } while ($ip) { if (exists $self->{_octets}{$ip}) { $self->log(LOGINFO, "pass, octet match in relayclients ($ip)"); return 1; } if (exists $more_relay_clients->{$ip}) { $self->log(LOGINFO, "pass, octet match in morerelayclients ($ip)"); return 1; } # added IPv6 support (Michael Holzt - 2012-11-14) if ($ipv6) { $ip =~ s/[0-9a-f]:?$//; # strip off another nibble chop $ip if ':' eq substr($ip, -1, 1); } else { $ip =~ s/\d+\.?$// or last; # strip off another 8 bits } } $self->log(LOGDEBUG, "no octet match"); return; } sub hook_connect { my ($self, $transaction) = @_; if ($self->is_in_norelayclients()) { $self->qp->connection->relay_client(0); delete $ENV{RELAYCLIENT}; $self->log(LOGINFO, "fail, disabled by norelayclients"); return (DECLINED); } if ($ENV{RELAYCLIENT}) { $self->qp->connection->relay_client(1); $self->log(LOGINFO, "pass, enabled by env"); return (DECLINED); } $self->populate_relayclients(); # 95586 (connect) relay: pass, octet match in relayclients (127.0.0.) if ($self->is_in_cidr_block() || $self->is_octet_match()) { $self->qp->connection->relay_client(1); return (DECLINED); } $self->log(LOGINFO, "skip, no match"); return (DECLINED); } sub relay_only { my $self = shift; if ($self->qp->connection->relay_client) { return (OK); } return (DENY); } qpsmtpd-0.94/plugins/resolvable_fromhost000066400000000000000000000211251240247602400206230ustar00rootroot00000000000000#!perl -w =head1 NAME resolvable_fromhost =head1 SYNOPSIS Determine if the from host resolves to a valid MX or host. =head1 DESCRIPTION The fromhost is the part of the email address after the @ symbol, provided by the sending server during the SMTP conversation. This is usually, but not always, the same as the hostname in the From: header. B tests to see if the fromhost resolves. It saves the results in the transaction note I where other plugins can use that information. Typical results are: a - fromhost resolved as an A record mx - fromhost has valid MX record(s) ip - fromhost was an IP whitelist - skipped checks due to whitelisting null - null sender config - fromhost not resolvable, but I was set. Any other result is an error message with details of the failure. If B is enabled, the from hostname is also stored in I, making it accessible when $sender is not. =head1 CONFIGURATION =head2 reject < 0 | 1 | naughty > If I is set, the old require_resolvable_fromhost plugin behavior of temporary rejection is the default. resolvable_fromhost reject [ 0 | 1 | naughty ] Default: 1 =head2 reject_type reject_type [ perm | temp ] Set I to reject mail instead of deferring it. Default: temp (temporary, aka soft, aka 4xx). =head1 EXAMPLE LOG ENTRIES 80072 (mail) resolvable_fromhost: pass, googlegroups.com has MX at gmr-smtp-in.l.google.com 80108 (mail) resolvable_fromhost: pass, zerobarriers.net has MX at zerobarriers.net 80148 (mail) resolvable_fromhost: pass, uhin.com has MX at filter.itsafemail.com 86627 (mail) resolvable_fromhost: palmalar.com has no MX 86627 (mail) resolvable_fromhost: fail, palmalar.com (SERVFAIL) =head1 AUTHORS 2012 - Matt Simerson - refactored, added: POD, tests, reject, reject_type 2002 - Ask Bjørn Hansen - intial plugin =cut use strict; use warnings; use lib 'lib'; use Qpsmtpd::Constants; use Qpsmtpd::DSN; use Qpsmtpd::TcpServer; use Socket; use Net::DNS qw(mx); use Net::IP qw(:PROC); my %invalid = (); my $has_ipv6 = Qpsmtpd::TcpServer::has_ipv6(); sub register { my ($self, $qp, %args) = @_; foreach (keys %args) { $self->{_args}->{$_} = $args{$_}; } if (!defined $self->{_args}{reject}) { $self->{_args}{reject} = 1; } $self->{_args}{reject_type} ||= 'soft'; } sub hook_mail { my ($self, $transaction, $sender, %param) = @_; return DECLINED if $self->is_immune(); if ($sender eq '<>') { $transaction->notes('resolvable_fromhost', 'null'); $self->log(LOGINFO, "pass, null sender"); return DECLINED; } $self->populate_invalid_networks(); my $resolved = $self->check_dns($sender->host, $transaction); return DECLINED if $resolved; # success, no need to continue #return DECLINED if $sender->host; # reject later my $result = $transaction->notes('resolvable_fromhost') or do { if ($self->{_args}{reject}) { ; $self->log(LOGINFO, 'fail, missing result'); return Qpsmtpd::DSN->temp_resolver_failed($self->get_reject_type(), ''); } $self->log(LOGINFO, 'fail, tolerated, missing result'); return DECLINED; }; return DECLINED if $result =~ /^(?:a|ip|mx)$/; # success return DECLINED if $result =~ /^(?:whitelist|null|naughty)$/; # immunity $self->adjust_karma(-1); if (!$self->{_args}{reject}) { ; $self->log(LOGINFO, "fail, tolerated, $result"); return DECLINED; } $self->log(LOGINFO, "fail, $result"); # log error return Qpsmtpd::DSN->addr_bad_from_system($self->get_reject_type(), "FQDN required in the envelope sender"); } sub check_dns { my ($self, $host, $transaction) = @_; # we can't even parse a hostname out of the address if (!$host) { $transaction->notes('resolvable_fromhost', 'unparsable host'); $self->adjust_karma(-1); return; } $transaction->notes('resolvable_fromhost_host', $host); if ($host =~ m/^\[(\d{1,3}\.){3}\d{1,3}\]$/) { $self->log(LOGINFO, "skip, $host is an IP"); $transaction->notes('resolvable_fromhost', 'ip'); $self->adjust_karma(-1); return 1; } my $res = new Net::DNS::Resolver(dnsrch => 0); $res->tcp_timeout(30); $res->udp_timeout(30); my $has_mx = $self->get_and_validate_mx($res, $host, $transaction); return 1 if $has_mx == 1; # success, has MX! return if $has_mx == -1; # has invalid MX records # at this point, no MX for fh is resolvable my @host_answers = $self->get_host_records($res, $host, $transaction); foreach my $rr (@host_answers) { if ($rr->type eq 'A' || $rr->type eq 'AAAA') { $self->log(LOGINFO, "pass, found A for $host"); $transaction->notes('resolvable_fromhost', 'a'); return $self->ip_is_valid($rr->address); } if ($rr->type eq 'MX') { $self->log(LOGINFO, "pass, found MX for $host"); $transaction->notes('resolvable_fromhost', 'mx'); return $self->mx_address_resolves($rr->exchange, $host); } } return; } sub ip_is_valid { my ($self, $ip) = @_; my ($net, $mask); ### while (($net,$mask) = each %invalid) { ### ... does NOT reset to beginning, will start on ### 2nd invocation after where it denied the first time..., so ### 2nd time the same "MAIL FROM" would be accepted! foreach $net (keys %invalid) { $mask = $invalid{$net}; $mask = pack "B32", "1" x ($mask) . "0" x (32 - $mask); return if $net eq join('.', unpack("C4", inet_aton($ip) & $mask)); } return 1; } sub get_and_validate_mx { my ($self, $res, $host, $transaction) = @_; my @mx = mx($res, $host); if (!scalar @mx) { # no mx records $self->adjust_karma(-1); $self->log(LOGINFO, "$host has no MX"); return 0; } foreach my $mx (@mx) { # if any MX is valid, then we consider the domain resolvable if ($self->mx_address_resolves($mx->exchange, $host)) { $self->log(LOGINFO, "pass, $host has MX at " . $mx->exchange); $transaction->notes('resolvable_fromhost', 'mx'); return 1; } } # if there are MX records, and we got here, none are valid #$self->log(LOGINFO, "fail, invalid MX for $host"); $transaction->notes('resolvable_fromhost', "invalid MX for $host"); $self->adjust_karma(-1); return -1; } sub get_host_records { my ($self, $res, $host, $transaction) = @_; my @answers; my $query = $res->search($host); if ($query) { foreach my $rrA ($query->answer) { push(@answers, $rrA); } } if ($has_ipv6) { $query = $res->search($host, 'AAAA'); if ($query) { foreach my $rrAAAA ($query->answer) { push(@answers, $rrAAAA); } } } if (!scalar @answers) { if ($res->errorstring ne 'NXDOMAIN') { $self->log(LOGWARN, "fail, query for $host, ", $res->errorstring); } return; } return @answers; } sub mx_address_resolves { my ($self, $name, $fromhost) = @_; # IP in MX return $self->ip_is_valid($name) if ip_is_ipv4($name) || ip_is_ipv6($name); my $res = new Net::DNS::Resolver(dnsrch => 0); my @mx_answers; my $query = $res->search($name, 'A'); if ($query) { foreach my $rrA ($query->answer) { push(@mx_answers, $rrA); } } if ($has_ipv6) { my $query = $res->search($name, 'AAAA'); if ($query) { foreach my $rrAAAA ($query->answer) { push(@mx_answers, $rrAAAA); } } } if (!@mx_answers) { if ($res->errorstring eq 'NXDOMAIN') { $self->log(LOGWARN, "fail, query for $fromhost, ", $res->errorstring); } return; } foreach my $rr (@mx_answers) { next if ($rr->type ne 'A' && $rr->type ne 'AAAA'); return $self->ip_is_valid($rr->address); } return; } sub populate_invalid_networks { my $self = shift; foreach my $i ($self->qp->config("invalid_resolvable_fromhost")) { $i =~ s/^\s*//; # trim leading spaces $i =~ s/\s*$//; # trim trailing spaces if ($i =~ m#^((\d{1,3}\.){3}\d{1,3})/(\d\d?)#) { $invalid{$1} = $3; } } } qpsmtpd-0.94/plugins/rhsbl000066400000000000000000000074711240247602400156660ustar00rootroot00000000000000#!perl -w =head1 NAME rhsbl - handle RHSBL lookups =head1 DESCRIPTION Pluging that checks the host part of the sender's address against a configurable set of RBL services. =head1 CONFIGURATION This plugin reads the lists to use from the rhsbl_zones configuration file. Normal domain based dns blocking lists ("RBLs") which contain TXT records are specified simply as: dsn.rfc-ignorant.org To configure RBL services which do not contain TXT records in the DNS, but only A records, specify, after a whitespace, your own error message to return in the SMTP conversation e.g. abuse.rfc-ignorant.org does not support abuse@domain =cut use strict; use warnings; use Qpsmtpd::Constants; sub register { my ($self, $qp) = (shift, shift); if (@_ == 1) { $self->legacy_positional_args(@_); } else { $self->{_args} = {@_}; } $self->{_args}{reject} = 1 if !defined $self->{_args}{reject}; $self->{_args}{reject_type} ||= 'perm'; } sub legacy_positional_args { my ($self, $denial) = @_; if (defined $denial && $denial =~ /^disconnect$/i) { $self->{_args}{reject_type} = 'disconnect'; } else { $self->{_args}{reject_type} = 'perm'; } } sub hook_mail { my ($self, $transaction, $sender, %param) = @_; return DECLINED if $self->is_immune(); if ($sender->format eq '<>') { $self->log(LOGINFO, 'pass, null sender'); return DECLINED; } my %rhsbl_zones = $self->populate_zones() or return DECLINED; my $res = $self->init_resolver(); my @hosts = $sender->host; for my $host (@hosts) { for my $rhsbl (keys %rhsbl_zones) { my $query; # fix to find TXT records, if the rhsbl_zones line doesn't have second field if (defined($rhsbl_zones{$rhsbl})) { $self->log(LOGDEBUG, "Checking $host.$rhsbl for A record"); $query = $res->query("$host.$rhsbl"); } else { $self->log(LOGDEBUG, "Checking $host.$rhsbl for TXT record"); $query = $res->query("$host.$rhsbl", 'TXT'); } if (!$query) { if ($res->errorstring ne 'NXDOMAIN') { $self->log(LOGCRIT, "query failed: ", $res->errorstring); } next; } my $result; foreach my $rr ($query->answer) { $self->log(LOGDEBUG, 'got an ' . $rr->type . ' record ' . $rr->name); if ($rr->type eq 'A') { $self->log(LOGDEBUG, "A record found for $result with IP " . $rr->address); $result = $rr->name; } elsif ($rr->type eq 'TXT') { $result = $rr->txtdata; $self->log(LOGDEBUG, "TXT record found: " . $rr->txtdata); } next if !$result; $self->log(LOGINFO, "fail, $result"); if ($transaction->sender) { my $host = $transaction->sender->host; if ($result =~ /^$host\./) { return $self->get_reject( "Mail from $host rejected because it $result"); } } my $hello = $self->qp->connection->hello_host; return $self->get_reject( "Mail from HELO $hello rejected because it $result"); } } } $self->log(LOGINFO, "pass"); return DECLINED; } sub populate_zones { my $self = shift; my %rhsbl_zones = map { (split /\s+/, $_, 2)[0, 1] } $self->qp->config('rhsbl_zones'); if (!keys %rhsbl_zones) { $self->log(LOGINFO, 'pass, no zones'); return; } return %rhsbl_zones; } qpsmtpd-0.94/plugins/sender_permitted_from000066400000000000000000000213721240247602400211300ustar00rootroot00000000000000#!perl -w =head1 NAME SPF - implement Sender Permitted From =head1 SYNOPSIS Prevents email sender address spoofing by checking the SPF policy of the purported senders domain. Sets the transaction note spf_pass_host if the SPF result is pass. =head1 DESCRIPTION Sender Policy Framework (SPF) is an email validation system designed to prevent source address spoofing. SPF allows administrators to specify which hosts are allowed to send email from a given domain by creating a specific SPF record in the public DNS. Mail exchangers then use the DNS to verify that mail is being sent by a host sanctioned by a given domain administrators. -- http://en.wikipedia.org/wiki/Sender_Policy_Framework The results of a SPF query are stored in a transaction note named 'spfquery'; =head1 CONFIGURATION In config/plugins, add arguments to the sender_permitted_from line. sender_permitted_from reject 3 =head2 reject Set to a value between 1 and 6 to enable the following SPF behaviors: 1 annotate-only, add Received-SPF header, no rejections. 2 defer on DNS failures. Assure there's always a meaningful SPF header. 3 rejected if SPF record says 'fail' 4 stricter reject. Also rejects 'softfail' 5 reject 'neutral' 6 reject if no SPF records, or a syntax error Most sites should start at level 3. It temporarily defers connections (4xx) that have soft SFP failures and only rejects (5xx) messages when the sending domains policy suggests it. SPF levels above 4 are for crusaders who don't mind rejecting some valid mail when the sending server administrator hasn't dotted his i's and crossed his t's. May the deities bless their obsessive little hearts. =head1 SEE ALSO http://spf.pobox.com/ http://en.wikipedia.org/wiki/Sender_Policy_Framework =head1 TODO Check the scope of the SPF policy. If it's too broad (ie, the whole internet is valid), apply karma penalty Examples of too broad: +all, =head1 ACKNOWLDGEMENTS The reject options are modeled after, and aim to match the functionality of those found in the SPF patch for qmail-smtpd. =head1 AUTHOR Matt Simerson - 2013 - populate dmarc_spf note with SPF results Matt Simerson - 2012 - increased policy options from 3 to 6 Matt Simerson - 2011 - rewrote using Mail::SPF Matt Sergeant - 2003 - initial plugin =cut use strict; use warnings; #use Mail::SPF 2.000; # eval'ed in ->register use Qpsmtpd::Constants; sub register { my ($self, $qp, %args) = @_; eval 'use Mail::SPF'; if ($@) { warn "skip: plugin disabled, is Mail::SPF installed?\n"; $self->log(LOGERROR, "skip: plugin disabled, is Mail::SPF installed?"); return; } $self->{_args} = {%args}; if ($self->{_args}{spf_deny}) { $self->{_args}{reject} = 3 if $self->{_args}{spf_deny} == 1; $self->{_args}{reject} = 4 if $self->{_args}{spf_deny} == 2; } if (!$self->{_args}{reject} && $self->qp->config('spfbehavior')) { $self->{_args}{reject} = $self->qp->config('spfbehavior'); } $self->register_hook('mail', 'mail_handler'); $self->register_hook('data_post', 'data_post_handler'); } sub mail_handler { my ($self, $transaction, $sender, %param) = @_; if ( $self->is_immune() ) { $transaction->notes('dmarc_spf', { domain => $sender->host, scope => 'mfrom', result => 'pass', } ); return (DECLINED); }; my $format = $sender->format; if ($format eq '<>' || !$sender->host || !$sender->user) { $self->log(LOGINFO, "skip, null sender"); $transaction->notes('dmarc_spf', { scope => 'helo', result => 'none', } ); return (DECLINED, "SPF - null sender"); } my $from = $sender->user . '@' . lc($sender->host); my $helo = $self->qp->connection->hello_host; my $scope = $from ? 'mfrom' : 'helo'; my %req_params = ( versions => [1, 2], # optional scope => $scope, ip_address => $self->qp->connection->remote_ip, ); if ($scope =~ /^mfrom|pra$/) { $req_params{identity} = $from; $req_params{helo_identity} = $helo if $helo; } elsif ($scope eq 'helo') { $req_params{identity} = $helo; $req_params{helo_identity} = $helo; } $transaction->notes('dmarc_spf', { domain => $scope eq 'helo' ? $helo : $sender->host, scope => $scope, result => 'none', } ); my $spf_server = Mail::SPF::Server->new(); my $request = Mail::SPF::Request->new(%req_params); my $result = $spf_server->process($request) or do { $self->log(LOGINFO, "fail, no result"); return DECLINED; }; $transaction->notes('spfquery', $result); my $code = $result->code; my $why = $result->local_explanation; my $reject = $self->{_args}{reject}; if (!$code) { $self->log(LOGINFO, "fail, no response"); return (DENYSOFT, "SPF - no response") if $reject >= 2; return (DECLINED, "SPF - no response"); } $transaction->notes('dmarc_spf', { domain => $scope eq 'helo' ? $helo : $sender->host, scope => $scope, result => $code, } ); $self->store_auth_results("spf=$code smtp.mailfrom=".$sender->host); if ($code eq 'pass') { $self->adjust_karma(1); $transaction->notes('spf_pass_host', lc $sender->host); $self->log(LOGINFO, "pass, $why"); return (DECLINED); } if (!$reject) { $self->log(LOGINFO, "skip, tolerated ($code: $why)"); return (DECLINED, "SPF - $code: $why"); } # SPF result codes: pass fail softfail neutral none error permerror temperror return $self->handle_code_none($reject, $why) if $code eq 'none'; return $self->handle_code_fail($reject, $why) if $code eq 'fail'; return $self->handle_code_softfail($reject, $why) if $code eq 'softfail'; if ($code eq 'neutral') { if ($reject >= 5 ) { $self->log(LOGINFO, "fail, $code, $why"); return (DENY, "SPF - $code: $why"); }; $self->log(LOGINFO, "fail, tolerated, $code, $why"); return (DECLINED); } if ($code =~ /(?:permerror|error)/ ) { $self->log(LOGINFO, "fail, $code, $why") if $reject > 3; return (DENY, "SPF - $code: $why") if $reject >= 6; return (DENYSOFT, "SPF - $code: $why") if $reject > 3; $self->log(LOGINFO, "fail, tolerated, $code, $why"); return (DECLINED); } if ($code eq 'temperror') { $self->log(LOGINFO, "fail, $code, $why"); return (DENYSOFT, "SPF - $code: $why") if $reject >= 2; $self->log(LOGINFO, "fail, tolerated, $code, $why"); return (DECLINED); } $self->log(LOGINFO, "SPF from $from was $code: $why"); return (DECLINED); } sub handle_code_none { my ($self, $reject, $why) = @_; if ($reject >= 6) { $self->log(LOGINFO, "fail, none, $why"); return (DENY, "SPF - none: $why"); } $self->log(LOGINFO, "skip, tolerated, none, $why"); return DECLINED; } sub handle_code_fail { my ($self, $reject, $why) = @_; $self->adjust_karma(-1); if ($reject >= 2) { $self->log(LOGINFO, "fail, $why"); return (DENY, "SPF - forgery: $why") if $reject >= 3; return (DENYSOFT, "SPF - fail: $why"); } $self->log(LOGINFO, "fail, tolerated, $why"); return DECLINED; } sub handle_code_softfail { my ($self, $reject, $why) = @_; $self->adjust_karma(-1); if ($reject >= 3) { $self->log(LOGINFO, "fail, soft, $why"); return (DENY, "SPF - fail: $why") if $reject >= 4; return (DENYSOFT, "SPF - fail: $why") if $reject >= 3; } $self->log(LOGINFO, "fail, tolerated, soft, $why"); return DECLINED; } sub data_post_handler { my ($self, $transaction) = @_; my $result = $transaction->notes('spfquery') or return DECLINED; # if we skipped processing in mail_handler, we should skip here too return (DECLINED) if $self->is_immune(); $self->log(LOGDEBUG, "result was $result->code"); if (!$transaction->header) { $self->log(LOGERROR, "missing headers!"); return DECLINED; } $transaction->header->add('Received-SPF', $result->received_spf_header, 0); return DECLINED; } sub is_special_recipient { my ($self, $rcpt) = @_; if (!$rcpt) { $self->log(LOGINFO, "skip: missing recipient"); return 1; } if (!$rcpt->user) { $self->log(LOGINFO, "skip: missing user"); return 1; } # special addresses don't get SPF-tested. if ($rcpt->user =~ /^(?:postmaster|abuse|mailer-daemon|root)$/i) { $self->log(LOGINFO, "skip: special user (" . $rcpt->user . ")"); return 1; } return; } qpsmtpd-0.94/plugins/spamassassin000066400000000000000000000375621240247602400172650ustar00rootroot00000000000000#!perl -w =head1 NAME spamassassin - SpamAssassin integration for qpsmtpd =head1 DESCRIPTION Plugin that checks if the mail is spam by using the "spamd" daemon from the SpamAssassin package. F SpamAssassin 2.6 or newer is required. Stores the results in a note named spamassassin (for other plugins). The note is a hashref with whatever fields are defined in your spamassassin config. These are the common ones: score,required,autolearn,tests,version =head1 CONFIG Configured in the plugins file without any parameters, the spamassassin plugin will add relevant headers from spamd (X-Spam-Status etc). The format goes like spamassassin option value [option value] Options being those listed below and the values being parameters to the options. Confused yet? :-) It looks like this in practice: spamassassin reject 7 leave_old_headers keep =over 4 =item reject [threshold] Set the threshold where the plugin will reject the mail. Some mail servers are so useless that they ignore 55x responses not coming after RCPT TO, so they might just keep retrying and retrying and retrying until the mail expires from their queue. Depending on your spamassassin configuration a reasonable setting is typically somewhere between 12 to 20. The default is to never reject mail based on the SpamAssassin score. =item munge_subject_threshold [threshold] Set the threshold where the plugin will prefix the subject with the value of C. A modified subject is easier to filter on than the other headers for many people with not so clever mail clients. You might want to make another plugin that does this on a per user basis. The default is to never munge the subject based on the SpamAssassin score. =item subject_prefix [prefix] What to prefix the subject with if the message is detected as spam (i.e. if score is greater than C. Defaults to C<*** SPAM ***> =item spamd_socket [/path/to/socket|spamd.host:port] Beginning with Mail::SpamAssassin 2.60, it is possible to use Unix domain sockets for spamd. This is faster and more secure than using a TCP connection, but if you run spamd on a remote machine, you need to use a TCP connection. =item headers [none] By default, spamassasin headers are added to messages. To suppress header insertion, use 'headers none'. =item leave_old_headers [drop|rename|keep] Another mail server before might have checked this mail already and may have added X-Spam-Status, X-Spam-Flag and X-Spam-Check-By lines. Normally you can not trust such headers and should either rename them to X-Old-... (default, parameter 'rename') or have them removed (parameter 'drop'). If you know what you are doing, you can also leave them intact (parameter 'keep'). =item spamd_user [username] The username to pass to spamd, if different from the user qpsmtpd runs as. =item relayclient skip What special treatment is offered to connection with relay permission? Relay permissions are granted when the connecting IP is listed in the relayclients file and/or when the user has authenticated. The only valid option at present is 'skip', which skips SA scoring. If SpamAssasin has certain network tests enabled, users may get elevated spam scores because their dynamic IP space is properly listed on DUL blocking lists. If the user is authenticated or coming from a trusted IP, odds are we don't want to be reject their messages. Especially when running qpsmtpd on port 587. =back With both of the first options the configuration line will look like the following spamasssasin reject 18 munge_subject_threshold 8 =head1 MULTIPLE RECIPIENT BEHAVIOR This plugin supports per-user SpamAssassin preferences. When per-user SA prefs are enabled (by setting spamd_user = vpopmail), the message recipient is used as the spamd username. If SpamAssassin has per-user preferences enabled, it will consult the users spam preferences when scoring the message. When a message has multiple recipients, we do not change the spamd username. The message is still scored by SA, but per-user preferences are not consulted. To aid in debugging, messages with multiple recipents will have an X-Spam-User header inserted. Admins and savvy users can look for that header to confirm the reason their personal prefs were not consulted. To get per-user SA prefs to work for messages with multiple recipients, the LDA should be configured to check for the presence of the X-Spam-User header. If the X-Spam-User header is present, the LDA should submit the message to spamd for re-processing with the recipients address. =head1 TODO Make the "subject munge string" configurable =head1 CHANGES 2012.04.02 - Matt Simerson * refactored for ease of maintenance * added support for per-user SpamAssassin preferences * updated get_spam_results so that score=N.N works (as well as hits=N.N) * rewrote the X-Spam-* header additions so that SA generated headers are preserved. Admins can alter SA headers with add_header in their SA config. Subverting their changes there is unexpected. Making them read code to figure out why is an unnecessary hurdle. * added assemble_message, so we can calc content size which spamd wants =cut use strict; use warnings; use Qpsmtpd::Constants; use Qpsmtpd::DSN; use Socket qw(:DEFAULT :crlf); use IO::Handle; sub register { my ($self, $qp, %args) = @_; $self->log(LOGERROR, "Bad parameters for the spamassassin plugin") if @_ % 2; $self->{_args} = {%args}; # backwards compatibility with previous config syntax if ( !defined $self->{_args}{reject} && defined $self->{_args}{reject_threshold}) { $self->{_args}{reject} = $self->{_args}{reject_threshold}; } if (!defined $self->{_args}{reject_type}) { $self->{_args}{reject_type} = 'perm'; } $self->register_hook('data_post', 'data_post_handler'); } sub data_post_handler { my ($self, $transaction) = @_; return (DECLINED) if $self->is_immune(); if ($transaction->data_size > 500_000) { $self->log(LOGINFO, "skip, too large (" . $transaction->data_size . ")"); return (DECLINED); } my $SPAMD = $self->connect_to_spamd() or return (DECLINED); my $username = $self->select_spamd_username($transaction); my $message = $self->assemble_message($transaction); my $length = length $message; $self->print_to_spamd($SPAMD, $message, $length, $username); shutdown($SPAMD, 1); # close our side of the socket (tell spamd we're done) my $headers = $self->parse_spamd_response($SPAMD) or return (DECLINED); $self->insert_spam_headers($transaction, $headers, $username); $self->munge_subject($transaction); return $self->reject($transaction); } sub select_spamd_username { my ($self, $transaction) = @_; my $username = $self->{_args}{spamd_user} || getpwuid($>); my $recipient_count = scalar $transaction->recipients; if ($recipient_count > 1) { $self->log(LOGDEBUG, "Message has $recipient_count recipients"); return $username; } if ($username eq 'vpopmail') { # use the recipients email address as username. This enables per-user SA prefs $username = ($transaction->recipients)[0]->address; } else { $self->log(LOGDEBUG, "skipping per-user SA prefs"); } return $username; } sub parse_spamd_response { my ($self, $SPAMD) = @_; my $line0 = <$SPAMD>; # get the first protocol line if ($line0 !~ /EX_OK/) { $self->log(LOGERROR, "invalid response from spamd: $line0"); return; } my (%new_headers, $last_header); while (<$SPAMD>) { s/[\r\n]//g; if (m/^(X-Spam-.*?): (.*)?/) { $new_headers{$1} = $2 || ''; $last_header = $1; next; } if ($last_header && m/^(\s+.*)/) { # a folded line, append to last $new_headers{$last_header} .= CRLF . "\t" . $1; next; } $last_header = undef; } close $SPAMD; $self->log(LOGDEBUG, "finished reading from spamd"); return scalar keys %new_headers ? \%new_headers : undef; } sub insert_spam_headers { my ($self, $transaction, $new_headers, $username) = @_; if ($self->{_args}{headers} && $self->{_args}{headers} eq 'none') { my $r = $self->parse_spam_header($new_headers->{'X-Spam-Status'}); $transaction->notes('spamassassin', $r); return; } my $recipient_count = scalar $transaction->recipients; $self->_cleanup_spam_header($transaction, 'X-Spam-User'); # always clean up if ($recipient_count > 1) { # add for multiple recipients $transaction->header->add('X-Spam-User', $username . ", $recipient_count recipients", 0); } foreach my $name (keys %$new_headers) { next if $name eq 'X-Spam-Prev-Subject'; # might exist if SA rewrote subject if ($name eq 'X-Spam-Report') { next; # Mail::Header mangles this prefolded header # $self->log(LOGDEBUG, $new_headers->{$name} ); } if ($name eq 'X-Spam-Status') { $self->parse_spam_header($new_headers->{$name}); } $new_headers->{$name} =~ s/\015//; # hack for outlook $self->_cleanup_spam_header($transaction, $name); $transaction->header->add($name, $new_headers->{$name}, 0); } } sub assemble_message { my ($self, $transaction) = @_; $transaction->body_resetpos; my $message = "X-Envelope-From: " . $transaction->sender->format . "\n" . $transaction->header->as_string; while (my $line = $transaction->body_getline) { $message .= $line; } $message = join(CRLF, split /\n/, $message); return $message . CRLF; } sub connect_to_spamd { my $self = shift; my $socket = $self->{_args}{spamd_socket}; my $SPAMD; if ($socket && $socket =~ /\//) { # file path $SPAMD = $self->connect_to_spamd_socket($socket); } else { $SPAMD = $self->connect_to_spamd_tcpip($socket); } return if !$SPAMD; $SPAMD->autoflush(1); return $SPAMD; } sub connect_to_spamd_socket { my ($self, $socket) = @_; if (!$socket || $socket !~ /^([\w\/.-]+)$/) { # Unix Domain Socket $self->log(LOGERROR, "not a valid path"); return; } # Sanitize for use with taint mode $socket =~ /^([\w\/.-]+)$/; $socket = $1; socket(my $SPAMD, PF_UNIX, SOCK_STREAM, 0) or do { $self->log(LOGERROR, "Could not open socket: $!"); return; }; my $paddr = sockaddr_un($socket); connect($SPAMD, $paddr) or do { $self->log(LOGERROR, "Could not connect to spamd socket: $!"); return; }; $self->log(LOGDEBUG, "connected to spamd"); return $SPAMD; } sub connect_to_spamd_tcpip { my ($self, $socket) = @_; my $remote = 'localhost'; my $port = 783; if (defined $socket && $socket =~ /^([\w.-]+):(\d+)$/) { $remote = $1; $port = $2; } if ($port =~ /\D/) { $port = getservbyname($port, 'tcp') } if (!$port) { $self->log(LOGERROR, "No spamd port, check your spamd_socket config."); return; } my $iaddr = inet_aton($remote) or do { $self->log(LOGERROR, "Could not resolve host: $remote"); return; }; my $paddr = sockaddr_in($port, $iaddr); my $proto = getprotobyname('tcp'); socket(my $SPAMD, PF_INET, SOCK_STREAM, $proto) or do { $self->log(LOGERROR, "Could not open socket: $!"); return; }; connect($SPAMD, $paddr) or do { $self->log(LOGERROR, "Could not connect to spamd: $!"); return; }; $self->log(LOGDEBUG, "connected to spamd"); return $SPAMD; } sub print_to_spamd { my ($self, $SPAMD, $message, $length, $username) = @_; print $SPAMD "HEADERS SPAMC/1.4" . CRLF; print $SPAMD "Content-length: $length" . CRLF; print $SPAMD "User: $username" . CRLF; print $SPAMD CRLF; print $SPAMD $message or $self->log(LOGWARN, "Could not print to spamd: $!"); $self->log(LOGDEBUG, "check_spam: finished sending to spamd"); } sub reject { my ($self, $transaction) = @_; my $sa_results = $self->get_spam_results($transaction) or do { $self->log(LOGNOTICE, "error, no results"); return DECLINED; }; my $score = $sa_results->{score}; if (!defined $score) { $self->log(LOGERROR, "error, error getting score"); return DECLINED; } my $ham_or_spam = $sa_results->{is_spam} eq 'Yes' ? 'Spam' : 'Ham'; if ($ham_or_spam eq 'Spam') { $self->adjust_karma(-1); } my $status = "$ham_or_spam, $score"; my $learn = ''; my $al = $sa_results->{autolearn}; # subject to local SA learn scores if ($al) { $self->adjust_karma(1) if $al eq 'ham'; $self->adjust_karma(-1) if $al eq 'spam'; $learn = "learn=" . $al; } my $reject = $self->{_args}{reject} or do { $self->log(LOGERROR, "error, reject disabled ($status, $learn)"); return DECLINED; }; if ($score < $reject) { if ($ham_or_spam eq 'Spam') { $self->log(LOGINFO, "fail, tolerated, $status < $reject, $learn"); return DECLINED; } else { $self->log(LOGINFO, "pass, $status < $reject, $learn"); return DECLINED; } } $self->log(LOGINFO, "fail, $status, > $reject, $learn"); return ($self->get_reject_type(), "spam score exceeded threshold"); } sub munge_subject { my ($self, $transaction) = @_; return if ($self->{_args}{headers} && $self->{_args}{headers} eq 'none'); my $sa = $self->get_spam_results($transaction) or return; my $qp_num = $self->{_args}{munge_subject_threshold}; my $required = $sa->{required}; if (!$qp_num) { $self->log(LOGDEBUG, "skipping munge, no user or qpsmtpd pref set"); return; }; return unless $sa->{score} > $required; return unless $sa->{score} > $qp_num; my $subject_prefix = $self->qp->config('subject_prefix') || '*** SPAM ***'; my $subject = $transaction->header->get('Subject') || ''; $transaction->header->replace('Subject', "$subject_prefix $subject"); } sub get_spam_results { my ($self, $transaction) = @_; if (defined $transaction->notes('spamassassin')) { return $transaction->notes('spamassassin'); } my $header = $transaction->header->get('X-Spam-Status') or return; my $r = $self->parse_spam_header($header); $self->log(LOGDEBUG, "$r->{is_spam}, $r->{score}"); $transaction->notes('spamassassin', $r); return $r; } sub parse_spam_header { my ($self, $string) = @_; # the X-Spam-Score header contents vary based on the settings in # the spamassassin *.cf files. Rather than parse via regexp, split # on the consistent whitespace and = delimiters. More reliable and # likely faster. my @parts = split(/\s+/, $string); my $is_spam = shift @parts; chomp @parts; chop $is_spam; # remove trailing , my %r; foreach (@parts) { my ($key, $val) = split(/=/, $_); $r{$key} = $val; } $r{is_spam} = $is_spam; # compatibility for SA versions < 3 if (defined $r{hits} && !defined $r{score}) { $r{score} = delete $r{hits}; } return \%r; } sub _cleanup_spam_header { my ($self, $transaction, $header_name) = @_; my $action = 'rename'; if ($self->{_args}->{leave_old_headers}) { $action = lc($self->{_args}->{leave_old_headers}); } return unless $action eq 'drop' || $action eq 'rename'; my $old_header_name = $header_name; $old_header_name = ($old_header_name =~ s/^X-//) ? "X-Old-$old_header_name" : "Old-$old_header_name"; for my $header ($transaction->header->get($header_name)) { $transaction->header->add($old_header_name, $header, 0) if $action eq 'rename'; $transaction->header->delete($header_name); } } qpsmtpd-0.94/plugins/stunnel000066400000000000000000000044621240247602400162410ustar00rootroot00000000000000#!perl -w =head1 NAME stunnel - stunnel proxy protocol client ip helper. =head1 DESCRIPTION stunnel proxy protocol remote ip,port setting feature added for smtps. reference : http://www.stunnel.org/static/stunnel.html protocol spec : http://haproxy.1wt.eu/download/1.5/doc/proxy-protocol.txt config/plugins file example stunnel proxy on ... =head1 CONFIGURATION =head2 proxy [ ON | OFF ] proxy protocol handler on/off =cut use strict; use warnings; use Qpsmtpd::Constants; my $proxy_enabled; sub init { my ($self, $qp, %args) = @_; return if ( uc $args{proxy} ne 'ON' ); $self->log(LOGINFO, "proxy protocol enabled"); $proxy_enabled = 1; } sub hook_unrecognized_command { my ($self, $transaction, $cmd, @args) = @_; return OK if ( uc $cmd ne 'PROXY' ); return OK if ( !defined $proxy_enabled ); return DENY_DISCONNECT if ( $self->connection->remote_ip() ne '127.0.0.1' ); return DENY_DISCONNECT if ( $self->connection->notes('proxy') ); # TCP4 192.168.41.227 10.27.11.106 50060 465 if ( $args[0] =~ m/^(.*?) (.*?) (.*?) (.*?) (.*?)$/ ) { my $protocol = $1; my $remote_ip = $2; my $local_ip = $3; my $remote_port = $4; my $local_port = $5; $self->connection->remote_ip( $remote_ip ); $self->connection->remote_port( $remote_port ); $self->connection->remote_info( "[$remote_ip]"); $self->connection->notes('proxy', 'YES'); $self->connection->notes('protocol', $protocol); $self->connection->notes('remote_ip', $remote_ip); $self->connection->notes('remote_port', $remote_port); $self->connection->notes('local_ip', $local_ip); $self->connection->notes('local_port', $local_port); $self->log(LOGINFO, "stunnel : $remote_ip:$remote_port"); # DNS reverse if ( $self->isa('Qpsmtpd::PollServer') ) { eval { use ParaDNS; ParaDNS->new( finished => sub { $self->continue_read() }, callback => sub { $self->connection->remote_host($_[0]) }, host => $remote_ip, ); }; } else { my $res = Net::DNS::Resolver->new( dnsrch => 0 ); $res->tcp_timeout(3); $res->udp_timeout(3); my $query = $res->query( $remote_ip, 'PTR' ); if ($query) { foreach my $rr ($query->answer) { next if $rr->type ne 'PTR'; $self->connection->remote_host( $rr->ptrdname ); } } } } else { return DENY_DISCONNECT; } return DONE; } qpsmtpd-0.94/plugins/tls000066400000000000000000000236601240247602400153540ustar00rootroot00000000000000#!perl -w =head1 NAME tls - plugin to support STARTTLS =head1 SYNOPSIS # in config/plugins tls [B] =over 4 =item B Path to the server certificate file. Default: I =item B Path to the private key file. Default: I =item B Path to the certificate authority file. Default: I =back =head1 DESCRIPTION This plugin implements basic TLS support. It can also be used to support port 465 (SMTP over SSL), but only with qpsmtpd-forkserver. In this case, be sure to load plugins/tls before any other connect plugins and start qpsmtpd like this: qpsmtpd-forkserver --port 25 --port 465 You can also specify multiple --listen-address options as well; see the help for qpsmtpd-forkserver for more details. If TLS is successfully negotiated then the C field in the Connection notes is set. If you wish to make TLS mandatory you should check that field and take appropriate action. Note that you can only do that from MAIL FROM onwards. Use the script C to automatically generate a self-signed certificate with the appropriate characteristics. Otherwise, you should give absolute pathnames to the certificate, key, and the CA root cert used to sign that certificate. =head1 CIPHERS and COMPATIBILITY By default, we use only the plugins that openssl considers to be "high security". If you need to tweak the available ciphers for some broken client (such as Versamail 3.x), have a look at the available ciphers at L, and put a suitable string in config/tls_ciphers (e.g. "DEFAULT" or "HIGH:MEDIUM") =cut use IO::Socket::SSL 0.98; sub init { my ($self, $qp, $cert, $key, $ca) = @_; my $dir = -d 'ssl' ? 'ssl' : 'config/ssl'; $cert ||= "$dir/qpsmtpd-server.crt"; $key ||= "$dir/qpsmtpd-server.key"; $ca ||= "$dir/qpsmtpd-ca.crt"; unless (-f $cert && -f $key && -f $ca) { $self->log(LOGERROR, "Cannot locate cert/key! Run plugins/tls_cert to generate"); return; } $self->tls_cert($cert); $self->tls_key($key); $self->tls_ca($ca); $self->tls_ciphers($self->qp->config('tls_ciphers') || 'HIGH'); $self->log(LOGDEBUG, "ciphers: " . $self->tls_ciphers); local $^W; # this bit is very noisy... my $ssl_ctx = IO::Socket::SSL::SSL_Context->new( SSL_use_cert => 1, SSL_cert_file => $self->tls_cert, SSL_key_file => $self->tls_key, SSL_ca_file => $self->tls_ca, SSL_cipher_list => $self->tls_ciphers, SSL_server => 1 ) or die "Could not create SSL context: $!"; # now extract the password... $self->ssl_context($ssl_ctx); # Check for possible AUTH mechanisms HOOK: foreach my $hook (keys %{$qp->hooks}) { no strict 'refs'; if ($hook =~ m/^auth-?(.+)?$/) { if (defined $1) { my $hooksub = "hook_$hook"; $hooksub =~ s/\W/_/g; *$hooksub = \&bad_ssl_hook; } else { # at least one polymorphous auth provider *hook_auth = \&bad_ssl_hook; } } } } sub hook_ehlo { my ($self, $transaction) = @_; return DECLINED unless $self->can_do_tls; return DECLINED if $self->connection->notes('tls_enabled'); return DENY, "Command refused due to lack of security" if $transaction->notes('ssl_failed'); my $cap = $transaction->notes('capabilities') || []; push @$cap, 'STARTTLS'; $transaction->notes('tls_enabled', 1); $transaction->notes('capabilities', $cap); return DECLINED; } sub hook_unrecognized_command { my ($self, $transaction, $cmd, @args) = @_; return DECLINED unless lc $cmd eq 'starttls'; return DECLINED unless $transaction->notes('tls_enabled'); return DENY, "Syntax error (no parameters allowed)" if @args; # OK, now we setup TLS $self->qp->respond(220, "Go ahead with TLS"); unless (_convert_to_ssl($self)) { # SSL setup failed. Now we must respond to every command with 5XX warn("TLS failed: $@\n"); $transaction->notes('ssl_failed', 1); return DENY, "TLS Negotiation Failed"; } $self->log(LOGINFO, "TLS setup returning"); return DONE; } sub hook_connect { my ($self, $transaction) = @_; my $local_port = $self->qp->connection->local_port; if ( ! defined $local_port || $local_port != 465 ) { # SMTPS $self->log(LOGDEBUG, "skip, not SMTPS"); return DECLINED; }; unless (_convert_to_ssl($self)) { $self->log(LOGINFO, "fail, unable to establish SSL"); return (DENY_DISCONNECT, "Cannot establish SSL session"); } $self->log(LOGINFO, "pass, connect via SMTPS"); return DECLINED; } sub hook_post_connection { my ($self, $transaction) = @_; my $tls_socket = $self->connection->notes('tls_socket'); if (defined $tls_socket && $self->connection->notes('tls_socket_is_duped')) { $tls_socket->close; $self->connection->notes('tls_socket', undef); $self->connection->notes('tls_socked_is_duped', 0); } return DECLINED; } sub _convert_to_ssl { my ($self) = @_; if ($self->qp->isa('Qpsmtpd::PollServer')) { return _convert_to_ssl_async($self); } eval { my $tlssocket = IO::Socket::SSL->new_from_fd( fileno(STDIN), '+>', SSL_use_cert => 1, SSL_cert_file => $self->tls_cert, SSL_key_file => $self->tls_key, SSL_ca_file => $self->tls_ca, SSL_cipher_list => $self->tls_ciphers, SSL_server => 1, SSL_reuse_ctx => $self->ssl_context, ) or die "Could not create SSL socket: $!"; # Clone connection object (without data received from client) $self->qp->connection($self->connection->clone()); $self->qp->reset_transaction; *STDIN = *STDOUT = $self->connection->notes('tls_socket', $tlssocket); $self->connection->notes('tls_socket_is_duped', 1); $self->connection->notes('tls_enabled', 1); }; if ($@) { return 0; } return 1; } sub _convert_to_ssl_async { my ($self) = @_; my $upgrader = $self->connection->notes('tls_upgrader', UpgradeClientSSL->new($self)); $upgrader->upgrade_socket(); return 1; } sub can_do_tls { my ($self) = @_; $self->tls_cert && -r $self->tls_cert; } sub tls_cert { my $self = shift; @_ and $self->{_tls_cert} = shift; $self->{_tls_cert}; } sub tls_key { my $self = shift; @_ and $self->{_tls_key} = shift; $self->{_tls_key}; } sub tls_ca { my $self = shift; @_ and $self->{_tls_ca} = shift; $self->{_tls_ca}; } sub tls_ciphers { my $self = shift; @_ and $self->{_tls_ciphers} = shift; $self->{_tls_ciphers}; } sub ssl_context { my $self = shift; @_ and $self->{_ssl_ctx} = shift; $self->{_ssl_ctx}; } # Fulfill RFC 2487 secn 5.1 sub bad_ssl_hook { my ($self, $transaction) = @_; return DENY, "Command refused due to lack of security" if $transaction->notes('ssl_failed'); return DECLINED; } *hook_helo = *hook_data = *hook_rcpt = *hook_mail = \&bad_ssl_hook; package UpgradeClientSSL; # borrowed heavily from Perlbal::SocketSSL use strict; use warnings; no warnings qw(deprecated); use IO::Socket::SSL 0.98; use Errno qw( EAGAIN ); use fields qw( _stashed_qp _stashed_plugin _ssl_started ); sub new { my UpgradeClientSSL $self = shift; $self = fields::new($self) unless ref $self; $self->{_stashed_plugin} = shift; $self->{_stashed_qp} = $self->{_stashed_plugin}->qp; return $self; } sub upgrade_socket { my UpgradeClientSSL $self = shift; unless ($self->{_ssl_started}) { $self->{_stashed_qp}->clear_data(); IO::Socket::SSL->start_SSL( $self->{_stashed_qp}->{sock}, { SSL_use_cert => 1, SSL_cert_file => $self->{_stashed_plugin}->tls_cert, SSL_key_file => $self->{_stashed_plugin}->tls_key, SSL_ca_file => $self->{_stashed_plugin}->tls_ca, SSL_cipher_list => $self->{_stashed_plugin}->tls_ciphers, SSL_startHandshake => 0, SSL_server => 1, SSL_reuse_ctx => $self->{_stashed_plugin}->ssl_context, } ) or die "Could not upgrade socket to SSL: $!"; $self->{_ssl_started} = 1; } $self->event_read($self->{_stashed_qp}); } sub event_read { my UpgradeClientSSL $self = shift; my $qp = shift; $qp->watch_read(0); my $sock = $qp->{sock}->accept_SSL; if (defined $sock) { $qp->connection($qp->connection->clone); $qp->reset_transaction; $self->connection->notes('tls_socket', $sock); $self->connection->notes('tls_enabled', 1); $qp->watch_read(1); return 1; } # nope, let's see if we can continue the process if ($! == EAGAIN) { $qp->set_reader_object($self); if ($SSL_ERROR == SSL_WANT_READ) { $qp->watch_read(1); } elsif ($SSL_ERROR == SSL_WANT_WRITE) { $qp->watch_write(1); } else { $qp->disconnect(); } } else { $qp->disconnect(); } } qpsmtpd-0.94/plugins/tls_cert000066400000000000000000000073621240247602400163720ustar00rootroot00000000000000#!/usr/bin/perl use strict; use warnings; # Very basic script to create TLS certificates for qpsmtpd use File::Temp qw/ tempfile tempdir /; use Getopt::Long; my %opts = (); chomp (my $hostname = `hostname --fqdn`); if ($?) { chomp($hostname = `hostname`); } print "Using hostname: $hostname\n"; my %defaults = ( C => 'XY', ST => 'unknown', L => 'unknown', O => 'QSMTPD', OU => 'Server', CN => $hostname, ); GetOptions(\%opts, 'C|Country:s', 'ST|State:s', 'L|Locality|City:s', 'O|Organization:s', 'OU|OrganizationalUnit|U:s', 'CN|CommonName|N:s', 'emailAddress|email|E:s', 'help|H', ); usage() if $opts{help}; # initialize defaults foreach my $key ( keys %defaults ) { $opts{$key} = $defaults{$key} unless $opts{$key} } $opts{emailAddress} = 'postmaster@'.$opts{CN}; mkdir('ssl') unless -d 'ssl'; my $CA_key = 'ssl/qpsmtpd-ca.key'; my $CA_crt = 'ssl/qpsmtpd-ca.crt'; my $CA_serial = 'ssl/.cert.serial'; my $template; my ($CA, $CAfilename) = tempfile( $template, DIR => "ssl", UNLINK => 1); print ${CA} return_cfg('CA'); close ${CA}; system('openssl', 'genrsa', '-out', $CA_key, 2048) == 0 or die "Cannot create CA key: $?"; system('openssl', 'req', '-config', $CAfilename, '-new', '-x509', '-days', (365*6), '-key', $CA_key, '-out', $CA_crt) == 0 or die "Cannot create CA cert: $?"; my $SERVER_key = 'ssl/qpsmtpd-server.key'; my $SERVER_csr = 'ssl/qpsmtpd-server.csr'; my $SERVER_crt = 'ssl/qpsmtpd-server.crt'; my ($SERVER, $SERVERfilename) = tempfile( $template, DIR => "ssl", UNLINK => 1); print ${SERVER} return_cfg($opts{OU}); close ${SERVER}; system('openssl', 'genrsa', '-out', $SERVER_key, 1024) == 0 or die "Cannot create server key: $?"; system('openssl', 'req', '-config', $SERVERfilename, '-new', '-key', $SERVER_key, '-out', $SERVER_csr) == 0 or die "Cannot create server cert: $?"; my ($SIGN, $SIGNfilename) = tempfile( $template, DIR => "ssl", UNLINK => 1); print ${SIGN} <<"EOT"; extensions = x509v3 [ x509v3 ] subjectAltName = email:copy nsComment = tls certificate nsCertType = server EOT close ${SIGN}; open my $SERIAL, '>', $CA_serial; print ${SERIAL} "01\n"; close ${SERIAL}; system('openssl', 'x509', '-extfile', $SIGNfilename, '-days', (365*2), '-CAserial', $CA_serial, '-CA', $CA_crt, '-CAkey', $CA_key, '-in', $SERVER_csr, '-req', '-out', $SERVER_crt) == 0 or die "Cannot sign cert: $?"; exit(0); sub return_cfg { my $OU = shift; my $RANDOM = int(rand(1000)).'RAN'.int(rand(1000)).'DOM'; my $cfg = <<"EOT"; [ req ] default_bits = 1024 default_keyfile = keyfile.pem distinguished_name = req_distinguished_name attributes = req_attributes prompt = no output_password = mypass [ req_distinguished_name ] C = $opts{C} ST = $opts{ST} L = $opts{L} O = $opts{O} OU = $OU CN = $opts{CN} emailAddress = $opts{emailAddress} [ req_attributes ] challengePassword = $RANDOM challenge password EOT return $cfg; } sub usage { print STDERR <<"EOT"; $0 will generate a TLS certificate "the quick way", i.e. without interaction. You can change some defaults however. These options are recognized: Default: --C Country (two letters, e.g. DE) $defaults{C} --ST State (spelled out) $defaults{ST} --L City $defaults{L} --O Organization $defaults{O} --OU Organizational Unit $defaults{OU} --CN Common name $defaults{CN} --email Email address of postmaster postmaster\@CN --help Show usage EOT exit(1); } qpsmtpd-0.94/plugins/uribl000066400000000000000000000432051240247602400156640ustar00rootroot00000000000000#!perl -w =head1 NAME uribl - URIBL blocking plugin for qpsmtpd =head1 DESCRIPTION This plugin implements DNSBL lookups for URIs found in spam, such as that implemented by SURBL (see Ehttp://surbl.org/E). Incoming messages are scanned for URIs, which are then checked against one or more URIBLs in a fashion similar to DNSBL systems. =head1 CONFIGURATION To enable the plugin, add it to I<~qpsmtpd/config/plugins>. The list of URIBLs to check should be placed in I in the config directory (typically I<~qpsmtpd/config>). The format of the I file is a list of URIBL DNS zones, one per line, consisting of one or more columns separated by whitespace. The first column (the only mandatoy one) should consist of the URIBL zone. The second column may contain a comma-delimited list of integers selecting mask values to be applied to the A record(s) returned from a URIBL. This enables the use of composite DNSBLs, such as multi.surbl.org, where several lists are combined so they may be accessed with a single query; any returns are checked against the mask of lists you're interested in. If unspecified, or if a negative number is given, all lists in a composite URIBL will be checked. URIBL operators prefer that you use the composite lists to reduce their own query load, and it's more efficient for qpsmtpd as well. The third column specifies an action, which overrides the default action configured with the I setting discussed below. For example: =over 4 multi.surbl.org 2,8 deny ob.surbl.org 1 add-header =back You may specify the following config option(s) in the I file: =over 4 =item action Specifies what to do when a URI is matched in a URIBL. Available options are I (the default) I and I. If set to add-header, an X-URIBL-Match: header will be added explaining the URIBL entry found. If set to 'deny,' the delivery will be declined with a hard failure. If set to denysoft, the delivery will be soft failed (this is probably not a good idea.) =item timeout Timeout for DNS requests, in seconds. The default is 30 seconds. DNS requests are issued asynchronously and in parallel for all hosts found in URIs in the mail; the same timeout will apply to each; see the Net::DNS documentation for details. =item scan-headers If set true, any headers found in the URIs will be checked as well. Disabled by default. =back =head1 CAUTIONS When used in I or I mode, a URIBL check can block not only the original spam containing a listed URI, but mail unintentionally carrying that URI, such as forwarded complaints. The uribl checks should only be used in these modes if you know what you're doing. The URI scanner used by the uribl plugin is quite aggressive, and attempts to detect all forms of URIs supported by typical MUAs (even those that lack a protocol specification, for example.) However, it does not attempt to detect URIs that have been mangled beyond programmatic reconstruction. Even so, it may issue spurious lookups on unintended URIs, especially those in non-text sections of the mail. =head1 COPYRIGHT uribl is copyright 2004-2007 by Devin Carraway Eqpsmtpd@devin.comE. It may be used and redistributed under the same terms as qpsmtpd itself. =cut use strict; use warnings; use Qpsmtpd::Constants; use Net::DNS::Resolver; use Time::HiRes qw(time); use IO::Select; # ccTLDs that allocate domain names within a strict two-level hierarchy, # as in *.co.uk my %strict_twolevel_cctlds = ( 'ac' => 1, 'ae' => 1, 'uk' => 1, 'ai' => 1, 'ar' => 1, 'at' => 1, 'au' => 1, 'az' => 1, 'bb' => 1, 'bh' => 1, 'bm' => 1, 'br' => 1, 'bs' => 1, 'ca' => 1, 'ck' => 1, 'cn' => 1, 'co' => 1, 'cr' => 1, 'cu' => 1, 'cy' => 1, 'do' => 1, 'et' => 1, 'ge' => 1, 'hk' => 1, 'id' => 1, 'il' => 1, 'jp' => 1, 'kr' => 1, 'kw' => 1, 'lv' => 1, 'sg' => 1, 'za' => 1, ); # async version: OK sub init { my ($self, $qp, %args) = @_; $self->{action} = $args{action} || 'add-header'; $self->{timeout} = $args{timeout} || 30; # scan-headers was the originally documented name for this option, while # check-headers actually implements it, so tolerate both. $self->{check_headers} = $args{'check-headers'} || $args{'scan-headers'}; $args{mask} ||= 0x00ffffff; $self->{mask} = 0; my @zones = $self->qp->config('uribl_zones'); for (@zones) { chomp; next if !$_ or /^\s*#/; my @z = split(/\s+/, $_); next unless $z[0]; my $mask = 0; $z[1] ||= 0x00ffffff; for (split /,/, $z[1]) { unless (/^(-?\d+)$/) { $self->log(LOGERROR, "Malformed mask $_ for $z[0]"); return undef; } $mask |= $1 >= 0 ? $1 : 0x00ffffff; } my $action = $z[2] || $self->{action}; unless ($action =~ /^(add-header|deny|denysoft|log)$/) { $self->log(LOGERROR, "Unknown action $action for $z[0]"); return undef; } $self->{uribl_zones}->{$z[0]} = { mask => $mask, action => $action, }; } keys %{$self->{uribl_zones}} or return 0; my @whitelist = $self->qp->config('uribl_whitelist_domains'); $self->{whitelist_zones} = {(map { ($_ => 1) } @whitelist)}; $self->init_resolver; } # async version: not used sub register { my $self = shift; $self->register_hook('data_post', 'data_handler'); } # async version: not used sub send_query { my $self = shift; my $name = shift || return undef; my $count = 0; $self->{socket_select} ||= new IO::Select or return undef; for my $z (keys %{$self->{uribl_zones}}) { my ($s, $s1); my $index = { zone => $z, name => $name, }; next unless $z; next if exists $self->{sockets}->{$z}->{$name}; $s = $self->{resolver}->bgsend("$name.$z", 'A'); if (defined $s) { $self->{sockets}->{$z}->{$name}->{'a'} = $s; $self->{socket_select}->add($s); $self->{socket_idx}->{"$s"} = $index; $count++; } else { $self->log(LOGERROR, "Couldn't open socket for A record '$name.$z': " . ($self->{resolver}->errorstring || 'unknown error') ); } $s1 = $self->{resolver}->bgsend("$name.$z", 'TXT'); if (defined $s1) { $self->{sockets}->{$z}->{$name}->{'txt'} = $s1; $self->{socket_select}->add($s1); $self->{socket_idx}->{"$s1"} = $index; $count++; } else { $self->log(LOGERROR, "Couldn't open socket for TXT record '$name.$z': " . ($self->{resolver}->errorstring || 'unknown error') ); } $self->{sockets}->{$z}->{$name} = {}; } $count; } # async version: not used sub lookup_finish { my $self = shift; $self->{socket_idx} = {}; $self->{sockets} = {}; undef $self->{socket_select}; } # async version: OK sub evaluate { my $self = shift; my $zone = shift || return undef; my $a = shift || return undef; my $mask = $self->{uribl_zones}->{$zone}->{mask} || $self->{mask}; $a =~ /^(\d{1,3})\.(\d{1,3})\.(\d{1,3})\.(\d{1,3})$/ or return undef; my $v = (($1 & 0xff) << 24) | (($2 & 0xff) << 16) | (($3 & 0xff) << 8) | ($4 & 0xff); return ($v & $mask); } # async version: OK sub lookup_start { my ($self, $transaction, $start_query) = @_; my $l; my $queries = 0; my %pending; my @qp_continuations; $transaction->body_resetpos; # if we're not looking for URIs in the headers, read past that point # before starting to actually look for any while (!$self->{check_headers} and $l = $transaction->body_getline) { chomp $l; last if !$l; } while ($l = $transaction->body_getline) { chomp $l; if ($l =~ /(.*)=$/) { push @qp_continuations, $1; } elsif (@qp_continuations) { $l = join('', @qp_continuations, $l); @qp_continuations = (); } # Undo URI escape munging $l =~ s/[=%]([0-9A-Fa-f]{2,2})/chr(hex($1))/ge; # Undo HTML entity munging (e.g. in parameterized redirects) $l =~ s/&#(\d{2,3});?/chr($1)/ge; # Dodge inserted-semicolon munging $l =~ tr/;//d; while ( $l =~ m{ \w{3,16}:/+ # protocol (?:\S+@)? # user/pass (\d{7,}) # raw-numeric IP (?::\d*)?([/?\s]|$) # port, slash # or EOL }gx ) { my @octets = ( (($1 >> 24) & 0xff), (($1 >> 16) & 0xff), (($1 >> 8) & 0xff), ($1 & 0xff) ); my $fwd = join('.', @octets); my $rev = join('.', reverse @octets); $self->log(LOGDEBUG, "uribl: matched pure-integer ipaddr $1 ($fwd)"); unless (exists $pending{$rev}) { $queries += $start_query->($self, $rev); $pending{$rev} = 1; } } while ( $l =~ m{ \w{3,16}:/+ # protocol (?:\S+@)? # user/pass (\d+|0[xX][0-9A-Fa-f]+)\. # IP address (\d+|0[xX][0-9A-Fa-f]+)\. (\d+|0[xX][0-9A-Fa-f]+)\. (\d+|0[xX][0-9A-Fa-f]+) }gx ) { my @octets = ($1, $2, $3, $4); # return any octal/hex octets in the IP addr back # to decimal form (e.g. http://0x7f.0.0.00001) for (0 .. $#octets) { $octets[$_] =~ s/^0([0-7]+)$/oct($1)/e; $octets[$_] =~ s/^0x([0-9a-fA-F]+)$/hex($1)/e; } my $fwd = join('.', @octets); my $rev = join('.', reverse @octets); $self->log(LOGDEBUG, "uribl: matched URI ipaddr $fwd"); unless (exists $pending{$rev}) { $queries += $start_query->($self, $rev); $pending{$rev} = 1; } } while ( $l =~ m{ ((?:www\.)? # www? [a-zA-Z0-9][a-zA-Z0-9\-.]+\. # hostname (?:aero|arpa|asia|biz|cat|com|coop| # tld edu|gov|info|int|jobs|mil|mobi| museum|name|net|org|pro|tel|travel| [a-zA-Z]{2}) )(?!\w) }gix ) { my $host = lc $1; my @host_domains = split /\./, $host; $self->log(LOGDEBUG, "uribl: matched 'www.' hostname $host"); my $cutoff = exists $strict_twolevel_cctlds{$host_domains[$#host_domains]} ? 3 : 2; if ( exists $self->{whitelist_zones}->{ join('.', @host_domains[($#host_domains - $cutoff + 1) .. $#host_domains]) } ) { $self->log(LOGINFO, "Skipping whitelist URI domain '$host'"); } else { while (@host_domains >= $cutoff) { my $subhost = join('.', @host_domains); unless (exists $pending{$subhost}) { $self->log(LOGINFO, "URIBL: checking sub-host $subhost"); $queries += $start_query->($self, $subhost); $pending{$subhost} = 1; } shift @host_domains; } } } while ( $l =~ m{ \w{3,16}:/+ # protocol (?:\S+@)? # user/pass ( [a-zA-Z0-9][a-zA-Z0-9\-.]+\. # hostname (?:aero|arpa|asia|biz|cat|com|coop| # tld edu|gov|info|int|jobs|mil|mobi| museum|name|net|org|pro|tel|travel| [a-zA-Z]{2}) ) }gix ) { my $host = lc $1; my @host_domains = split /\./, $host; $self->log(LOGDEBUG, "uribl: matched full URI hostname $host"); my $cutoff = exists $strict_twolevel_cctlds{$host_domains[$#host_domains]} ? 3 : 2; if ( exists $self->{whitelist_zones} ->{join('.', @host_domains[($cutoff - 1) .. $#host_domains])}) { $self->log(LOGINFO, "Skipping whitelist URI domain '$host'"); } else { while (@host_domains >= $cutoff) { my $subhost = join('.', @host_domains); unless (exists $pending{$subhost}) { $self->log(LOGINFO, "URIBL: checking sub-host $subhost"); $queries += $start_query->($self, $subhost); $pending{$subhost} = 1; } shift @host_domains; } } } } $transaction->body_resetpos; return $queries; } # async version: not used sub collect_results { my ($self, $transaction) = @_; my $matches = 0; my $complete = 0; my $start_time = time; while ($self->{socket_select}->handles) { my $timeout = ($start_time + $self->{timeout}) - time; last if $timeout <= 0; my @ready = $self->{socket_select}->can_read($timeout); SOCK: for my $s (@ready) { $self->{socket_select}->remove($s); my $r = $self->{socket_idx}->{"$s"} or next SOCK; $self->log(LOGDEBUG, "from $r: socket $s: " . join(', ', map { "$_=$r->{$_}" } keys %{$r}) ); my $zone = $r->{zone}; my $name = $r->{name}; my $h = $self->{sockets}->{$zone}->{$name}; my $packet = $self->{resolver}->bgread($s) or next SOCK; for my $a ($packet->answer) { if ($a->type eq 'TXT') { $h->{txt} = $a->txtdata; } elsif ($a->type eq 'A') { $h->{a} = $a->address; if ($self->evaluate($zone, $h->{a})) { $self->log(LOGDEBUG, "match in $zone"); $h->{match} = 1; $matches++; } } } $complete++; } } my $elapsed = time - $start_time; $self->log(LOGINFO, sprintf( "$complete lookup%s finished in %.2f sec (%d match%s)", $complete == 1 ? '' : 's', $elapsed, $matches, $matches == 1 ? '' : 'es' ) ); my @matches = (); for my $z (keys %{$self->{sockets}}) { for my $n (keys %{$self->{sockets}->{$z}}) { my $h = $self->{sockets}->{$z}->{$n}; next unless $h->{match}; push @matches, { action => $self->{uribl_zones}->{$z}->{action}, desc => "$n in $z: " . ($h->{txt} || $h->{a}), }; } } $self->lookup_finish; return \@matches; } # async version: not used sub data_handler { my ($self, $transaction) = @_; return (DECLINED) if $self->is_immune(); my $queries = $self->lookup_start( $transaction, sub { my ($self, $name) = @_; return $self->send_query($name); } ); unless ($queries) { $self->log(LOGINFO, "pass, No URIs found in mail"); return DECLINED; } my $matches = $self->collect_results($transaction); for (@$matches) { $self->log(LOGWARN, $_->{desc}); if ($_->{action} eq 'add-header') { $transaction->header->add('X-URIBL-Match', $_->{desc}, 0); } elsif ($_->{action} eq 'deny') { return (DENY, $_->{desc}); } elsif ($_->{action} eq 'denysoft') { return (DENYSOFT, $_->{desc}); } } return DECLINED; } # async version: not used sub init_resolver { my $self = shift; $self->{resolver} = new Net::DNS::Resolver or return undef; $self->{resolver}->udp_timeout($self->{timeout}); } qpsmtpd-0.94/plugins/virus/000077500000000000000000000000001240247602400157705ustar00rootroot00000000000000qpsmtpd-0.94/plugins/virus/aveclient000066400000000000000000000137041240247602400176720ustar00rootroot00000000000000#!perl -w =head1 NAME aveclient =head1 DESCRIPTION This qpsmtpd plugin uses the aveclient of a kaspersky 5.x server-suite. The original kaspersky aveclient is called within this plugin to connect to the local socket of the aveserver. The aveserver runs as a daemon with all virusdefinitions already loaded, what makes scanning veeery quick and performant without much load. When a virus is detected, the mail is blocked and the connection is denied! Further configuration is simple to be added. =head1 INSTALL AND CONFIG Place this plugin in the default plugin directory of your qpsmtpd installation. Normaly you can use it with default options (nothing specified): =over 4 =item B Optional you may set the path to original aveclient and/or the socket: =over 4 =item avclient_bin I Set the path to the original aveclient of kaspersky 5.x server-suite. Default: /opt/kav/bin/aveclient =item avdaemon_sock I Set the path to the unix socket of the original aveserver of kaspersky 5.x server-suite. Default: /var/run/aveserver =item blockonerror I<(1|0)> Whether to block mails on scanning errors or to accept connections. Default: 0 (No) =back =back =head1 EXIT CODES OF aveclient (taken from man aveclient) When launched with the -s option, aveclient returns one of the following codes (if several files to be scanned are indicated in the command line, the return code corresponds to the results of scanning the last file): 0 no viruses have been detected. 1 unable to connect to aveserver. 2 objects with an unknown viral code have been found. 3 suspicious objects have been found. 4 infected objects have been detected. 5 all infected objects have been disinfected. 6 scan results are unavailable: encrypted or password protected file. 7 system error launching the application (file not found, unable to read the file). 8 scan results are unavailable: file is corrupted or input/output error. 9 some of the required parameters are missing from the command line. =head1 VERSION 0.1rc first proof of concept. How is load and performance on larger systems? This is tested whith aprox. 900 Clients on a small RH-System (AMD, 768 Mhz, 512 MB) MAXCLIENTS set to 40. =head1 AUTHOR Adopted by Marcus Spiegel from kavscanner plugin of Hanno Hecker. THIS SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. =cut use File::Temp qw(tempfile); use Mail::Address; sub register { my ($self, $qp, @args) = @_; # defaults to be used $self->{_avclient_bin} = "/opt/kav/bin/aveclient"; $self->{_avdaemon_sock} = "/var/run/aveserver"; $self->{_blockonerror} = 0; # parse optional arguments my %args = @args; foreach my $key (keys %args) { my $arg = $key; $key =~ s/^/_/; $self->{$key} = $args{$arg}; } # Untaint client location # socket will be tested during scan (response-code) if (exists $self->{_avclient_bin} && $self->{_avclient_bin} =~ /^(\/[\/\-\_\.a-z0-9A-Z]*)$/) { $self->{_avclient_bin} = $1; } else { $self->log(LOGALERT, "FATAL ERROR: No binary aveclient found: '" . $self->{_avclient_bin} . "'" ); exit 3; } } sub hook_data_post { my ($self, $transaction) = @_; my ($temp_fh, $filename) = tempfile(); my $description = 'clean'; # a temporary file is needed to be scanned print $temp_fh $transaction->header->as_string; print $temp_fh "\n"; $transaction->body_resetpos; while (my $line = $transaction->body_getline) { print $temp_fh $line; } seek($temp_fh, 0, 0); # Now scan this file my $cmd = $self->{_avclient_bin} . " -p " . $self->{_avdaemon_sock} . " -s $filename 2>&1"; my @output = `$cmd`; chomp(@output); my $result = ($? >> 8); my $signal = ($? & 127); # tidy up a bit unlink($filename); close $temp_fh; # check if something went wrong if ($signal) { $self->log(LOGERROR, "kavscanner exited with signal: $signal"); return (DECLINED); } # either we found a virus or something went wrong if ($result > 0) { if ($result =~ /^(2|3|4|6|8)$/) { # ok a somewhat virus was found shift @output; $description = "REPORT: " . join(", ", @output); $self->log(LOGWARN, "Virus found! ($description)"); # we don't want to be disturbed be these, so block mail and DENY connection return (DENY, "Virus found: $description"); } else { $self->log(LOGCRIT, "aveserver: no viruses have been detected.") if ($result =~ /^0$/); $self->log(LOGCRIT, "aveserver: system error launching the application (file not found, unable to read the file)." ) if ($result =~ /^0$/); $self->log(LOGCRIT, "aveserver: some of the required parameters are missing from the command line." ) if ($result =~ /^9$/); return (DENY, "Unable to scan for virus, please contact admin of " . $self->qp->config("me") . ", if you feel this is an error!" ) if $self->{_blockonerror}; } } $self->log(LOGINFO, "kavscanner results: $description"); $transaction->header->add('X-Virus-Checked', 'Checked by Kaspersky on ' . $self->qp->config("me")); return (DECLINED); } qpsmtpd-0.94/plugins/virus/bitdefender000066400000000000000000000060161240247602400201710ustar00rootroot00000000000000#!perl -w =head1 NAME bitdefender -- BitDefender Linux Edition antivirus plugin for qpsmtpd =head1 DESCRIPTION This plugin scans incoming mail with the BitDefender Linux Edition scanner, and can at your option reject or flag infected messages. =head1 CONFIGURATION =over 4 =item B Full path to the BitDefender binary and all signature files; defaults to /opt/bdc/bdc. =item B Whether the scanner will automatically delete messages which have viruses. Takes either 'yes' or 'no' (defaults to 'yes'). =item B Maximum size in kilobytes for messages which will be scanned; defaults to 128k; =back =head1 DEPENDENCIES =over 4 =item B The BitDefender Linux Edition is available to use, free of charge, from this link: Please read the documentation for configuring automatic updates of the virus profiles. =back =head1 AUTHOR John Peacock =head1 COPYRIGHT AND LICENSE Copyright (c) 2004 John Peacock Based lightly on the clamav plugin This plugin is licensed under the same terms as the qpsmtpd package itself. Please see the LICENSE file included with qpsmtpd for details. =cut use strict; use warnings; use File::Path; use Qpsmtpd::Constants; sub register { my ($self, $qp, @args) = @_; while (@args) { $self->{"_bitd"}->{pop @args} = pop @args; } $self->{"_bitd"}->{"bitdefender_location"} ||= "/opt/bdc/bdc"; $self->{"_bitd"}->{"deny_viruses"} ||= "yes"; $self->{"_bitd"}->{"max_size"} ||= 128; $self->{"_bitd"}->{"max_size"} *= 1024; } sub hook_data_post { my ($self, $transaction) = @_; if ($transaction->data_size > $self->{"_bitd"}->{"max_size"}) { $self->log(LOGWARN, 'Mail too large to scan (' . $transaction->data_size . " vs " . $self->{"_bitd"}->{"max_size"} . ")" ); return (DECLINED); } # Ignore non-multipart emails my $content_type = $transaction->header->get('Content-Type'); $content_type =~ s/\s/ /g if defined $content_type; unless ( $content_type && $content_type =~ m!\bmultipart/.*\bboundary="?([^"]+)!i) { $self->log(LOGERROR, "non-multipart mail - skipping"); return DECLINED; } my $filename = $transaction->body_filename; unless (defined $filename) { $self->log(LOGERROR, "didn't get a filename"); return DECLINED; } # Now do the actual scanning! open my $bdc, "-|", $self->{"_bitd"}->{"bitdefender_location"} . " --mail --all --arc $filename"; my $output; while (<$bdc>) { if (/infected: (.+)$/) { $output = $1; last; } } close $bdc; if ($output) { $self->log(LOGINFO, "Virus(es) found: $output"); if ($self->{"_bitd"}->{"deny_viruses"} eq "yes") { return (DENY, "Virus Found: $output"); } } return (DECLINED); } qpsmtpd-0.94/plugins/virus/clamav000066400000000000000000000166631240247602400171720ustar00rootroot00000000000000#!perl -w =head1 NAME clamav -- ClamAV antivirus plugin for qpsmtpd =head1 DESCRIPTION This plugin scans incoming mail with the clamav A/V scanner, and can at your option reject or flag infected messages. =head1 CONFIGURATION Arguments to clamav should be specified in the form of name=value pairs, separated by whitespace. For sake of backwards compatibility, a single leading argument containing only alphanumerics, -, _, . and slashes will be tolerated, and interpreted as the path to clamscan/clamdscan. All new installations should use the name=value form as follows: =over 4 =item clamscan_path=I (e.g. I) Path to the clamav commandline scanner. Mail will be passed to the clamav scanner in Berkeley mbox format (that is, with a "From " line). See the discussion below on which commandline scanner to use. =item clamd_conf=I (e.g. I) Path to the clamd configuration file. Passed as an argument to the command-line scanner (--config-file=I). The default value is '/etc/clamd.conf'. =item action=EI | IE (e.g. I) Selects an action to take when an inbound message is found to be infected. Valid arguments are 'add-header' and 'reject'. All rejections are hard 5xx-code rejects; the SMTP error will contain an explanation of the virus found in the mail (for example, '552 Virus Found: Worm.SomeFool.P'). The default action is 'add-header'. =item max_size=I (e.g. I) Specifies the maximum size, in bytes, for mail to be scanned. Any mail exceeding this size will be left alone. This is recommended, as large mail can take an exceedingly long time to scan. The default is 524288, or 512k. =item tmp_dir=I (e.g. I) Specify an alternate temporary directory. If not specified, the qpsmtpd I will be used. If neither is available, I<~/tmp/> will be tried, and if that that fails the plugin will gracefully fail. =item back_compat If you are using a version of ClamAV prior to 0.80, you need to set this variable to include a couple of now deprecated options. =back =head2 CLAMAV COMMAND LINE SCANNER You can use either clamscan or clamdscan, but the latter is recommended for sake of performance. However, in this case, the user executing clamd requires access to the qpsmtpd spool directory, which usually means either running clamd as the same user as qpsmtpd does (by far the easiest method) or by doing the following: =over 4 =item * Change the group ownership of the spool directory to be a group of which clamav is a member or add clamav to the same group as the qpsmtpd user. =item * Enable the "AllowSupplementaryGroups" option in clamd.conf. =item * Change the permissions of the qpsmtpd spool directory to 0750 (this will emit a warning when the qpsmtpd service starts up, but can be safely ignored). =item * Make sure that all directories above the spool directory (to the root) are g+x so that the group has directory traversal rights; it is not necessary for the group to have any read rights except to the spool directory itself. =back It may be helpful to temporary grant the clamav user a shell and test to make sure you can cd into the spool directory and read files located there. Remember to remove the shell from the clamav user when you are done testing. =head2 CLAMAV CONFIGURATION At the least, you should have 'ScanMail' supplied in your clamav.conf file. It is recommended that you also have sane limits on ArchiveMaxRecursion and StreamMaxLength also. =head1 LICENSE This plugin is licensed under the same terms as the qpsmtpd package itself. Please see the LICENSE file included with qpsmtpd for details. =cut use strict; use warnings; use Qpsmtpd::Constants; sub register { my ($self, $qp, @args) = @_; my %args; if ($args[0] && $args[0] =~ /^(\/[\/\-\_\.a-z0-9A-Z]*)$/ && -x $1) { $self->{_clamscan_loc} = $1; shift @args; } for (@args) { if (/^max_size=(\d+)$/) { $self->{_max_size} = $1; } elsif (/^clamscan_path=(\/[\/\-\_\.a-z0-9A-Z]*)$/) { $self->{_clamscan_loc} = $1; } elsif (/^clamd_conf=(\/[\/\-\_\.a-z0-9A-Z]*)$/) { $self->{_clamd_conf} = "$1"; } elsif (/^tmp_dir=(\/[\/\-\_\.a-z0-9A-Z]*)$/) { $self->{_spool_dir} = $1; } elsif (/^action=(add-header|reject)$/) { $self->{_action} = $1; } elsif (/back_compat/) { $self->{_back_compat} = '-i --max-recursion=50'; } elsif (/declined_on_fail/) { $self->{_declined_on_fail} = 1; } else { $self->log(LOGERROR, "Unrecognized argument '$_' to clamav plugin"); return undef; } } $self->{_max_size} ||= 512 * 1024; $self->{_spool_dir} ||= $self->spool_dir(); $self->{_back_compat} ||= ''; # make sure something is set $self->{_clamd_conf} ||= '/etc/clamd.conf'; # make sure something is set $self->{_declined_on_fail} ||= 0; # decline the message on clamav failure unless ($self->{_spool_dir}) { $self->log(LOGERROR, "No spool dir configuration found"); return undef; } unless (-d $self->{_spool_dir}) { $self->log(LOGERROR, "Spool dir $self->{_spool_dir} does not exist"); return undef; } } sub hook_data_post { my ($self, $transaction) = @_; if ($transaction->data_size > $self->{_max_size}) { $self->log(LOGWARN, 'Mail too large to scan (' . $transaction->data_size . " vs $self->{_max_size})" ); return (DECLINED); } my $filename = $transaction->body_filename; unless (defined $filename) { $self->log(LOGWARN, "didn't get a filename"); return DECLINED; } my $mode = (stat($self->{_spool_dir}))[2]; if ($mode & 07077) { # must be sharing spool directory with external app $self->log(LOGWARN, "Changing permissions on file to permit scanner access"); chmod $mode, $filename; } # Now do the actual scanning! my $cmd = $self->{_clamscan_loc} . " --stdout " . $self->{_back_compat} . " --config-file=" . $self->{_clamd_conf} . " --no-summary $filename 2>&1"; $self->log(LOGDEBUG, "Running: $cmd"); my $output = `$cmd`; my $result = ($? >> 8); my $signal = ($? & 127); chomp($output); $output =~ s/^.* (.*) FOUND$/$1 /mg; $self->log(LOGINFO, "clamscan results: $output"); if ($signal) { $self->log(LOGINFO, "clamscan exited with signal: $signal"); return (DENYSOFT) if (!$self->{_declined_on_fail}); return (DECLINED); } if ($result == 1) { $self->log(LOGINFO, "Virus(es) found: $output"); if ($self->{_action} eq 'add-header') { $transaction->header->add('X-Virus-Found', 'Yes'); $transaction->header->add('X-Virus-Details', $output); } else { return (DENY, "Virus Found: $output"); } } elsif ($result) { $self->log(LOGERROR, "ClamAV error: $cmd: $result\n"); return (DENYSOFT) if (!$self->{_declined_on_fail}); } else { $transaction->header->add('X-Virus-Checked', "Checked by ClamAV on " . $self->qp->config("me")); } return (DECLINED); } qpsmtpd-0.94/plugins/virus/clamdscan000066400000000000000000000230011240247602400176340ustar00rootroot00000000000000#!perl -w =head1 NAME clamdscan =head1 DESCRIPTION A qpsmtpd plugin for virus scanning using the ClamAV scan daemon, clamd. =head1 RESTRICTIONS If connecting to clamd via TCP/IP host:port, then ignore this restriction. The ClamAV scan daemon, clamd, must have at least execute access to the qpsmtpd spool directory in order to sucessfully scan the messages. You can ensure this by running clamd as the same user as qpsmtpd does, or by doing the following: =over 4 =item * Change the group ownership of the spool directory to be a group of which clamav is a member or add clamav to the same group as the qpsmtpd user. =item * Enable the "AllowSupplementaryGroups" option in clamd.conf. =item * Add group-execute permissions to the qpsmtpd spool directory. =item * Make sure that all directories above the spool directory (to the root) are g+x so that the group has directory traversal rights; it is not necessary for the group to have any read rights. =back It may be helpful to temporary grant the clamav user a shell and test to make sure you can cd into the spool directory and read files located there. Remember to remove the shell from the clamav user when you are done testing. =head1 INSTALL AND CONFIG Place this plugin in the plugin/virus directory beneath the standard qpsmtpd installation. If you installed clamd with the default path, you can use this plugin with default options (nothing specified): You must have the ClamAV::Client module installed to use the plugin. =over 4 =item B Full path to the clamd socket, if different from the ClamAV::Client defaults. =item B IP address where clamd is listening. Default: localhost =item B The TCP port where the clamd service is running, typically 3310. Default: disabled. When present, overrides clamd_socket. =item B Whether the scanner will automatically delete messages which have viruses. Takes either 'yes' or 'no'. If set to 'no', adds a header with the virus name. Default: yes =item B Whether to defer the mail (with a soft-failure error, which will incur a retry) if an unrecoverable error occurs during the scan. The default is to accept the mail under these conditions. This can permit viruses to be accepted when the clamd daemon is malfunctioning or unreadable, but will not allow mail to backlog or be lost if the condition persists. =item B The maximum size, in kilobytes, of messages to scan. Default: 1024 (1 MB) =item B Scan all messages, even if there are no attachments =back =head1 REQUIREMENTS This module requires the ClamAV::Client module, found on CPAN here: L =head1 AUTHOR Originally written for the Clamd module by John Peacock ; adjusted for ClamAV::Client by Devin Carraway . =head1 COPYRIGHT AND LICENSE Copyright (c) 2005 John Peacock, Copyright (c) 2007 Devin Carraway Copyright (c) 2013 Matt Simerson Based heavily on the clamav plugin This plugin is licensed under the same terms as the qpsmtpd package itself. Please see the LICENSE file included with qpsmtpd for details. =cut use strict; use warnings; #use ClamAV::Client; # eval'ed in $self->register use Socket qw(:DEFAULT :crlf); use Qpsmtpd::Constants; sub register { my $self = shift; my $qp = shift; $self->log(LOGERROR, "Bad parameters for the clamdscan plugin") if @_ % 2; $self->{'_args'} = {@_}; eval 'use ClamAV::Client'; if ($@) { warn "unable to load ClamAV::Client\n"; $self->log(LOGERROR, "unable to load ClamAV::Client"); return; } # Set some sensible defaults $self->{'_args'}{'deny_viruses'} ||= 'yes'; $self->{'_args'}{'max_size'} ||= 1024; $self->{'_args'}{'scan_all'} ||= 1; for my $setting ('deny_viruses', 'defer_on_error') { next unless $self->{'_args'}{$setting}; if (lc $self->{'_args'}{$setting} eq 'no') { $self->{'_args'}{$setting} = 0; } } $self->register_hook('data_post', 'data_post_handler'); } sub data_post_handler { my ($self, $transaction) = @_; if ($self->connection->notes('naughty')) { $self->log(LOGINFO, "skip, naughty"); return (DECLINED); } return (DECLINED) if $self->is_too_big($transaction); return (DECLINED) if $self->is_not_multipart($transaction); my $clamd = $self->get_clamd() or return $self->err_and_return("Cannot instantiate ClamAV::Client"); unless (eval { $clamd->ping() }) { return $self->err_and_return("Cannot ping clamd server: $@"); } my ($version) = split(/\//, $clamd->version); $version ||= 'ClamAV'; my ($path, $found); if ( $self->{_args}{clamd_port} ) { my $message = $self->assemble_message($transaction); $found = eval { $clamd->scan_scalar(\$message) }; # pass scalar ref # $found = eval { $clamd->scan_stream() }; # pass IO handle } else { my $filename = $self->get_filename($transaction) or return DECLINED; $self->set_permission($filename) or return DECLINED; ($path, $found) = eval { $clamd->scan_path($filename) }; }; if ($@) { return $self->err_and_return("Error scanning mail: $@"); } if ($found) { $self->log(LOGNOTICE, "fail, found virus $found"); $self->is_naughty(1); # see plugins/naughty $self->adjust_karma(-1); if ($self->{_args}{deny_viruses}) { return (DENY, "Virus found: $found"); } $transaction->header->add('X-Virus-Found', 'Yes', 0); $transaction->header->add('X-Virus-Details', $found, 0); return (DECLINED); } $self->log(LOGINFO, "pass, clean"); $transaction->header->add('X-Virus-Found', 'No', 0); $transaction->header->add('X-Virus-Checked', "by $version on " . $self->qp->config('me'), 0); return (DECLINED); } sub assemble_message { my ($self, $transaction) = @_; $transaction->body_resetpos; my $message = $transaction->header->as_string . "\n\n"; while (my $line = $transaction->body_getline) { $message .= $line; } $message = join(CRLF, split /\n/, $message); return $message . CRLF; } sub err_and_return { my $self = shift; my $message = shift; if ($message) { $self->log(LOGERROR, $message); } return (DENYSOFT, "Unable to scan for viruses") if $self->{_args}{defer_on_error}; return (DECLINED, "skip"); } sub get_filename { my $self = shift; my $transaction = shift || $self->qp->transaction; my $filename = $transaction->body_filename; if (!$filename) { $self->log(LOGWARN, "Cannot process due to lack of filename"); return; } if (!-f $filename) { $self->log(LOGERROR, "spool file missing! Attempting to respool"); $transaction->body_spool; $filename = $transaction->body_filename; if (!-f $filename) { $self->log(LOGERROR, "skip: failed spool to $filename! Giving up"); return; } my $size = (stat($filename))[7]; $self->log(LOGDEBUG, "Spooled $size bytes to $filename"); } return $filename; } sub set_permission { my ($self, $filename) = @_; # the spool directory must be readable and executable by the scanner; # this generally means either group or world exec; if # neither of these is set, issue a warning but try to proceed anyway my $dir_mode = (stat($self->spool_dir()))[2]; $self->log(LOGDEBUG, "spool dir mode: $dir_mode"); if ($dir_mode & 0010 || $dir_mode & 0001) { # match the spool file mode with the mode of the directory -- add # the read bit for group, world, or both, depending on what the # spool dir had, and strip all other bits, especially the sticky bit my $fmode = ($dir_mode & 0044) | ($dir_mode & 0010 ? 0040 : 0) | ($dir_mode & 0001 ? 0004 : 0); unless (chmod $fmode, $filename) { $self->log(LOGERROR, "chmod: $filename: $!"); return; } return 1; } $self->log(LOGWARN, "spool directory permissions do not permit scanner access"); return 1; } sub get_clamd { my $self = shift; my $port = $self->{'_args'}{'clamd_port'}; my $host = $self->{'_args'}{'clamd_host'} || 'localhost'; if ($port && $port =~ /^(\d+)/) { return new ClamAV::Client(socket_host => $host, socket_port => $1); } my $socket = $self->{'_args'}{'clamd_socket'}; if ($socket) { if ($socket =~ /([\w\/.]+)/) { return new ClamAV::Client(socket_name => $1); } $self->log(LOGERROR, "invalid characters in socket name"); } return new ClamAV::Client; } sub is_too_big { my $self = shift; my $transaction = shift || $self->qp->transaction; my $size = $transaction->data_size; if ($size > $self->{_args}{max_size} * 1024) { $self->log(LOGINFO, "skip, too big ($size)"); return 1; } $self->log(LOGDEBUG, "data_size, $size"); return; } sub is_not_multipart { my $self = shift; my $transaction = shift || $self->qp->transaction; return if $self->{'_args'}{'scan_all'}; return 1 if !$transaction->header; # Ignore non-multipart emails my $content_type = $transaction->header->get('Content-Type') or return 1; $content_type =~ s/\s/ /g; if ($content_type !~ m!\bmultipart/.*\bboundary="?([^"]+)!i) { $self->log(LOGNOTICE, "skip, not multipart"); return 1; } return; } qpsmtpd-0.94/plugins/virus/hbedv000066400000000000000000000110771240247602400170110ustar00rootroot00000000000000#!perl -w # H+B EDV-AV plugin. =head1 NAME hbedv - plugin for qpsmtpd which calls the H+BEDV anti virus scanner =head1 DESCRIPTION The B plugin checks a mail for viruses with the H+BEDV anti virus scanner (see L for info). It can deny mails if a virus was found with a configurable deny list. =head1 VERSION this is B version 1.1 =head1 CONFIGURATION Add (perl-)regexps to the F configuration file, one per line for the virii you want to block, e.g.: Worm\/Sober\..* Worm\/NetSky\..* or just .* to block any virus ;) Set the location of the binary with hbedv hbedvscanner /path/to/antivir in the plugin config if qpsmtpd, the location defaults to I. =head1 NOTES If the hbedv_deny config file is empty or could not be found, any virus will be blocked. This plugin started life as a copy of the B plugin. =head1 LICENCE Written by Hanno Hecker Ehah@uu-x.deE. The B plugin is published under the same licence as qpsmtpd itself. =cut sub register { my ($self, $qp, @args) = @_; if (@args % 2) { $self->log(LOGERROR, "FATAL ERROR: odd number of arguments"); exit 3; } my %args = @args; if (!exists $args{hbedvscanner}) { $self->{_hbedvscan_loc} = "/usr/bin/antivir"; } else { if ($args{hbedvscanner} =~ /^(\/[\/\-\_\.a-z0-9A-Z]*)$/) { $self->{_hbedvscan_loc} = $1; } else { $self->log(LOGERROR, "FATAL ERROR: Unexpected characters in hbedvscanner argument"); exit 3; } } } sub hook_data_post { my ($self, $transaction) = @_; my $filename = $transaction->body_filename; unless (defined $filename) { $self->log(LOGWARN, "didn't get a file name"); return (DECLINED); } # Now do the actual scanning! my $cmd = $self->{_hbedvscan_loc} . " --archive-max-recursion=50 --alltypes -z -noboot -nombr -rs $filename 2>&1"; $self->log(LOGDEBUG, "Running: $cmd"); my @output = `$cmd`; my $result = ($? >> 8); my $signal = ($? & 127); chomp(@output); my @virii = (); foreach my $line (@output) { next unless $line =~ /^ALERT: \[([^\]]+)\s+(\w+)?\]/; # $2 =~ /^(virus|worm)$/; push @virii, $1; } @virii = unique(@virii); $self->log(LOGDEBUG, "results: " . join("//", @output)); if ($signal) { $self->log(LOGWARN, "scanner exited with signal: $signal"); return (DECLINED); } my $output = join(", ", @virii); $output = substr($output, 0, 60); if ($result == 1 || $result == 3) { $self->log(LOGWARN, "Virus(es) found: $output"); # return (DENY, "Virus Found: $output"); # $transaction->header->add('X-Virus-Found', 'Yes', 0); # $transaction->header->add('X-Virus-Details', $output, 0); $transaction->header->add('X-H+BEDV-Virus-Found', 'Yes', 0); $transaction->header->add('X-H+BEDV-Virus-Details', $output, 0); } elsif ($result == 200) { $self->log(LOGWARN, "Program aborted, not enough memory available"); } elsif ($result == 211) { $self->log(LOGWARN, "Programm aborted, because the self check failed"); } elsif ($result == 214) { $self->log(LOGWARN, "License key not found"); } elsif ($result) { $self->log(LOGWARN, "Error: $result, look for exit codes in the output of '" . $self->{_hbedvscan_loc} . " --help' for more info\n" ); } # $transaction->header->add('X-Virus-Checked', 'Checked', 0); $transaction->header->add('X-H+BEDV-Virus-Checked', 'Checked', 0); return (DECLINED) unless $result; if (@virii) { return (DENY, "Virus found: $output") unless $self->qp->config("hbedv_deny"); foreach my $d ($self->qp->config("hbedv_deny")) { foreach my $v (@virii) { if ($v =~ /^$d$/i) { $self->log(LOGWARN, "Denying mail with virus '$v'"); return (DENY, "Virus found: $output"); } } } } return (DECLINED); } sub unique { ## This is the short version, I haven't tried if any warnings ## are generated by perl if you use just this... if you need ## every cpu cycle, try this: ## my %h;foreach (@_) { ++$h{$_}; }; return keys(%h); my @list = @_; my %hash; foreach my $item (@list) { exists $hash{$item} || ($hash{$item} = 1); } return keys(%hash); } qpsmtpd-0.94/plugins/virus/kavscanner000066400000000000000000000134641240247602400200560ustar00rootroot00000000000000#!perl -w # Kasperski-AV plugin. =head1 NAME kavscanner - plugin for qpsmtpd which calls the Kasperski anti virus scanner =head1 DESCRIPTION Check a mail with the B and deny if it matches a configured virus list. =head1 VERSION this is B version 1.0 =head1 CONFIGURATION Add (perl-)regexps to the F configuration file, one per line for the virii you want to block, e.g.: I-Worm\.Sober\..* I-Worm\.NetSky\..* NOTE: untested and disabled currently, need volunteers :-) If this list does not match the virus found in the mail, you may set I in the plugin config to send a B to the given mail address, i.e. the line kavscanner bcc_virusadmin viradm@your.company.com in the F file instead of just kavscanner Set the location of the binary with kavscanner kavscanner_bin /path/to/kavscanner (default: F), NOTE: this may be broken, you want to set B explicitly ;-) =head1 NOTES This is a merge of the clam_av plugin for qpsmtpd and qmail-scanner-queue.pl L with my own improvements ;-) Only tested with kavscanner 4.0.x, and bcc_virusadmin untested, as we have no use for it currently. I wait for an official change in Qpsmtpd::Transaction (reset/set the RCPT TO list) to activate and test the currently disabled B option. =cut use File::Temp qw(tempfile); use Mail::Address; sub register { my ($self, $qp, @args) = @_; if (@args % 2) { $self->log(LOGWARN, "kavscanner: Wrong number of arguments"); $self->{_kavscanner_bin} = "/opt/AVP/kavscanner"; } else { my %args = @args; foreach my $key (keys %args) { my $arg = $key; $key =~ s/^/_/; $self->{$key} = $args{$arg}; } # Untaint scanner location if (exists $self->{_kavscanner_bin} && $self->{_kavscanner_bin} =~ /^(\/[\/\-\_\.a-z0-9A-Z]*)$/) { $self->{_kavscanner_bin} = $1; } else { $self->log(LOGALERT, "FATAL ERROR: Unexpected characters in kavscanner argument"); exit 3; } } } sub hook_data_post { my ($self, $transaction) = @_; my ($temp_fh, $filename) = tempfile(); print $temp_fh $transaction->header->as_string; print $temp_fh "\n"; $transaction->body_resetpos; while (my $line = $transaction->body_getline) { print $temp_fh $line; } seek($temp_fh, 0, 0); # Now do the actual scanning! my $cmd = $self->{_kavscanner_bin} . " -Y -P -B -MP -MD -* $filename 2>&1"; $self->log(LOGNOTICE, "Running: $cmd"); my @output = `$cmd`; chomp(@output); my $result = ($? >> 8); my $signal = ($? & 127); unlink($filename); close $temp_fh; if ($signal) { $self->log(LOGWARN, "kavscanner exited with signal: $signal"); return (DECLINED); } my $description = 'clean'; my @infected = (); my @suspicious = (); if ($result > 0) { if ($result =~ /^(2|3|4|8)$/) { foreach (@output) { if (/^.* infected: (.*)$/) { # This covers the specific push @infected, $1; } elsif (/^\s*.* suspicion: (.*)$/) { # This covers the potential viruses push @suspicious, $1; } } $description = "infected by: " . join(", ", @infected) . "; " . "suspicions: " . join(", ", @suspicious); # else we may get a veeeery long X-Virus-Details: line or log entry $description = substr($description, 0, 60); $self->log(LOGWARN, "There be a virus! ($description)"); ### Untested by now, need volunteers ;-) #if ($self->qp->config("kav_deny")) { # foreach my $d (keys %{$self->qp->config("kav_deny", "map")}) { # foreach my $v (@infected) { # return(DENY, "Virus found: $description") # if ($v =~ /^$d$/i); # } # foreach my $s (@suspicious) { # return(DENY, "Virus found: $description") # if ($s =~ /^$d$/i); # } # } #} $transaction->header->add('X-Virus-Found', 'Yes'); $transaction->header->add('X-Virus-Details', $description); ### maybe the spamassassin plugin can skip this mail if a virus ### was found (and $transaction->notes('virus_flag') exists :)) ### ...ok, works with our spamassassin plugin version ### -- hah $transaction->notes('virus', $description); $transaction->notes('virus_flag', 'Yes'); #### requires modification of Qpsmtpd/Transaction.pm: # if ($self->{_to_virusadmin}) { # my @addrs = (); # foreach (@{$transaction->recipients}) { # push @addr, $_->address; # } # $transaction->header->add('X-Virus-Orig-RcptTo', join(", ", @addrs)); # $transaction->set_recipients(@{ Mail::Address->parse($self->{_to_virusadmin}) }); # } elsif ($self->{_bcc_virusadmin}) { if ($self->{_bcc_virusadmin}) { foreach (@{Mail::Address->parse($self->{_bcc_virusadmin})}) { $transaction->add_recipient($_); } } } else { $self->log(LOGEMERG, "corrupt or unknown Kaspersky scanner/resource problems - exit status $result" ); } } $self->log(LOGINFO, "kavscanner results: $description"); $transaction->header->add('X-Virus-Checked', 'Checked by ' . $self->qp->config("me")); return (DECLINED); } qpsmtpd-0.94/plugins/virus/klez_filter000066400000000000000000000016301240247602400202250ustar00rootroot00000000000000#!perl -w sub hook_data_post { my ($self, $transaction) = @_; # klez files are always sorta big .. how big? Dunno. return (DECLINED) if $transaction->data_size < 60_000; # 220k was too little, so let's just disable the "big size check" # or $transaction->data_size > 1_000_000; # maybe it would be worthwhile to add a check for # Content-Type: multipart/alternative; here? # make sure we read from the beginning; $transaction->body_resetpos; my $line_number = 0; my $seen_klez_signature = 0; while ($_ = $transaction->body_getline) { last if $line_number++ > 40; m/^Content-type:.*(?:audio|application)/i and ++$seen_klez_signature and next; return (DENY, "Klez Virus Detected") if $seen_klez_signature and m!^TVqQAAMAAAAEAAAA//8AALgAAAAAAAAAQA!; } return (DECLINED); } qpsmtpd-0.94/plugins/virus/sophie000066400000000000000000000125631240247602400172110ustar00rootroot00000000000000#!perl -w use IO::Socket; sub register { my ($self, $qp, @args) = @_; %{$self->{"_sophie"}} = @args; # Set some sensible defaults $self->{"_sophie"}->{"sophie_socket"} ||= "/var/run/sophie"; $self->{"_sophie"}->{"deny_viruses"} ||= "yes"; $self->{"_sophie"}->{"max_size"} ||= 128; } sub hook_data_post { my ($self, $transaction) = @_; $DB::single = 1; if ($transaction->data_size > $self->{"_sophie"}->{"max_size"} * 1024) { $self->log(LOGNOTICE, "Declining due to data_size"); return (DECLINED); } # Ignore non-multipart emails my $content_type = $transaction->header->get('Content-Type'); $content_type =~ s/\s/ /g if defined $content_type; unless ( $content_type && $content_type =~ m!\bmultipart/.*\bboundary="?([^"]+)!i) { $self->log(LOGWARN, "non-multipart mail - skipping"); return DECLINED; } my $filename = $transaction->body_filename; unless ($filename) { $self->log(LOGWARN, "Cannot process due to lack of filename"); return (DECLINED); # unless $filename; } my $mode = (stat($self->spool_dir()))[2]; if ($mode & 07077) { # must be sharing spool directory with external app $self->log(LOGWARN, "Changing permissions on file to permit scanner access"); chmod $mode, $filename; } my ($SOPHIE, $response); socket(\*SOPHIE, AF_UNIX, SOCK_STREAM, 0) || die "Couldn't create socket ($!)\n"; connect(\*SOPHIE, pack_sockaddr_un $self->{"_sophie"}->{"sophie_socket"}) || die "Couldn't connect() to the socket ($!)\n"; syswrite(\*SOPHIE, $filename . "\n", length($filename) + 1); sysread(\*SOPHIE, $response, 256); close(\*SOPHIE); my $virus; if (($virus) = ($response =~ m/^1:?(.*)?$/)) { $self->log(LOGERROR, "One or more virus(es) found: $virus"); if (lc($self->{"_sophie"}->{"deny_viruses"}) eq "yes") { return (DENY, "Virus" . ($virus =~ /,/ ? "es " : " ") . "Found: $virus"); } else { $transaction->header->add('X-Virus-Found', 'Yes'); $transaction->header->add('X-Virus-Details', $virus); return (DECLINED); } } $transaction->header->add('X-Virus-Checked', "Checked by SOPHIE on " . $self->qp->config("me")); return (DECLINED); } =head1 NAME sophie scanner =head1 DESCRIPTION A qpsmtpd plugin for virus scanning using the SOPHOS scan daemon, Sophie. =head1 RESTRICTIONS The Sophie scan daemon must have at least read access to the qpsmtpd spool directory in order to sucessfully scan the messages. You can ensure this by running Sophie as the same user as qpsmtpd does (by far the easiest method) or by doing the following: =over 4 =item * Change the group ownership of the spool directory to be a group of which the Sophie user is a member or add the Sophie user to the same group as the qpsmtpd user. =item * Change the permissions of the qpsmtpd spool directory to 0750 (this will emit a warning when the qpsmtpd service starts up, but can be safely ignored). =item * Make sure that all directories above the spool directory (to the root) are g+x so that the group has directory traversal rights; it is not necessary for the group to have any read rights except to the spool directory itself. =back It may be helpful to temporary grant the Sophie user a shell and test to make sure you can cd into the spool directory and read files located there. Remember to remove the shell from the Sophieav user when you are done testing. Note also that the contents of config/spool_dir must be the full path to the spool directory (not a relative path) in order for the scanner to locate the file. =head1 INSTALL AND CONFIG Place this plugin in the plugin/virus directory beneath the standard qpsmtpd installation. If you installed Sophie with the default path, you can use this plugin with default options (nothing specified): =over 4 =item B Full path to the Sophie socket defaults to /var/run/Sophie. =item B Whether the scanner will automatically delete messages which have viruses. Takes either 'yes' or 'no' (defaults to 'yes'). If set to 'no' it will add a header to the message with the virus results. =item B The maximum size, in kilobytes, of messages to scan; defaults to 128k. =back =head1 REQUIREMENTS This module requires the Sophie daemon, available here: L which in turn requires the libsavi.so library (available with the Sophos Anti-Virus for Linux or Unix). The following changes to F B be made: =over 4 =item user: qmaild Change the "user" parameter to match the qpsmtpd user. =item group: nofiles Change the "group" parameter to match the qpsmtpd group. =item umask: 0001 If you don't change the umask, only the above user/group will be able to scan. =back The following changes to F B be made: =over 4 =item Mime: 1 This option will permit the SAVI engine to directly scan e-mail messages. =back =head1 AUTHOR John Peacock =head1 COPYRIGHT AND LICENSE Copyright (c) 2005 John Peacock Based heavily on the clamav plugin This plugin is licensed under the same terms as the qpsmtpd package itself. Please see the LICENSE file included with qpsmtpd for details. =cut qpsmtpd-0.94/plugins/virus/uvscan000066400000000000000000000076441240247602400172250ustar00rootroot00000000000000#!perl -w =head1 NAME uvscan =head1 DESCRIPTION A qpsmtpd plugin for the McAfee commandline virus scanner, uvscan. =head1 INSTALL AND CONFIG Place this plugin in the plugin/virus directory beneath the standard qpsmtpd installation. If you installed uvscan with the default path, you can use this plugin with default options (nothing specified): =over 4 =item B Full path to the uvscan binary and all signature files; defaults to /usr/local/bin/uvscan. =item B Whether the scanner will automatically delete messages which have viruses. Takes either 'yes' or 'no' (defaults to 'yes'). =back =head1 AUTHOR John Peacock =head1 COPYRIGHT AND LICENSE Copyright (c) 2004 John Peacock Based heavily on the clamav plugin This plugin is licensed under the same terms as the qpsmtpd package itself. Please see the LICENSE file included with qpsmtpd for details. =cut sub register { my ($self, $qp, @args) = @_; while (@args) { $self->{"_uvscan"}->{pop @args} = pop @args; } $self->{"_uvscan"}->{"uvscan_location"} ||= "/usr/local/bin/uvscan"; } sub hook_data_post { my ($self, $transaction) = @_; return (DECLINED) if $transaction->data_size > 250_000; # Ignore non-multipart emails my $content_type = $transaction->header->get('Content-Type'); $content_type =~ s/\s/ /g if defined $content_type; unless ( $content_type && $content_type =~ m!\bmultipart/.*\bboundary="?([^"]+)!i) { $self->log(LOGWARN, "non-multipart mail - skipping"); return DECLINED; } my $filename = $transaction->body_filename; return (DECLINED) unless $filename; # Now do the actual scanning! my @cmd = ( $self->{"_uvscan"}->{"uvscan_location"}, '--mime', '--unzip', '--secure', '--noboot', $filename, '2>&1 |' ); $self->log(LOGINFO, "Running: ", join(' ', @cmd)); open(FILE, join(' ', @cmd)); #perl 5.6 doesn't properly support the pipe # mode list form of open, but this is basically the same thing. This form # of exec is safe(ish). my $output; while () { $output .= $_; } close FILE; my $result = ($? >> 8); my $signal = ($? & 127); my $virus; if ($output && $output =~ m/.*\W+Found (.*)\n/m) { $virus = $1; } if ($output && $output =~ m/password-protected/m) { return (DENY, 'We do not accept password-protected zip files!'); } if ($signal) { $self->log(LOGWARN, "uvscan exited with signal: $signal"); return (DECLINED); } if ($result == 2) { $self->log(LOGERROR, "Integrity check for a DAT file failed."); return (DECLINED); } elsif ($result == 6) { $self->log(LOGERROR, "A general problem has occurred."); return (DECLINED); } elsif ($result == 8) { $self->log(LOGERROR, "The program could not find a DAT file."); return (DECLINED); } elsif ($result == 15) { $self->log(LOGERROR, "The program self-check failed"); return (DECLINED); } elsif ($result) { # all of the possible virus returns if ($result == 12) { $self->log(LOGERROR, "The program tried to clean a file but failed."); } elsif ($result == 13) { $self->log(LOGERROR, "One or more virus(es) found"); } elsif ($result == 19) { $self->log(LOGERROR, "Successfully cleaned the file"); } if (lc($self->{"_uvscan"}->{"deny_viruses"}) eq "yes") { return (DENY, "Virus Found: $virus"); } $transaction->header->add('X-Virus-Found', 'Yes'); $transaction->header->add('X-Virus-Details', $virus); return (DECLINED); } $transaction->header->add('X-Virus-Checked', "Checked by McAfee uvscan on " . $self->qp->config("me")); return (DECLINED); } qpsmtpd-0.94/plugins/whitelist000066400000000000000000000162061240247602400165640ustar00rootroot00000000000000#!perl -w =head1 NAME whitelist - whitelist override for other qpsmtpd plugins =head1 DESCRIPTION The B plugin allows selected hosts or senders or recipients to be whitelisted as exceptions to later plugin processing. It is a more conservative variant of Devin Carraway's 'whitelist' plugin. =head1 CONFIGURATION To enable the plugin, add it to the qpsmtpd/config/plugins file as usual. It should precede any plugins you might wish to whitelist for. Several configuration files are supported, corresponding to different parts of the SMTP conversation: =over 4 =item whitelisthosts Any IP address (or start-anchored fragment thereof) listed in the whitelisthosts file is exempted from any further validation during 'connect', and can be selectively exempted at other stages by plugins testing for a 'whitelisthost' connection note. Similarly, if the environment variable $WHITELISTCLIENT is set (which can be done by tcpserver), the connection will be exempt from further 'connect' validation, and the host can be selectively exempted by other plugins testing for a 'whitelistclient' connection note. =item whitelisthelo Any host that issues a HELO matching an entry in whitelisthelo will be exempted from further validation at the 'helo' stage. Subsequent plugins can test for a 'whitelisthelo' connection note. Note that this does not actually amount to an authentication in any meaningful sense. =item whitelistsenders If the envelope sender of a mail (that which is sent as the MAIL FROM) matches an entry in whitelistsenders, or if the hostname component matches, the mail will be exempted from any further validation within the 'mail' stage. Subsequent plugins can test for this exemption as a 'whitelistsender' transaction note. =item whitelistrcpt If any recipient of a mail (that sent as the RCPT TO) matches an entry from whitelistrcpt, or if the hostname component matches, no further validation will be required for this recipient. Subsequent plugins can test for this exemption using a 'whitelistrcpt' transaction note, which holds the count of whitelisted recipients. =back whitelist_soft also supports per-recipient whitelisting when using the per_user_config plugin. To enable the per-recipient behaviour (delaying all whitelisting until the rcpt part of the smtp conversation, and using per-recipient whitelist configs, if available), pass a true 'per_recipient' argument in the config/plugins invocation i.e. whitelist_soft per_recipient 1 By default global and per-recipient whitelists are merged; to turn off the merge behaviour pass a false 'merge' argument in the config/plugins invocation i.e. whitelist_soft per_recipient 1 merge 0 =head1 BUGS Whitelist lookups are all O(n) linear scans of configuration files, even though they're all associative lookups. Something should be done about this when CDB/DB/GDBM configs are supported. =head1 AUTHOR Based on the 'whitelist' plugin by Devin Carraway . Modified by Gavin Carr to not inherit whitelisting across hooks, but use per-hook whitelist notes instead. This is a more conservative approach e.g. whitelisting an IP will not automatically allow relaying from that IP. =cut use strict; use warnings; use Qpsmtpd::Constants; my $VERSION = 0.02; # Default is to merge whitelists in per_recipient mode my %MERGE = (merge => 1); sub register { my ($self, $qp, %arg) = @_; $self->{_per_recipient} = 1 if $arg{per_recipient}; $MERGE{merge} = $arg{merge} if defined $arg{merge}; # Normal mode - whitelist per hook unless ($arg{per_recipient}) { $self->register_hook("connect", "check_host"); $self->register_hook("helo", "check_helo"); $self->register_hook("ehlo", "check_helo"); $self->register_hook("mail", "check_sender"); $self->register_hook("rcpt", "check_rcpt"); } # Per recipient mode - defer all whitelisting to rcpt hook else { $self->register_hook("rcpt", "check_host"); $self->register_hook("helo", "helo_helper"); $self->register_hook("ehlo", "helo_helper"); $self->register_hook("rcpt", "check_helo"); $self->register_hook("rcpt", "check_sender"); $self->register_hook("rcpt", "check_rcpt"); } } sub check_host { my ($self, $transaction, $rcpt) = @_; my $ip = $self->qp->connection->remote_ip || return (DECLINED); # From tcpserver if (exists $ENV{WHITELISTCLIENT}) { $self->qp->connection->notes('whitelistclient', 1); $self->log(2, "pass, is whitelisted client"); $self->adjust_karma(5); return OK; } my $config_arg = $self->{_per_recipient} ? {rcpt => $rcpt, %MERGE} : {}; for my $h ($self->qp->config('whitelisthosts', $config_arg)) { if ($h eq $ip or $ip =~ /^\Q$h\E/) { $self->qp->connection->notes('whitelisthost', 1); $self->log(2, "pass, is a whitelisted host"); $self->adjust_karma(5); return OK; } } $self->log(LOGDEBUG, "skip: $ip is not whitelisted"); return DECLINED; } sub helo_helper { my ($self, $transaction, $helo) = @_; $self->{_whitelist_soft_helo} = $helo; return DECLINED; } sub check_helo { my ($self, $transaction, $helo) = @_; # If per_recipient will be rcpt hook, and helo actually rcpt my $config_arg = {}; if ($self->{_per_recipient}) { $config_arg = {rcpt => $helo, %MERGE}; $helo = $self->{_whitelist_soft_helo}; } for my $h ($self->qp->config('whitelisthelo', $config_arg)) { if ($helo and lc $h eq lc $helo) { $self->qp->connection->notes('whitelisthelo', 1); $self->log(2, "helo host $helo in whitelisthelo"); return OK; } } return DECLINED; } sub check_sender { my ($self, $transaction, $sender) = @_; # If per_recipient will be rcpt hook, and sender actually rcpt my $config_arg = {}; if ($self->{_per_recipient}) { $config_arg = {rcpt => $sender, %MERGE}; $sender = $transaction->sender; } return DECLINED if $sender->format eq '<>'; my $addr = lc $sender->address or return DECLINED; my $host = lc $sender->host or return DECLINED; for my $h ($self->qp->config('whitelistsenders', $config_arg)) { next unless $h; $h = lc $h; if ($addr eq $h or $host eq $h) { $transaction->notes('whitelistsender', 1); $self->log(2, "envelope sender $addr in whitelistsenders"); return OK; } } return DECLINED; } sub check_rcpt { my ($self, $transaction, $rcpt) = @_; my $addr = lc $rcpt->address or return DECLINED; my $host = lc $rcpt->host or return DECLINED; my $config_arg = $self->{_per_recipient} ? {rcpt => $rcpt, %MERGE} : {}; for my $h ($self->qp->config('whitelistrcpt', $config_arg)) { next unless $h; $h = lc $h; if ($addr eq $h or $host eq $h) { my $note = $transaction->notes('whitelistrcpt'); $transaction->notes('whitelistrcpt', ++$note); $self->log(2, "recipient $addr in whitelistrcpt"); return OK; } } return DECLINED; } qpsmtpd-0.94/qpsmtpd000077500000000000000000000017451240247602400145640ustar00rootroot00000000000000#!/usr/bin/perl -Tw # Copyright (c) 2001-2010 Ask Bjoern Hansen. See the LICENSE file for details. # The "command dispatch" system was taken from colobus - http://trainedmonkey.com/colobus/ # # this is designed to be run under tcpserver (http://cr.yp.to/ucspi-tcp.html) # or inetd if you're into that sort of thing # # For more information see http://smtpd.github.io/qpsmtpd/ # use lib 'lib'; use Qpsmtpd::TcpServer; use strict; $| = 1; delete $ENV{ENV}; $ENV{PATH} = '/bin:/usr/bin:/var/qmail/bin'; my $qpsmtpd = Qpsmtpd::TcpServer->new(); $qpsmtpd->load_plugins(); $qpsmtpd->start_connection(); $qpsmtpd->run(\*STDIN); # pass the "socket" like -prefork/-forkserver $qpsmtpd->run_hooks("post-connection"); $qpsmtpd->connection->reset; # needed for Qpsmtpd::TcpServer::check_socket(): # emulate IO::Socket::connected on STDIN. STDIN was used instead of STDOUT # because the other code also calls getpeername(STDIN). sub IO::Handle::connected { return getpeername(shift) } __END__ 1; qpsmtpd-0.94/qpsmtpd-async000077500000000000000000000273461240247602400157040ustar00rootroot00000000000000#!/usr/bin/perl use lib "./lib"; BEGIN { delete $ENV{ENV}; delete $ENV{BASH_ENV}; $ENV{PATH} = '/bin:/usr/bin:/var/qmail/bin:/usr/local/bin'; } # Profiling - requires Devel::Profiler 0.05 #BEGIN { $Devel::Profiler::NO_INIT = 1; } #use Devel::Profiler; use strict; use vars qw($DEBUG); use FindBin qw(); # TODO: need to make this taint friendly use lib "$FindBin::Bin/lib"; use Danga::Socket; use Danga::Client; use Qpsmtpd::PollServer; use Qpsmtpd::ConfigServer; use Qpsmtpd::Constants; use IO::Socket; use Carp; use POSIX qw(WNOHANG); use Getopt::Long; use List::Util qw(shuffle); $|++; use Socket qw(SOMAXCONN IPPROTO_TCP SO_KEEPALIVE TCP_NODELAY SOL_SOCKET AF_UNIX SOCK_STREAM PF_UNSPEC); $SIG{'PIPE'} = "IGNORE"; # handled manually $DEBUG = 0; my $CONFIG_PORT = 20025; my $CONFIG_LOCALADDR = '127.0.0.1'; my $PORT = 2525; my $LOCALADDR = '0.0.0.0'; my $PROCS = 1; my $USER = (getpwuid $>)[0]; # user to suid to $USER = "smtpd" if $USER eq "root"; my $PAUSED = 0; my $NUMACCEPT = 20; my $PID_FILE = ''; my $ACCEPT_RSET; my $DETACH; # daemonize on startup # make sure we don't spend forever doing accept() use constant ACCEPT_MAX => 1000; sub reset_num_accept { $NUMACCEPT = 20; } sub help { print < \$PORT, 'l|listen-address=s' => \$LOCALADDR, 'j|procs=i' => \$PROCS, 'v|verbose+' => \$DEBUG, 'u|user=s' => \$USER, 'pid-file=s' => \$PID_FILE, 'd|detach' => \$DETACH, 'h|help' => \&help, 'config-port=i' => \$CONFIG_PORT, ) || help(); # detaint the commandline if ($PORT =~ /^(\d+)$/) { $PORT = $1 } else { &help } if ($LOCALADDR =~ /^([\d\w\-.]+)$/) { $LOCALADDR = $1 } else { &help } if ($USER =~ /^([\w\-]+)$/) { $USER = $1 } else { &help } if ($PROCS =~ /^(\d+)$/) { $PROCS = $1 } else { &help } sub force_poll { $Danga::Socket::HaveEpoll = 0; $Danga::Socket::HaveKQueue = 0; } my $POLL = "with " . ( $Danga::Socket::HaveEpoll ? "epoll()" : $Danga::Socket::HaveKQueue ? "kqueue()" : "poll()" ); my $SERVER; my $CONFIG_SERVER; use constant READY => 1; use constant ACCEPTING => 2; use constant RESTARTING => 999; my %childstatus = (); if ($PID_FILE && -r $PID_FILE) { open PID, "<$PID_FILE" or die "open_pidfile $PID_FILE: $!\n"; my $running_pid = || ''; chomp $running_pid; if ($running_pid =~ /^(\d+)/) { if (kill 0, $running_pid) { die "Found an already running qpsmtpd with pid $running_pid.\n"; } } close(PID); } run_as_server(); exit(0); sub _fork { my $pid = fork; if (!defined($pid)) { die "Cannot fork: $!" } return $pid if $pid; # Fixup Net::DNS randomness after fork srand($$ ^ time); local $^W; delete $INC{'Net/DNS/Header.pm'}; require Net::DNS::Header; # cope with different versions of Net::DNS eval { $Net::DNS::Resolver::global{id} = 1; $Net::DNS::Resolver::global{id} = int(rand(Net::DNS::Resolver::MAX_ID())); # print "Next DNS ID: $Net::DNS::Resolver::global{id}\n"; }; if ($@) { # print "Next DNS ID: " . Net::DNS::Header::nextid() . "\n"; } # Fixup lost kqueue after fork $Danga::Socket::HaveKQueue = undef; } sub spawn_child { my $plugin_loader = shift || Qpsmtpd::SMTP->new; socketpair(my $reader, my $writer, AF_UNIX, SOCK_STREAM, PF_UNSPEC) || die "Unable to create a pipe"; $writer->autoflush(1); $reader->autoflush(1); if (my $pid = _fork) { $childstatus{$pid} = $writer; return $pid; } $SIG{CHLD} = $SIG{INT} = $SIG{TERM} = 'DEFAULT'; $SIG{PIPE} = 'IGNORE'; $SIG{HUP} = 'IGNORE'; close $CONFIG_SERVER; Qpsmtpd::PollServer->Reset; Qpsmtpd::PollServer->OtherFds( fileno($reader) => sub { command_handler($reader) }, fileno($SERVER) => \&accept_handler,); $ACCEPT_RSET = Danga::Socket->AddTimer(30, \&reset_num_accept); $plugin_loader->run_hooks('post-fork'); Qpsmtpd::PollServer->EventLoop(); exit; } # Note this is broken on KQueue because it requires that it handle signals itself or it breaks the event loop. sub sig_hup { for my $writer (values %childstatus) { print $writer "hup\n"; } } sub sig_chld { my $spawn_count = 0; while ((my $child = waitpid(-1, WNOHANG)) > 0) { if (!defined $childstatus{$child}) { next; } last unless $child > 0; print "SIGCHLD: child $child died\n"; delete $childstatus{$child}; $spawn_count++; } if ($spawn_count) { for (1 .. $spawn_count) { # restart a new child if in poll server mode my $pid = spawn_child(); } } $SIG{CHLD} = \&sig_chld; } sub HUNTSMAN { $SIG{CHLD} = 'DEFAULT'; kill 'INT' => keys %childstatus; if ($PID_FILE && -e $PID_FILE) { unlink $PID_FILE or ::log(LOGERROR, "unlink: $PID_FILE: $!"); } exit(0); } sub run_as_server { # establish SERVER socket, bind and listen. $SERVER = IO::Socket::INET->new( LocalPort => $PORT, LocalAddr => $LOCALADDR, Type => SOCK_STREAM, Proto => IPPROTO_TCP, Blocking => 0, Reuse => 1, Listen => SOMAXCONN ) or die "Error creating server $LOCALADDR:$PORT : $@\n"; IO::Handle::blocking($SERVER, 0); binmode($SERVER, ':raw'); $CONFIG_SERVER = IO::Socket::INET->new( LocalPort => $CONFIG_PORT, LocalAddr => $CONFIG_LOCALADDR, Type => SOCK_STREAM, Proto => IPPROTO_TCP, Blocking => 0, Reuse => 1, Listen => 1 ) or die "Error creating server $CONFIG_LOCALADDR:$CONFIG_PORT : $@\n"; IO::Handle::blocking($CONFIG_SERVER, 0); binmode($CONFIG_SERVER, ':raw'); # Drop priviledges my (undef, undef, $quid, $qgid) = getpwnam $USER or die "unable to determine uid/gid for $USER\n"; my $groups = "$qgid $qgid"; while (my (undef, undef, $gid, $members) = getgrent) { my @m = split(/ /, $members); if (grep { $_ eq $USER } @m) { $groups .= " $gid"; } } endgrent; $) = $groups; POSIX::setgid($qgid) or die "unable to change gid: $!\n"; POSIX::setuid($quid) or die "unable to change uid: $!\n"; $> = $quid; # Load plugins here my $plugin_loader = Qpsmtpd::SMTP->new(); $plugin_loader->load_plugins; if ($DETACH) { open STDIN, '/dev/null' or die "/dev/null: $!"; open STDOUT, '>/dev/null' or die "/dev/null: $!"; open STDERR, '>&STDOUT' or die "open(stderr): $!"; defined(my $pid = fork) or die "fork: $!"; exit 0 if $pid; POSIX::setsid or die "setsid: $!"; } if ($PID_FILE) { open PID, ">$PID_FILE" || die "$PID_FILE: $!"; print PID $$, "\n"; close PID; } $plugin_loader->log(LOGINFO, 'Running as user ' . (getpwuid($>) || $>) . ', group ' . (getgrgid($)) || $)) ); $SIG{INT} = $SIG{TERM} = \&HUNTSMAN; ###################### # more Profiling code =pod $plugin_loader->run_hooks('post-fork'); Devel::Profiler->set_options( bad_subs => [qw(Danga::Socket::EventLoop)], sub_filter => sub { my ($pkg, $sub) = @_; return 0 if $sub eq 'AUTOLOAD'; return 0 if $pkg =~ /ParaDNS::XS/; return 1; }, ); Devel::Profiler->init(); Qpsmtpd::PollServer->OtherFds( fileno($SERVER) => \&accept_handler, fileno($CONFIG_SERVER) => \&config_handler, ); Qpsmtpd::PollServer->EventLoop; exit; =cut ##################### for (1 .. $PROCS) { my $pid = spawn_child($plugin_loader); } $plugin_loader->log(LOGDEBUG, "Listening on $PORT with $PROCS children $POLL"); $SIG{CHLD} = \&sig_chld; $SIG{HUP} = \&sig_hup; Qpsmtpd::PollServer->OtherFds(fileno($CONFIG_SERVER) => \&config_handler,); Qpsmtpd::PollServer->EventLoop; exit; } sub config_handler { my $csock = $CONFIG_SERVER->accept(); if (!$csock) { # warn("accept failed on config server: $!"); return; } binmode($csock, ':raw'); printf("Config server connection\n") if $DEBUG; IO::Handle::blocking($csock, 0); setsockopt($csock, IPPROTO_TCP, TCP_NODELAY, pack("l", 1)) or die; my $client = Qpsmtpd::ConfigServer->new($csock); $client->watch_read(1); return; } sub command_handler { my $reader = shift; chomp(my $command = <$reader>); #print "Got command: $command\n"; my $real_command = "cmd_$command"; no strict 'refs'; $real_command->(); } sub cmd_hup { # clear cache print "Clearing cache\n"; Qpsmtpd::clear_config_cache(); # should also reload modules... but can't do that yet. } # Accept all new connections sub accept_handler { for (1 .. $NUMACCEPT) { return unless _accept_handler(); } # got here because we have accept's left. # So double the number we accept next time. $NUMACCEPT *= 2; $NUMACCEPT = ACCEPT_MAX if $NUMACCEPT > ACCEPT_MAX; $ACCEPT_RSET->cancel if defined $ACCEPT_RSET; $ACCEPT_RSET = Danga::Socket->AddTimer(30, \&reset_num_accept); } use Errno qw(EAGAIN EWOULDBLOCK); sub _accept_handler { my $csock = $SERVER->accept(); if (!$csock) { # warn("accept() failed: $!"); return; } binmode($csock, ':raw'); printf("Listen child making a Qpsmtpd::PollServer for %d.\n", fileno($csock)) if $DEBUG; IO::Handle::blocking($csock, 0); #setsockopt($csock, IPPROTO_TCP, TCP_NODELAY, pack("l", 1)) or die; #print "Got connection\n"; my $client = Qpsmtpd::PollServer->new($csock); if ($PAUSED) { $client->write("451 Sorry, this server is currently paused\r\n"); $client->close; return 1; } $client->process_line("Connect\n"); $client->watch_read(1); $client->pause_read(); return 1; } ######################################################################## sub log { my ($level, $message) = @_; # $level not used yet. this is reimplemented from elsewhere anyway warn("$$ fd:? $message\n"); } sub pause { my ($pause) = @_; $PAUSED = $pause; } qpsmtpd-0.94/qpsmtpd-forkserver000077500000000000000000000257541240247602400167600ustar00rootroot00000000000000#!/usr/bin/perl -Tw # Copyright (c) 2001-2010 Ask Bjoern Hansen. See the LICENSE file for details. # The "command dispatch" system is taken from colobus - http://trainedmonkey.com/colobus/ # # For more information see http://smtpd.github.io/qpsmtpd/ # use lib 'lib'; use Qpsmtpd::TcpServer; use Qpsmtpd::Constants; use IO::Socket; use IO::Select; use Socket; use Getopt::Long qw(:config no_ignore_case); use POSIX qw(:sys_wait_h :errno_h :signal_h); use Net::DNS::Header; use strict; $| = 1; my $has_ipv6 = Qpsmtpd::TcpServer::has_ipv6; # Configuration my $MAXCONN = 15; # max simultaneous connections my @PORT; # port number(s) my @LOCALADDR; # ip address(es) to bind to my $MAXCONNIP = 5; # max simultaneous connections from one IP my $PID_FILE = ''; my $DETACH; # daemonize on startup my $NORDNS; my $USER = (getpwuid $>)[0]; # user to suid to $USER = "smtpd" if $USER eq "root"; sub usage { print <<"EOT"; usage: qpsmtpd-forkserver [ options ] -l, --listen-address addr : listen on specific address(es); can be specified multiple times for multiple bindings. IPv6 addresses must be inside square brackets [], and don't need to be zero padded. Default is [::] (if has_ipv6) or 0.0.0.0 (if not) -p, --port P : listen on a specific port; default 2525; can be specified multiple times for multiple bindings. -c, --limit-connections N : limit concurrent connections to N; default 15 -u, --user U : run as a particular user (default '$USER') -m, --max-from-ip M : limit connections from a single IP; default 5 --pid-file P : print main servers PID to file P -d, --detach : detach from controlling terminal (daemonize) -H, --no-rdns : don't perform reverse DNS lookups EOT exit 0; } GetOptions( 'h|help' => \&usage, 'l|listen-address=s' => \@LOCALADDR, 'c|limit-connections=i' => \$MAXCONN, 'm|max-from-ip=i' => \$MAXCONNIP, 'p|port=s' => \@PORT, 'u|user=s' => \$USER, 'pid-file=s' => \$PID_FILE, 'd|detach' => \$DETACH, 'H|no-rdns' => \$NORDNS, ) || &usage; # detaint the commandline if ($has_ipv6) { @LOCALADDR = ('[::]') if !@LOCALADDR; } else { @LOCALADDR = ('0.0.0.0') if !@LOCALADDR; } @PORT = (2525) if !@PORT; my @LISTENADDR; for (0 .. $#LOCALADDR) { if ($LOCALADDR[$_] =~ /^(\[.*\]|[\d\w\-.]+)(?::(\d+))?$/) { if (defined $2) { push @LISTENADDR, {'addr' => $1, 'port' => $2}; } else { my $addr = $1; for (0 .. $#PORT) { if ($PORT[$_] =~ /^(\d+)$/) { push @LISTENADDR, {'addr' => $addr, 'port' => $1}; } else { &usage; } } } } else { &usage; } } if ($USER =~ /^([\w\-]+)$/) { $USER = $1 } else { &usage } if ($MAXCONN =~ /^(\d+)$/) { $MAXCONN = $1 } else { &usage } delete $ENV{ENV}; $ENV{PATH} = '/bin:/usr/bin:/var/qmail/bin'; my %childstatus = (); sub REAPER { while (defined(my $chld = waitpid(-1, WNOHANG))) { last unless $chld > 0; ::log(LOGINFO, "cleaning up after $chld"); delete $childstatus{$chld}; } } sub HUNTSMAN { $SIG{CHLD} = 'DEFAULT'; kill 'INT' => keys %childstatus; if ($PID_FILE && -e $PID_FILE) { unlink $PID_FILE or ::log(LOGERROR, "unlink: $PID_FILE: $!"); } exit(0); } $SIG{INT} = \&HUNTSMAN; $SIG{TERM} = \&HUNTSMAN; my $select = new IO::Select; my $server; # establish SERVER socket(s), bind and listen. for my $listen_addr (@LISTENADDR) { my @Socket_opts = ( LocalPort => $listen_addr->{'port'}, LocalAddr => $listen_addr->{'addr'}, Proto => 'tcp', Reuse => 1, Blocking => 0, Listen => SOMAXCONN ); if ($has_ipv6) { $server = IO::Socket::INET6->new(@Socket_opts) or die "Creating TCP socket $listen_addr->{'addr'}:$listen_addr->{'port'}: $!\n"; } else { $server = IO::Socket::INET->new(@Socket_opts) or die "Creating TCP socket $listen_addr->{'addr'}:$listen_addr->{'port'}: $!\n"; } IO::Handle::blocking($server, 0); $select->add($server); } if ($PID_FILE) { if ($PID_FILE =~ m#^(/[\w\d/\-.]+)$#) { $PID_FILE = $1 } else { &usage } if (-e $PID_FILE) { open PID, "+<$PID_FILE" or die "open pid_file: $!\n"; my $running_pid = || ''; chomp $running_pid; if ($running_pid =~ /(\d+)/) { $running_pid = $1; if (kill 0, $running_pid) { die "Found an already running qpsmtpd with pid $running_pid.\n"; } } seek PID, 0, 0 or die "Could not seek back to beginning of $PID_FILE: $!\n"; truncate PID, 0 or die "Could not truncate $PID_FILE at 0: $!"; } else { open PID, ">$PID_FILE" or die "open pid_file: $!\n"; } } # Load plugins here my $qpsmtpd = Qpsmtpd::TcpServer->new(); # Drop privileges my (undef, undef, $quid, $qgid) = getpwnam $USER or die "unable to determine uid/gid for $USER\n"; my $groups = "$qgid $qgid"; while (my ($name, $passwd, $gid, $members) = getgrent()) { my @m = split(/ /, $members); if (grep { $_ eq $USER } @m) { $groups .= " $gid"; } } endgrent; $) = $groups; POSIX::setgid($qgid) or die "unable to change gid: $!\n"; POSIX::setuid($quid) or die "unable to change uid: $!\n"; $> = $quid; $qpsmtpd->load_plugins; foreach my $listen_addr (@LISTENADDR) { ::log(LOGINFO, "Listening on $listen_addr->{'addr'}:$listen_addr->{'port'}"); } ::log(LOGINFO, 'Running as user ' . (getpwuid($>) || $>) . ', group ' . (getgrgid($)) || $)) ); if ($DETACH) { open STDIN, '/dev/null' or die "/dev/null: $!"; open STDOUT, '>/dev/null' or die "/dev/null: $!"; open STDERR, '>&STDOUT' or die "open(stderr): $!"; defined(my $pid = fork) or die "fork: $!"; exit 0 if $pid; POSIX::setsid or die "setsid: $!"; } if ($PID_FILE) { print PID $$, "\n"; close PID; } # Populate class cached variables $qpsmtpd->spool_dir; $qpsmtpd->size_threshold; $SIG{HUP} = sub { $qpsmtpd = Qpsmtpd::TcpServer->new('restart' => 1); $qpsmtpd->load_plugins; $qpsmtpd->spool_dir; $qpsmtpd->size_threshold; }; while (1) { REAPER(); my $running = scalar keys %childstatus; if ($running >= $MAXCONN) { ::log(LOGINFO, "Too many connections: $running >= $MAXCONN. Waiting one second." ); sleep(1); next; } my @ready = $select->can_read(1); next if !@ready; while (my $server = shift @ready) { my ($client, $hisaddr) = $server->accept; if (!$hisaddr) { # possible something condition... next; } IO::Handle::blocking($client, 1); # get local/remote hostname, port and ip address my ($port, $iaddr, $lport, $laddr, $nto_iaddr, $nto_laddr) = Qpsmtpd::TcpServer::lrpip($server, $client, $hisaddr); my ($rc, @msg) = $qpsmtpd->run_hooks( "pre-connection", remote_ip => $nto_iaddr, remote_port => $port, local_ip => $nto_laddr, local_port => $lport, max_conn_ip => $MAXCONNIP, child_addrs => [values %childstatus], ); if ($rc == DENYSOFT || $rc == DENYSOFT_DISCONNECT) { unless ($msg[0]) { @msg = ("Sorry, try again later"); } &respond_client($client, 451, @msg); close $client; next; } elsif ($rc == DENY || $rc == DENY_DISCONNECT) { unless ($msg[0]) { @msg = ("Sorry, service not available for you"); } &respond_client($client, 550, @msg); close $client; next; } my $pid = safe_fork(); if ($pid) { # parent $childstatus{$pid} = $iaddr; # add to table # $childstatus{$pid} = 1; # add to table $running++; close($client); next; } # otherwise child close $_ for $select->handles; $SIG{$_} = 'DEFAULT' for keys %SIG; $SIG{ALRM} = sub { print $client "421 Connection Timed Out\n"; ::log(LOGINFO, "Connection Timed Out"); exit; }; # set enviroment variables ($ENV{TCPLOCALIP}, $ENV{TCPREMOTEIP}, $ENV{TCPREMOTEHOST}) = Qpsmtpd::TcpServer::tcpenv($nto_laddr, $nto_iaddr); # don't do this! #$0 = "qpsmtpd-forkserver: $ENV{TCPREMOTEIP} / $ENV{TCPREMOTEHOST}"; ::log(LOGINFO, "Accepted connection $running/$MAXCONN from $ENV{TCPREMOTEIP} / $ENV{TCPREMOTEHOST}" ); # dup to STDIN/STDOUT POSIX::dup2(fileno($client), 0); POSIX::dup2(fileno($client), 1); $qpsmtpd->start_connection( local_ip => $ENV{TCPLOCALIP}, local_port => $lport, remote_ip => $ENV{TCPREMOTEIP}, remote_port => $port, ); $qpsmtpd->run($client); $qpsmtpd->run_hooks("post-connection"); $qpsmtpd->connection->reset; close $client; exit; # child leaves } } sub log { my ($level, $message) = @_; $qpsmtpd->log($level, $message); } sub respond_client { my ($client, $code, @message) = @_; $client->autoflush(1); while (my $msg = shift @message) { my $line = $code . (@message ? "-" : " ") . $msg; ::log(LOGDEBUG, $line); print $client "$line\r\n" or (::log(LOGERROR, "Could not print [$line]: $!"), return 0); } return 1; } ### routine to protect process during fork sub safe_fork { ### block signal for fork my $sigset = POSIX::SigSet->new(SIGINT); POSIX::sigprocmask(SIG_BLOCK, $sigset) or die "Can't block SIGINT for fork: [$!]\n"; ### fork off a child my $pid = fork; unless (defined $pid) { die "Couldn't fork: [$!]\n"; } ### make SIGINT kill us as it did before $SIG{INT} = 'DEFAULT'; ### put back to normal POSIX::sigprocmask(SIG_UNBLOCK, $sigset) or die "Can't unblock SIGINT for fork: [$!]\n"; return $pid; } __END__ 1; qpsmtpd-0.94/qpsmtpd-prefork000077500000000000000000000546101240247602400162310ustar00rootroot00000000000000#!/usr/bin/perl -Tw # High performance pre-forking qpsmtpd daemon, Copyright (C) 2006 SoftScan # http://www.softscan.co.uk # # Based on qpsmtpd-forkserver Copyright (C) 2001 Ask Bjoern Hansen # See the LICENSE file for details. # # For more information see http://smtpd.github.io/qpsmtpd/ # safety guards use strict; BEGIN { # secure shell $ENV{'PATH'} = '/bin:/usr/bin'; delete @ENV{qw(IFS CDPATH ENV BASH_ENV)}; } # includes use IO::Socket; use IO::Select; use POSIX; use IPC::Shareable(':all'); use lib 'lib'; use Qpsmtpd::TcpServer::Prefork; use Qpsmtpd::Constants; use Getopt::Long; use Config; defined $Config{sig_name} || die "No signals?"; my $has_ipv6 = Qpsmtpd::TcpServer::has_ipv6; #use Time::HiRes qw(gettimeofday tv_interval); #get available signals my %sig_num; my $i = 0; foreach my $sig_name (split(/\s/, $Config{sig_name})) { $sig_num{$sig_name} = $i++; } # version my $VERSION = "1.0"; # qpsmtpd instances my ($qpsmtpd); # cmd's needed by IPC my $ipcrm = '/usr/bin/ipcrm'; my $ipcs = '/usr/bin/ipcs'; my $xargs = '/usr/bin/xargs'; # vars we need my $chld_shmem; # shared mem to keep track of children (and their connections) my %children; my $chld_pool; my $chld_busy; my @children_term; # terminated children, their death pending processing # by the main loop my $select = new IO::Select; # socket(s) # default settings my $pid_file; my $d_port = 25; my @d_addr; # default applied after getopt call my $debug = 0; my $max_children = 15; # max number of child processes to spawn my $idle_children = 5; # number of idle child processes to spawn my $maxconnip = 10; my $child_lifetime = 100; # number of times a child may be reused my $loop_sleep = 15; # seconds main_loop sleeps before checking children my $re_nice = 5; # substracted from parents current nice level my $d_start = 0; my $quiet = 0; my $status = 0; my $signal = ''; my $pretty = 0; my $detach = 0; my $user; # help text sub usage { print <<"EOT"; Usage: qpsmtpd-prefork [ options ] --quiet : Be quiet (even errors are suppressed) --version : Show version information --debug : Enable debug output --listen-address addr: Listen for connections on the address 'addr' (either an IP address or ip:port pair). Listens on all interfaces by default; may be specified multiple times. --port int : TCP port daemon should listen on (default: $d_port) --max-from-ip int : Limit number of connections from single IP (default: $maxconnip, 0 to disable) --children int : Max number of children that can be spawned (default: $max_children) --idle-children int : Number of idle children to spawn (default: $idle_children, 0 to disable) --pretty-child : Change child process name (default: 0) --user username : User the daemon should run as --pid-file path : Path to pid file --renice-parent int : Subtract value from parent process nice level (default: $re_nice) --detach : detach from controlling terminal (daemonize) --help : This message EOT exit 0; } # get arguments GetOptions( 'quiet' => \$quiet, 'version' => sub { print "Qpsmtpd Daemon - version $VERSION\n"; exit 0; }, 'debug' => \$debug, 'interface|listen-address=s' => \@d_addr, 'port=i' => \$d_port, 'max-from-ip=i' => \$maxconnip, 'children=i' => \$max_children, 'idle-children=i' => \$idle_children, 'pretty-child' => \$pretty, 'user=s' => \$user, 'renice-parent=i' => \$re_nice, 'detach' => \$detach, 'pid-file=s' => \$pid_file, 'help' => \&usage, ) || &usage; if ($user && $user =~ /^([\w\-]+)$/) { $user = $1 } else { &usage } if (@d_addr) { for my $i (0 .. $#d_addr) { if ($d_addr[$i] =~ /^(\[.*\]|[\d\w\-.]+)(?::(\d+))?$/) { $d_addr[$i] = {'addr' => $1, 'port' => $2 || $d_port}; } else { print STDERR "Malformed listen address '$d_addr[$i]'\n"; &usage; } } } else { @d_addr = ({addr => $has_ipv6 ? "[::]" : "0.0.0.0", port => $d_port}); } # set max from ip to max number of children if option is set to disabled $maxconnip = $max_children if ($maxconnip == 0); #to fix limit counter error in plugin $maxconnip++; #ensure that idle_children matches value given to max_children $idle_children = $max_children if (!$idle_children || $idle_children > $max_children || $idle_children < -1); $chld_pool = $idle_children; if ($pid_file) { if ($pid_file =~ m#^(/[\w\d/\-.]+)$#) { $pid_file = $1 } else { &usage } if (-e $pid_file) { open PID, "+<$pid_file" or die "open pid_file: $!\n"; my $running_pid = || ''; chomp $running_pid; if ($running_pid =~ /(\d+)/) { $running_pid = $1; die "Found an already running qpsmtpd with pid $running_pid.\n" if (kill 0, $running_pid); } seek PID, 0, 0 or die "Could not seek back to beginning of $pid_file: $!\n"; truncate PID, 0 or die "Could not truncate $pid_file at 0: $!"; } else { open PID, ">$pid_file" or die "open pid_file: $!\n"; } } run(); #start daemon sub run { # get UUID/GUID my ($quid, $qgid, $groups); if ($user) { (undef, undef, $quid, $qgid) = getpwnam $user or die "unable to determine uid/gid for $user\n"; $groups = "$qgid $qgid"; while (my ($name, $passwd, $gid, $members) = getgrent()) { my @m = split(/ /, $members); if (grep { $_ eq $user } @m) { $groups .= " $gid"; } } endgrent; } for my $addr (@d_addr) { my @Socket_opts = ( LocalPort => $addr->{port}, LocalAddr => $addr->{addr}, Proto => 'tcp', Listen => SOMAXCONN, Reuse => 1, ); # create new socket (used by clients to communicate with daemon) my $s; if ($has_ipv6) { $s = IO::Socket::INET6->new(@Socket_opts); } else { $s = IO::Socket::INET->new(@Socket_opts); } die "FATAL: Failed to open socket on $addr->{addr}:$addr->{port} ($@)" . "\nIt may be necessary to wait 20 secs before starting daemon" . " again." unless $s; $select->add($s); } info( "qpsmtpd-prefork daemon, version: $VERSION, staring on host: " . join(', ', map { "$_->{addr}:$_->{port}" } @d_addr) . " (user: $user [$<])"); # reset priority my $old_nice = getpriority(0, 0); my $new_nice = $old_nice - $re_nice; if ($new_nice < 20 && $new_nice > -20) { setpriority(0, 0, $1) if ($new_nice =~ /(\-?\d+)/); info("parent daemon nice level: $1"); } else { die "FATAL: new nice level: $new_nice is not between -19 and 19 " . "(old level = $old_nice, renice value = $re_nice)"; } if ($user) { # change UUID/UGID $) = $groups; POSIX::setgid($qgid) or die "unable to change gid: $!\n"; POSIX::setuid($quid) or die "unable to change uid: $!\n"; $> = $quid; die "FATAL: failed to setuid to user: $user, uid: $quid\n" if ($> != $quid and $> != ($quid - 2**32)); } # setup shared memory $chld_shmem = shmem($d_port . "qpsmtpd", 1); untie $chld_shmem; # Interrupt handler $SIG{INT} = $SIG{TERM} = sub { # terminate daemon (and children) my $sig = shift; # prevent another signal and disable reaper $SIG{$sig} = $SIG{CHLD} = $SIG{HUP} = 'IGNORE'; # a notice, before the sleep below info("shutting down"); # close socket(s) $_->close for $select->handles; # send signal to process group kill -$sig_num{$sig} => $$; # cleanup IPC::Shareable->clean_up; unlink($pid_file) if $pid_file; info("shutdown of daemon"); exit; }; # Hup handler $SIG{HUP} = sub { # reload qpmstpd plugins $qpsmtpd = qpsmtpd_instance('restart' => 1); # reload plugins... $qpsmtpd->load_plugins; kill 'HUP' => keys %children; info("reload daemon requested"); }; # setup qpsmtpd_instance $qpsmtpd = qpsmtpd_instance(); if ($detach) { open STDIN, '/dev/null' or die "/dev/null: $!"; open STDOUT, '>/dev/null' or die "/dev/null: $!"; open STDERR, '>&STDOUT' or die "open(stderr): $!"; defined(my $pid = fork) or die "fork: $!"; exit 0 if $pid; } POSIX::setsid or die "setsid: $!"; if ($pid_file) { print PID $$, "\n"; close PID; } # child reaper $SIG{CHLD} = \&reaper; spawn_children(); main_loop(); exit; } # initialize children (only done at daemon startup) sub spawn_children { # block signals while new children are being spawned my $sigset = block_signal(SIGCHLD); for (1 .. $chld_pool) { new_child(); } # reset block signals unblock_signal($sigset); } # cleanup after child dies sub reaper { my $stiff; while (($stiff = waitpid(-1, &WNOHANG)) > 0) { my $res = WEXITSTATUS($?); info("child terminated, pid: $stiff (status $?, res: $res)"); delete $children{$stiff}; # delete pid from children # add pid to array so it later can be removed from shared memory push @children_term, $stiff; } $SIG{CHLD} = \&reaper; } #main_loop: main loop. Either processes children that have exited or # periodically scans the shared memory for children that are not longer # alive. Spawns new children when necessary. #arg0: void #ret0: void sub main_loop { my $created_children = $idle_children; while (1) { # if there is no child death to process, then sleep EXPR seconds # or until signal (i.e. child death) is received sleep $loop_sleep / ($created_children * 2 + 1) unless @children_term; # block CHLD signals to avoid race my $sigset = block_signal(SIGCHLD); # get number of busy children if (@children_term) { # remove dead children info from shared memory $chld_busy = shmem_opt(undef, \@children_term, undef, undef); @children_term = (); } else { # just check the shared memory $chld_busy = shmem_opt(undef, undef, undef, undef, 1); } # calculate children in pool (if valid busy children number) if (defined($chld_busy)) { info("busy children: $chld_busy"); $chld_pool = $chld_busy + $idle_children; # ensure pool limit is max_children $chld_pool = $max_children if ($chld_pool > $max_children); info( "children pool: $chld_pool, spawned: " . scalar(keys %children) . ", busy: $chld_busy"); } else { # reset shared memory warn("unable to access shared memory - resetting it"); IPC::Shareable->clean_up; my $shmem = shmem($d_port . "qpsmtpd", 1); untie $shmem; } # spawn children $created_children = $chld_pool - keys %children; $created_children = 0 if $created_children < 0; new_child() for 1 .. $created_children; # unblock signals unblock_signal($sigset); } } # block_signal: block signals # arg0..n: int with signal(s) to block # ret0: ref str with sigset (used to later unblock signal) sub block_signal { my @signal = @_; #arg0..n my ($sigset, $blockset); $sigset = POSIX::SigSet->new(); $blockset = POSIX::SigSet->new(@signal); sigprocmask(SIG_BLOCK, $blockset, $sigset) or die "Could not block @signal signals: $!\n"; return ($sigset); } # unblock_signal: unblock/reset and receive pending signals # arg0: ref str with sigset # ret0: void sub unblock_signal { my $sigset = shift; # arg0 sigprocmask(SIG_SETMASK, $sigset) or die "Could not restore signals: $!\n"; } # new_child: initialize new child # arg0: void # ret0: void sub new_child { # daemonize away from the parent process my $pid; die "Cannot fork child: $!\n" unless defined($pid = fork); if ($pid) { # in parent $children{$pid} = 1; info("new child, pid: $pid"); return; } # in child # reset priority setpriority 0, 0, getpriority(0, 0) + $re_nice; # reset signals my $sigset = POSIX::SigSet->new(); my $blockset = POSIX::SigSet->new(SIGCHLD); sigprocmask(SIG_UNBLOCK, $blockset, $sigset) or die "Could not unblock SIGCHLD signal: $!\n"; $SIG{CHLD} = $SIG{INT} = $SIG{TERM} = $SIG{ALRM} = 'DEFAULT'; # child should exit if it receives HUP signal (note: blocked while child # is busy, but restored once done) $SIG{HUP} = sub { info("signal HUP received, going to exit"); exit; }; # continue to accept connections until "old age" is reached for (my $i = 0 ; $i < $child_lifetime ; $i++) { # accept a connection if ($pretty) { $ENV{PROCESS} = $0 if not defined $ENV{PROCESS}; # 1st time only $0 = 'qpsmtpd child'; # set pretty child name in process listing } my @ready = $select->can_read(); next unless @ready; my $socket = $ready[0]; my ($client, $iinfo) = $socket->accept() or die "failed to create new object - $!"; # wait here until client connects info("connect from: " . $client->peerhost . ":" . $client->peerport); # clear a previously running instance by creating a new instance $qpsmtpd = qpsmtpd_instance(); # set STDIN/STDOUT and autoflush # ... no longer use POSIX::dup2: it failes after a few # million connections close(STDIN); open(STDIN, "+<&" . fileno($client)) or die "unable to duplicate filehandle to STDIN - $!"; close(STDOUT); open(STDOUT, "+>&" . fileno($client)) or die "unable to duplicate filehandle to STDOUT - $!"; select(STDOUT); $| = 1; # connection recieved, block signals my $sigset = block_signal(SIGHUP); # start a session if connection looks valid qpsmtpd_session($socket, $client, $iinfo, $qpsmtpd) if ($iinfo); # close connection and cleanup $client->shutdown(2); # unset block and receive pending signals unblock_signal($sigset); } exit; # this child has reached its end-of-life } # respond to client # arg0: ref to socket object (client) # arg1: int with SMTP reply code # arg2: arr with message # ret0: int 0|1 (0 = failure, 1 = success) sub respond_client { my ($client, $code, @message) = @_; $client->autoflush(1); while (my $msg = shift @message) { my $line = $code . (@message ? "-" : " ") . $msg; info("reply to client: <$line>"); print $client "$line\r\n" or (info("Could not print [$line]: $!"), return 0); } return 1; } # qpsmtpd_instance: setup qpsmtpd instance # arg0: void # ret0: ref to qpsmtpd_instance sub qpsmtpd_instance { my %args = @_; my $qpsmtpd = Qpsmtpd::TcpServer::Prefork->new(%args); $qpsmtpd->load_plugins; $qpsmtpd->spool_dir; $qpsmtpd->size_threshold; return ($qpsmtpd); } # shmem: tie to shared memory hash # arg0: str with glue # arg1: int 0|1 (0 = don't create shmem, 1 = create shmem) # ret0: ref to shared hash sub shmem { my $glue = shift; #arg0 my $create = shift || 0; #arg1 my %options = ( create => $create, exclusive => 0, mode => 0640, destroy => 0, ); my %shmem_hash; eval { tie %shmem_hash, 'IPC::Shareable', $glue, {%options} || die "unable to tie to shared memory - $!"; }; if ($@) { info("$@"); return; } return (\%shmem_hash); } # shmem_opt: connect to shared memory and perform options # arg0: ref to hash where shared memory should be copied to # arg1: ref to arr with pid(s) to delete # arg2: int with pid to add (key) # arg3: str with packed iaddr to add (value) # arg4: int 0|1 check and cleanup shared memory (0 = no, 1 = yes - default 0) # ret0: int with number of busy children (undef if error) sub shmem_opt { my $ref_shmem = shift; #arg0 my $ref_pid_del = shift; #arg1 my $pid_add_key = shift; #arg2 my $pid_add_value = shift; #arg3 my $check = shift || 0; #arg4 # check arguments if ( (defined($pid_add_key) && !defined($pid_add_value)) || (!defined($pid_add_key) && defined($pid_add_value))) { return; } my ($chld_shmem, $chld_busy); eval { $chld_shmem = &shmem($d_port . "qpsmtpd", 0); #connect to shared memory hash if (tied %{$chld_shmem}) { # lock shared memory eval { # ensure that hung shared memory is noticed local $SIG{ALRM} = sub { die "locking timed out\n"; }; alarm 15; (tied %{$chld_shmem})->shlock(LOCK_EX); alarm 0; }; die $@ if $@; # delete if ($ref_pid_del) { foreach my $pid_del (@{$ref_pid_del}) { delete $$chld_shmem{$pid_del}; } } # add $$chld_shmem{$pid_add_key} = $pid_add_value if ($pid_add_key); # copy %{$ref_shmem} = %{$chld_shmem} if ($ref_shmem); # check if ($check) { # loop through pid list and delete orphaned processes foreach my $pid (keys %{$chld_shmem}) { if (!kill 0, $pid) { delete $$chld_shmem{$pid}; warn("orphaned child, pid: $pid removed from memory"); } } } # number of busy children $chld_busy = scalar(keys %{$chld_shmem}); # unlock shared memory (tied %{$chld_shmem})->shunlock; # untie from shared memory untie $chld_shmem || die "unable to untie from shared memory"; } else { die "failed to connect to shared memory"; } }; # check for error if ($@) { undef($chld_busy); warn("$@"); } return ($chld_busy); } # info: write info # arg0: str with debug text sub info { my $text = shift; #arg0 return if (!$debug); my ($sec, $min, $hour, $mday, $mon, $year) = localtime(time); my $nowtime = sprintf "%02d/%02d/%02d %02d:%02d:%02d", $mday, $mon + 1, $year + 1900, $hour, $min, $sec; chomp($text); print STDERR "$nowtime:$$: $text\n"; } # start qpmstpd session # arg0: ref to socket object # arg1: ref to socket object # arg2: ref to qpsmtpd instance # ret0: void sub qpsmtpd_session { my $socket = shift; #arg0 my $client = shift; #arg1 my $iinfo = shift; #arg2 my $qpsmtpd = shift; #arg3 # get local/remote hostname, port and ip address my ($port, $iaddr, $lport, $laddr, $nto_iaddr, $nto_laddr) = Qpsmtpd::TcpServer::lrpip($socket, $client, $iinfo); # get current connected ip addresses (from shared memory) my %children; shmem_opt(\%children, undef, $$, $iaddr); my ($rc, @msg) = $qpsmtpd->run_hooks( "pre-connection", remote_ip => $nto_iaddr, remote_port => $port, local_ip => $nto_laddr, local_port => $lport, max_conn_ip => $maxconnip, child_addrs => [values %children], ); if ( $rc == DENYSOFT || $rc == DENYSOFT_DISCONNECT || $rc == DENY || $rc == DENY_DISCONNECT) { #smtp return code to reply client with (seed with soft deny) my $rc_reply = 451; unless ($msg[0]) { if ($rc == DENYSOFT || $rc == DENYSOFT_DISCONNECT) { @msg = ("Sorry, try again later"); } else { @msg = ("Sorry, service not available to you"); $rc_reply = 550; } } respond_client($client, $rc_reply, @msg); # remove pid from shared memory shmem_opt(undef, [$$], undef, undef); # retur so child can be reused return; } # all children should have different seeds, to prevent conflicts srand(time ^ ($$ + ($$ << 15))); # ALRM handler $SIG{ALRM} = sub { print $client "421 Connection Timed Out\n"; info("Connection Timed Out"); # child terminates exit; }; # set enviroment variables ($ENV{TCPLOCALIP}, $ENV{TCPREMOTEIP}, $ENV{TCPREMOTEHOST}) = Qpsmtpd::TcpServer::tcpenv($nto_laddr, $nto_iaddr); # run qpmsptd functions $SIG{__DIE__} = 'DEFAULT'; eval { $qpsmtpd->start_connection( local_ip => $ENV{TCPLOCALIP}, local_port => $lport, remote_ip => $ENV{TCPREMOTEIP}, remote_port => $client->peerport, ); $qpsmtpd->run($client); $qpsmtpd->run_hooks("post-connection"); $qpsmtpd->connection->reset; }; if ($@ !~ /^(disconnect_tcpserver|died while reading from STDIN)/) { warn("$@"); } # child is now idle again info("disconnect from: $nto_iaddr:$port"); # remove pid from shared memory unless (defined(shmem_opt(undef, [$$], undef, undef))) { # exit because parent is down or shared memory is corrupted info("parent seems to be down, going to exit"); exit 1; } } qpsmtpd-0.94/run.forkserver000077500000000000000000000007431240247602400160640ustar00rootroot00000000000000#!/bin/sh # QPUSER=smtpd # limit qpsmtpd to 300MB memory MAXRAM=300000000 BIN=/usr/local/bin PERL=/usr/bin/perl IP=0.0.0.0 LANG=C # See also: http://wiki.qpsmtpd.org/deploy:start exec 2>&1 \ sh -c " exec $BIN/softlimit -m $MAXRAM \ $PERL -T ./qpsmtpd-forkserver \ --listen-address $IP \ --port 25 \ --port 587 \ --limit-connections 15 \ --max-from-ip 5 \ --user $QPUSER " qpsmtpd-0.94/run.tcpserver000077500000000000000000000006501240247602400157060ustar00rootroot00000000000000#!/bin/sh # QPUSER=smtpd # limit qpsmtpd to 300MB memory MAXRAM=300000000 BIN=/usr/local/bin PERL=/usr/bin/perl IP=`head -1 config/IP` PORT=25 LANG=C QMAILDUID=`id -u $QPUSER` NOFILESGID=`id -g $QPUSER` # See also: http://wiki.qpsmtpd.org/deploy:start # exec $BIN/softlimit -m $MAXRAM \ $BIN/tcpserver -c 10 -v -R -p \ -u $QMAILDUID -g $NOFILESGID $IP $PORT \ ./qpsmtpd 2>&1 # qpsmtpd-0.94/t/000077500000000000000000000000001240247602400134025ustar00rootroot00000000000000qpsmtpd-0.94/t/Test/000077500000000000000000000000001240247602400143215ustar00rootroot00000000000000qpsmtpd-0.94/t/Test/Qpsmtpd.pm000066400000000000000000000055101240247602400163100ustar00rootroot00000000000000package Test::Qpsmtpd; use strict; use lib 't'; use lib 'lib'; use Carp qw(croak); use base qw(Qpsmtpd::SMTP); use Test::More; use Qpsmtpd::Constants; use Test::Qpsmtpd::Plugin; sub new_conn { ok(my $smtpd = __PACKAGE__->new(), "new"); ok( my $conn = $smtpd->start_connection( remote_host => 'localhost', remote_ip => '127.0.0.1' ), "start_connection" ); is(($smtpd->response)[0], "220", "greetings"); ($smtpd, $conn); } sub start_connection { my $self = shift; my %args = @_; my $remote_host = $args{remote_host} or croak "no remote_host parameter"; my $remote_info = "test\@$remote_host"; my $remote_ip = $args{remote_ip} or croak "no remote_ip parameter"; my $conn = $self->SUPER::connection->start( remote_info => $remote_info, remote_ip => $remote_ip, remote_host => $remote_host, @_ ); $self->load_plugins; my $rc = $self->start_conversation; return if $rc != DONE; $conn; } sub respond { my $self = shift; $self->{_response} = [@_]; } sub response { my $self = shift; $self->{_response} ? (@{delete $self->{_response}}) : (); } sub command { my ($self, $command) = @_; $self->input($command); $self->response; } sub input { my $self = shift; my $command = shift; my $timeout = $self->config('timeout'); alarm $timeout; $command =~ s/\r?\n$//s; # advanced chomp $self->log(LOGDEBUG, "dispatching $command"); defined $self->dispatch(split / +/, $command, 2) or $self->respond(502, "command unrecognized: '$command'"); alarm $timeout; } sub config_dir { return './t/config' if $ENV{QPSMTPD_DEVELOPER}; './config.sample'; } sub plugin_dirs { ('./plugins', './plugins/ident', './plugins/async'); } sub log { my ($self, $trace, $hook, $plugin, @log) = @_; my $level = Qpsmtpd::TRACE_LEVEL() || 5; $level = $self->init_logger unless defined $level; print("# " . join(" ", $$, @log) . "\n") if $trace <= $level; } sub varlog { shift->log(@_); } # sub run # sub disconnect sub run_plugin_tests { my $self = shift; $self->{_test_mode} = 1; my @plugins = $self->load_plugins(); # First count test number my $num_tests = 0; foreach my $plugin (@plugins) { $plugin->register_tests(); $num_tests += $plugin->total_tests(); } require Test::Builder; my $Test = Test::Builder->new(); $Test->plan(tests => $num_tests); # Now run them foreach my $plugin (@plugins) { $plugin->run_tests($self); } } 1; qpsmtpd-0.94/t/Test/Qpsmtpd/000077500000000000000000000000001240247602400157515ustar00rootroot00000000000000qpsmtpd-0.94/t/Test/Qpsmtpd/Plugin.pm000066400000000000000000000046331240247602400175530ustar00rootroot00000000000000package Test::Qpsmtpd::Plugin; 1; # Additional plugin methods used during testing package Qpsmtpd::Plugin; use strict; use warnings; use Qpsmtpd::Constants; use Test::More; sub register_tests { # Virtual base method - implement in plugin } sub register_test { my ($plugin, $test, $num_tests) = @_; $num_tests = 1 unless defined($num_tests); # print STDERR "Registering test $test ($num_tests)\n"; push @{$plugin->{_tests}}, {name => $test, num => $num_tests}; } sub total_tests { my ($plugin) = @_; my $total = 0; foreach my $t (@{$plugin->{_tests}}) { $total += $t->{num}; } return $total; } sub run_tests { my ($plugin, $qp) = @_; foreach my $t (@{$plugin->{_tests}}) { my $method = $t->{name}; print "# Running $method tests for plugin " . $plugin->plugin_name . "\n"; local $plugin->{_qp} = $qp; $plugin->$method(); } } sub validate_password { my ($self, %a) = @_; my ($pkg, $file, $line) = caller(); my $src_clear = $a{src_clear}; my $src_crypt = $a{src_crypt}; my $attempt_clear = $a{attempt_clear}; my $attempt_hash = $a{attempt_hash}; my $method = $a{method} or die "missing method"; my $ticket = $a{ticket}; my $deny = $a{deny} || DENY; if (!$src_crypt && !$src_clear) { $self->log(LOGINFO, "fail: missing password"); return ($deny, "$file - no such user"); } if (!$src_clear && $method =~ /CRAM-MD5/i) { $self->log(LOGINFO, "skip: cram-md5 not supported w/o clear pass"); return (DECLINED, $file); } if (defined $attempt_clear) { if ($src_clear && $src_clear eq $attempt_clear) { $self->log(LOGINFO, "pass: clear match"); return (OK, $file); } if ($src_crypt && $src_crypt eq crypt($attempt_clear, $src_crypt)) { $self->log(LOGINFO, "pass: crypt match"); return (OK, $file); } } if (defined $attempt_hash && $src_clear) { if (!$ticket) { $self->log(LOGERROR, "skip: missing ticket"); return (DECLINED, $file); } if ($attempt_hash eq hmac_md5_hex($ticket, $src_clear)) { $self->log(LOGINFO, "pass: hash match"); return (OK, $file); } } $self->log(LOGINFO, "fail: wrong password"); return ($deny, "$file - wrong password"); } 1; qpsmtpd-0.94/t/addresses.t000066400000000000000000000033721240247602400155510ustar00rootroot00000000000000use Test::More tests => 23; use strict; use lib 't'; use_ok('Test::Qpsmtpd'); ok(my ($smtpd, $conn) = Test::Qpsmtpd->new_conn(), "get new connection"); is(($smtpd->command('EHLO localhost'))[0], 250, 'EHLO localhost'); is(($smtpd->command('MAIL FROM:'))[0], 250, 'MAIL FROM:'); is($smtpd->transaction->sender->address, 'ask@perl.org', 'got the right sender'); is(($smtpd->command('MAIL FROM:'))[0], 250, 'MAIL FROM:'); is($smtpd->transaction->sender->address, 'ask @perl.org', 'got the right sender'); is(($smtpd->command('MAIL FROM:ask@perl.org'))[0], 250, 'MAIL FROM:ask@perl.org'); is($smtpd->transaction->sender->format, '', 'got the right sender'); is(($smtpd->command('MAIL FROM:ask@[1.2.3.4]'))[0], 250, 'MAIL FROM:ask@[1.2.3.4]'); is($smtpd->transaction->sender->format, '', 'got the right sender'); my $command = 'MAIL FROM: SIZE=1230'; is(($smtpd->command($command))[0], 250, $command); is($smtpd->transaction->sender->format, '', 'got the right sender'); $command = 'MAIL FROM:<>'; is(($smtpd->command($command))[0], 250, $command); is($smtpd->transaction->sender->format, '<>', 'got the right sender'); $command = 'MAIL FROM: SIZE=1230'; is(($smtpd->command($command))[0], 250, $command); is($smtpd->transaction->sender->format, '', 'got the right sender'); $command = 'MAIL FROM: SIZE=1230 CORRECT-WITHOUT-ARG'; is(($smtpd->command($command))[0], 250, $command); $command = 'MAIL FROM:'; is(($smtpd->command($command))[0], 250, $command); is($smtpd->transaction->sender->format, '<>', 'got the right sender'); qpsmtpd-0.94/t/auth.t000066400000000000000000000107441240247602400145360ustar00rootroot00000000000000#!/usr/bin/perl -w use strict; use warnings; use lib 't'; use lib 'lib'; use Data::Dumper; use Digest::HMAC_MD5 qw(hmac_md5_hex); use English qw/ -no_match_vars /; use File::Path; use Qpsmtpd::Constants; use Scalar::Util qw( openhandle ); use Test::More qw(no_plan); use_ok('Test::Qpsmtpd'); use_ok('Qpsmtpd::Auth'); my ($smtpd, $conn) = Test::Qpsmtpd->new_conn(); ok($smtpd, "get new connection ($smtpd)"); isa_ok($conn, 'Qpsmtpd::Connection', "get new connection"); #warn Dumper($smtpd) and exit; #my $hooks = $smtpd->hooks; #warn Dumper($hooks) and exit; my $r; my $user = 'good@example.com'; my $pass = 'good_pass'; my $enc_plain = Qpsmtpd::Auth::e64(join("\0", '', $user, $pass)); # get_auth_details_plain: plain auth method handles credentials properly my ($loginas, $ruser, $passClear) = Qpsmtpd::Auth::get_auth_details_plain($smtpd, $enc_plain); cmp_ok($user, 'eq', $user, "get_auth_details_plain, user"); cmp_ok($passClear, 'eq', $pass, "get_auth_details_plain, password"); my $bad_auth = Qpsmtpd::Auth::e64(join("\0", 'loginas', 'user@foo', 'passer')); ($loginas, $ruser, $passClear) = Qpsmtpd::Auth::get_auth_details_plain($smtpd, $bad_auth); ok(!$loginas, "get_auth_details_plain, loginas -"); ok(!$ruser, "get_auth_details_plain, user -"); ok(!$passClear, "get_auth_details_plain, pass -"); # these plugins test against whicever loaded plugin provides their selected # auth type. Right now, they end up testing against auth_flat_file. # PLAIN $r = Qpsmtpd::Auth::SASL($smtpd, 'plain', $enc_plain); cmp_ok(OK, '==', $r, "plain auth"); if ($ENV{QPSMTPD_DEVELOPER} && is_interactive()) { # same thing, but must be entered interactively print "answer: $enc_plain\n"; $r = Qpsmtpd::Auth::SASL($smtpd, 'plain', ''); cmp_ok(OK, '==', $r, "SASL, plain"); } # LOGIN if ($ENV{QPSMTPD_DEVELOPER} && is_interactive()) { my $enc_user = Qpsmtpd::Auth::e64($user); my $enc_pass = Qpsmtpd::Auth::e64($pass); # get_base64_response print "answer: $enc_user\n"; $r = Qpsmtpd::Auth::get_base64_response($smtpd, 'Username'); cmp_ok($r, 'eq', $user, "get_base64_response +"); # get_auth_details_login print "answer: $enc_pass\n"; ($ruser, $passClear) = Qpsmtpd::Auth::get_auth_details_login($smtpd, $enc_user); cmp_ok($ruser, 'eq', $user, "get_auth_details_login, user +"); cmp_ok($passClear, 'eq', $pass, "get_auth_details_login, pass +"); print "encoded pass: $enc_pass\n"; $r = Qpsmtpd::Auth::SASL($smtpd, 'login', $enc_user); cmp_ok(OK, '==', $r, "SASL, login"); } # CRAM-MD5 if ($ENV{QPSMTPD_DEVELOPER} && is_interactive()) { print "starting SASL\n"; # since we don't have bidirection communication here, we pre-generate a ticket my $ticket = sprintf('<%x.%x@%s>', rand(1000000), time(), $smtpd->config('me')); my $hash_pass = hmac_md5_hex($ticket, $pass); my $enc_answer = Qpsmtpd::Auth::e64(join(' ', $user, $hash_pass)); print "answer: $enc_answer\n"; my (@r) = Qpsmtpd::Auth::get_auth_details_cram_md5($smtpd, $ticket); cmp_ok($r[0], 'eq', $ticket, "get_auth_details_cram_md5, ticket"); cmp_ok($r[1], 'eq', $user, "get_auth_details_cram_md5, user"); cmp_ok($r[2], 'eq', $hash_pass, "get_auth_details_cram_md5, passHash"); #warn Data::Dumper::Dumper(\@r); # this isn't going to work without bidirection communication to get the ticket #$r = Qpsmtpd::Auth::SASL($smtpd, 'cram-md5' ); #cmp_ok( OK, '==', $r, "login auth"); } sub is_interactive { ## no critic # borrowed from IO::Interactive my ($out_handle) = (@_, select); # Default to default output handle # Not interactive if output is not to terminal... return if not -t $out_handle; # If *ARGV is opened, we're interactive if... if (openhandle * ARGV) { # ...it's currently opened to the magic '-' file return -t *STDIN if defined $ARGV && $ARGV eq '-'; # ...it's at end-of-file and the next file is the magic '-' file return @ARGV > 0 && $ARGV[0] eq '-' && -t *STDIN if eof *ARGV; # ...it's directly attached to the terminal return -t *ARGV; } # If *ARGV isn't opened, it will be interactive if *STDIN is attached # to a terminal and either there are no files specified on the command line # or if there are files and the first is the magic '-' file return -t *STDIN && (@ARGV == 0 || $ARGV[0] eq '-'); } __END__ if ( ref $r ) { } else { warn $r; } #print Data::Dumper::Dumper($conn); #print Data::Dumper::Dumper($smtpd); qpsmtpd-0.94/t/config.t000066400000000000000000000016401240247602400150350ustar00rootroot00000000000000#!/usr/bin/perl -w use Test::More qw(no_plan); use File::Path; use strict; use lib 't'; use_ok('Test::Qpsmtpd'); my @mes; BEGIN { # need this to happen before anything else my $cwd = `pwd`; chomp($cwd); @mes = qw{ ./config.sample/me ./t/config/me }; foreach my $f (@mes) { open my $me_config, '>', $f; print $me_config "some.host.example.org"; close $me_config; } } ok(my ($smtpd, $conn) = Test::Qpsmtpd->new_conn(), "get new connection"); is($smtpd->config('me'), 'some.host.example.org', 'config("me")'); # test for ignoring leading/trailing whitespace (relayclients has a # line with both) my $relayclients = join ",", sort $smtpd->config('relayclients'); is( $relayclients, '127.0.0.1,192.0.,2001:0DB8,2001:0DB8:0000:0000:0000:0000:0000:0001,2001:DB8::1,2001:DB8::1/32', 'config("relayclients") are trimmed' ); foreach my $f (@mes) { unlink $f if -f $f; } qpsmtpd-0.94/t/config/000077500000000000000000000000001240247602400146475ustar00rootroot00000000000000qpsmtpd-0.94/t/config/badhelo000066400000000000000000000001441240247602400161670ustar00rootroot00000000000000# these domains never uses their domain when greeting us, so reject transactions aol.com yahoo.com qpsmtpd-0.94/t/config/badrcptto000066400000000000000000000005141240247602400165540ustar00rootroot00000000000000######## entries used for testing ### bad@example.com @bad.example.com ######## Example patterns ####### # Format is pattern\s+Response # Don't forget to anchor the pattern if required ! Sorry, bang paths not accepted here @.*@ Sorry, multiple at signs not accepted here % Sorry, percent hack not accepted here qpsmtpd-0.94/t/config/dnsbl_allow000066400000000000000000000000531240247602400170700ustar00rootroot00000000000000# test entry for dnsbl plugin 192.168.99.5 qpsmtpd-0.94/t/config/dnsbl_zones000066400000000000000000000000211240247602400171030ustar00rootroot00000000000000zen.spamhaus.org qpsmtpd-0.94/t/config/flat_auth_pw000066400000000000000000000000641240247602400172470ustar00rootroot00000000000000good@example.com:good_pass bad@example.com:bad_pass qpsmtpd-0.94/t/config/invalid_resolvable_fromhost000066400000000000000000000001541240247602400223570ustar00rootroot00000000000000# include full network block including mask 127.0.0.0/8 0.0.0.0/8 224.0.0.0/4 169.254.0.0/16 10.0.0.0/8 qpsmtpd-0.94/t/config/norelayclients000066400000000000000000000002141240247602400176220ustar00rootroot00000000000000# used by plugins/relay # test entries - http://tools.ietf.org/html/rfc5737 192.0.99.5 192.0.99.6 192.0.98. # add your own entries below... qpsmtpd-0.94/t/config/plugins000066400000000000000000000044531240247602400162610ustar00rootroot00000000000000# # Example configuration file for plugins # # enable this to get configuration via http; see perldoc # plugins/http_config for details. # http_config http://localhost/~smtpd/config/ http://www.example.com/smtp.pl?config= # hosts_allow does not work with the tcpserver deployment model! # perldoc plugins/hosts_allow for an alternative. # # The hosts_allow module must be loaded if you want the -m / --max-from-ip / # my $MAXCONNIP = 5; # max simultaneous connections from one IP # settings... without this it will NOT refuse more than $MAXCONNIP connections # from one IP! hosts_allow # information plugins ident/geoip ident/p0f /tmp/.p0f_socket version 3 connection_time # enable to accept MAIL FROM:/RCPT TO: addresses without surrounding <> dont_require_anglebrackets # enable to reject MAIL FROM:/RCPT TO: parameters if client helo was HELO # (strict RFC 821)... this is not used in EHLO ... parse_addr_withhelo quit_fortune # tls should load before count_unrecognized_commands #tls earlytalker count_unrecognized_commands 4 relay resolvable_fromhost rhsbl dnsbl badmailfrom badmailfromto badrcptto helo sender_permitted_from greylisting p0f genre,windows auth/auth_checkpassword checkpw /usr/local/vpopmail/bin/vchkpw true /usr/bin/true auth/auth_vpopmail auth/auth_vpopmaild auth/auth_vpopmail_sql auth/auth_flat_file auth/authdeny # this plugin needs to run after all other "rcpt" plugins rcpt_ok headers days 5 reject_type temp require From,Date domainkeys dkim dmarc # content filters virus/klez_filter # You can run the spamassassin plugin with options. See perldoc # plugins/spamassassin for details. # spamassassin # rejects mails with a SA score higher than 20 and munges the subject # of the score is higher than 10. # # spamassassin reject_threshold 20 munge_subject_threshold 10 # dspam must run after spamassassin for the learn_from_sa feature to work dspam learn_from_sa 7 reject 1 # run the clamav virus checking plugin virus/clamav virus/clamdscan # You must enable a queue plugin - see the options in plugins/queue/ - for example: # queue to a maildir # queue/maildir /home/spamtrap/mail # queue the mail with qmail-queue queue/qmail-queue # If you need to run the same plugin multiple times, you can do # something like the following # relay # relay:0 somearg # relay:1 someotherarg qpsmtpd-0.94/t/config/public_suffix_list000066400000000000000000003064641240247602400205040ustar00rootroot00000000000000// This Source Code Form is subject to the terms of the Mozilla Public // License, v. 2.0. If a copy of the MPL was not distributed with this // file, You can obtain one at http://mozilla.org/MPL/2.0/. // ===BEGIN ICANN DOMAINS=== // ac : http://en.wikipedia.org/wiki/.ac ac com.ac edu.ac gov.ac net.ac mil.ac org.ac // ad : http://en.wikipedia.org/wiki/.ad ad nom.ad // ae : http://en.wikipedia.org/wiki/.ae // see also: "Domain Name Eligibility Policy" at http://www.aeda.ae/eng/aepolicy.php ae co.ae net.ae org.ae sch.ae ac.ae gov.ae mil.ae // aero : see http://www.information.aero/index.php?id=66 aero accident-investigation.aero accident-prevention.aero aerobatic.aero aeroclub.aero aerodrome.aero agents.aero aircraft.aero airline.aero airport.aero air-surveillance.aero airtraffic.aero air-traffic-control.aero ambulance.aero amusement.aero association.aero author.aero ballooning.aero broker.aero caa.aero cargo.aero catering.aero certification.aero championship.aero charter.aero civilaviation.aero club.aero conference.aero consultant.aero consulting.aero control.aero council.aero crew.aero design.aero dgca.aero educator.aero emergency.aero engine.aero engineer.aero entertainment.aero equipment.aero exchange.aero express.aero federation.aero flight.aero freight.aero fuel.aero gliding.aero government.aero groundhandling.aero group.aero hanggliding.aero homebuilt.aero insurance.aero journal.aero journalist.aero leasing.aero logistics.aero magazine.aero maintenance.aero marketplace.aero media.aero microlight.aero modelling.aero navigation.aero parachuting.aero paragliding.aero passenger-association.aero pilot.aero press.aero production.aero recreation.aero repbody.aero res.aero research.aero rotorcraft.aero safety.aero scientist.aero services.aero show.aero skydiving.aero software.aero student.aero taxi.aero trader.aero trading.aero trainer.aero union.aero workinggroup.aero works.aero // af : http://www.nic.af/help.jsp af gov.af com.af org.af net.af edu.af // ag : http://www.nic.ag/prices.htm ag com.ag org.ag net.ag co.ag nom.ag // ai : http://nic.com.ai/ ai off.ai com.ai net.ai org.ai // al : http://www.ert.gov.al/ert_alb/faq_det.html?Id=31 al com.al edu.al gov.al mil.al net.al org.al // am : http://en.wikipedia.org/wiki/.am am // an : http://www.una.an/an_domreg/default.asp an com.an net.an org.an edu.an // ao : http://en.wikipedia.org/wiki/.ao // http://www.dns.ao/REGISTR.DOC ao ed.ao gv.ao og.ao co.ao pb.ao it.ao // aq : http://en.wikipedia.org/wiki/.aq aq // ar : http://en.wikipedia.org/wiki/.ar *.ar !congresodelalengua3.ar !educ.ar !gobiernoelectronico.ar !mecon.ar !nacion.ar !nic.ar !promocion.ar !retina.ar !uba.ar // arpa : http://en.wikipedia.org/wiki/.arpa // Confirmed by registry 2008-06-18 e164.arpa in-addr.arpa ip6.arpa iris.arpa uri.arpa urn.arpa // as : http://en.wikipedia.org/wiki/.as as gov.as // asia : http://en.wikipedia.org/wiki/.asia asia // at : http://en.wikipedia.org/wiki/.at // Confirmed by registry 2008-06-17 at ac.at co.at gv.at or.at // au : http://en.wikipedia.org/wiki/.au // http://www.auda.org.au/ // 2LDs com.au net.au org.au edu.au gov.au asn.au id.au // Historic 2LDs (closed to new registration, but sites still exist) info.au conf.au oz.au // CGDNs - http://www.cgdn.org.au/ act.au nsw.au nt.au qld.au sa.au tas.au vic.au wa.au // 3LDs act.edu.au nsw.edu.au nt.edu.au qld.edu.au sa.edu.au tas.edu.au vic.edu.au wa.edu.au act.gov.au // Removed at request of Shae.Donelan@services.nsw.gov.au, 2010-03-04 // nsw.gov.au nt.gov.au qld.gov.au sa.gov.au tas.gov.au vic.gov.au wa.gov.au // aw : http://en.wikipedia.org/wiki/.aw aw com.aw // ax : http://en.wikipedia.org/wiki/.ax ax // az : http://en.wikipedia.org/wiki/.az az com.az net.az int.az gov.az org.az edu.az info.az pp.az mil.az name.az pro.az biz.az // ba : http://en.wikipedia.org/wiki/.ba ba org.ba net.ba edu.ba gov.ba mil.ba unsa.ba unbi.ba co.ba com.ba rs.ba // bb : http://en.wikipedia.org/wiki/.bb bb biz.bb com.bb edu.bb gov.bb info.bb net.bb org.bb store.bb // bd : http://en.wikipedia.org/wiki/.bd *.bd // be : http://en.wikipedia.org/wiki/.be // Confirmed by registry 2008-06-08 be ac.be // bf : http://en.wikipedia.org/wiki/.bf bf gov.bf // bg : http://en.wikipedia.org/wiki/.bg // https://www.register.bg/user/static/rules/en/index.html bg a.bg b.bg c.bg d.bg e.bg f.bg g.bg h.bg i.bg j.bg k.bg l.bg m.bg n.bg o.bg p.bg q.bg r.bg s.bg t.bg u.bg v.bg w.bg x.bg y.bg z.bg 0.bg 1.bg 2.bg 3.bg 4.bg 5.bg 6.bg 7.bg 8.bg 9.bg // bh : http://en.wikipedia.org/wiki/.bh bh com.bh edu.bh net.bh org.bh gov.bh // bi : http://en.wikipedia.org/wiki/.bi // http://whois.nic.bi/ bi co.bi com.bi edu.bi or.bi org.bi // biz : http://en.wikipedia.org/wiki/.biz biz // bj : http://en.wikipedia.org/wiki/.bj bj asso.bj barreau.bj gouv.bj // bm : http://www.bermudanic.bm/dnr-text.txt bm com.bm edu.bm gov.bm net.bm org.bm // bn : http://en.wikipedia.org/wiki/.bn *.bn // bo : http://www.nic.bo/ bo com.bo edu.bo gov.bo gob.bo int.bo org.bo net.bo mil.bo tv.bo // br : http://registro.br/dominio/dpn.html // Updated by registry 2011-03-01 br adm.br adv.br agr.br am.br arq.br art.br ato.br b.br bio.br blog.br bmd.br cim.br cng.br cnt.br com.br coop.br ecn.br eco.br edu.br emp.br eng.br esp.br etc.br eti.br far.br flog.br fm.br fnd.br fot.br fst.br g12.br ggf.br gov.br imb.br ind.br inf.br jor.br jus.br leg.br lel.br mat.br med.br mil.br mus.br net.br nom.br not.br ntr.br odo.br org.br ppg.br pro.br psc.br psi.br qsl.br radio.br rec.br slg.br srv.br taxi.br teo.br tmp.br trd.br tur.br tv.br vet.br vlog.br wiki.br zlg.br // bs : http://www.nic.bs/rules.html bs com.bs net.bs org.bs edu.bs gov.bs // bt : http://en.wikipedia.org/wiki/.bt bt com.bt edu.bt gov.bt net.bt org.bt // bv : No registrations at this time. // Submitted by registry 2006-06-16 // bw : http://en.wikipedia.org/wiki/.bw // http://www.gobin.info/domainname/bw.doc // list of other 2nd level tlds ? bw co.bw org.bw // by : http://en.wikipedia.org/wiki/.by // http://tld.by/rules_2006_en.html // list of other 2nd level tlds ? by gov.by mil.by // Official information does not indicate that com.by is a reserved // second-level domain, but it's being used as one (see www.google.com.by and // www.yahoo.com.by, for example), so we list it here for safety's sake. com.by // http://hoster.by/ of.by // bz : http://en.wikipedia.org/wiki/.bz // http://www.belizenic.bz/ bz com.bz net.bz org.bz edu.bz gov.bz // ca : http://en.wikipedia.org/wiki/.ca ca // ca geographical names ab.ca bc.ca mb.ca nb.ca nf.ca nl.ca ns.ca nt.ca nu.ca on.ca pe.ca qc.ca sk.ca yk.ca // gc.ca: http://en.wikipedia.org/wiki/.gc.ca // see also: http://registry.gc.ca/en/SubdomainFAQ gc.ca // cat : http://en.wikipedia.org/wiki/.cat cat // cc : http://en.wikipedia.org/wiki/.cc cc // cd : http://en.wikipedia.org/wiki/.cd // see also: https://www.nic.cd/domain/insertDomain_2.jsp?act=1 cd gov.cd // cf : http://en.wikipedia.org/wiki/.cf cf // cg : http://en.wikipedia.org/wiki/.cg cg // ch : http://en.wikipedia.org/wiki/.ch ch // ci : http://en.wikipedia.org/wiki/.ci // http://www.nic.ci/index.php?page=charte ci org.ci or.ci com.ci co.ci edu.ci ed.ci ac.ci net.ci go.ci asso.ci aéroport.ci int.ci presse.ci md.ci gouv.ci // ck : http://en.wikipedia.org/wiki/.ck *.ck !www.ck // cl : http://en.wikipedia.org/wiki/.cl cl gov.cl gob.cl co.cl mil.cl // cm : http://en.wikipedia.org/wiki/.cm cm gov.cm // cn : http://en.wikipedia.org/wiki/.cn // Submitted by registry 2008-06-11 cn ac.cn com.cn edu.cn gov.cn net.cn org.cn mil.cn 公司.cn 网络.cn 網絡.cn // cn geographic names ah.cn bj.cn cq.cn fj.cn gd.cn gs.cn gz.cn gx.cn ha.cn hb.cn he.cn hi.cn hl.cn hn.cn jl.cn js.cn jx.cn ln.cn nm.cn nx.cn qh.cn sc.cn sd.cn sh.cn sn.cn sx.cn tj.cn xj.cn xz.cn yn.cn zj.cn hk.cn mo.cn tw.cn // co : http://en.wikipedia.org/wiki/.co // Submitted by registry 2008-06-11 co arts.co com.co edu.co firm.co gov.co info.co int.co mil.co net.co nom.co org.co rec.co web.co // com : http://en.wikipedia.org/wiki/.com com // coop : http://en.wikipedia.org/wiki/.coop coop // cr : http://www.nic.cr/niccr_publico/showRegistroDominiosScreen.do cr ac.cr co.cr ed.cr fi.cr go.cr or.cr sa.cr // cu : http://en.wikipedia.org/wiki/.cu cu com.cu edu.cu org.cu net.cu gov.cu inf.cu // cv : http://en.wikipedia.org/wiki/.cv cv // cw : http://www.una.cw/cw_registry/ // Confirmed by registry 2013-03-26 cw com.cw edu.cw net.cw org.cw // cx : http://en.wikipedia.org/wiki/.cx // list of other 2nd level tlds ? cx gov.cx // cy : http://en.wikipedia.org/wiki/.cy *.cy // cz : http://en.wikipedia.org/wiki/.cz cz // de : http://en.wikipedia.org/wiki/.de // Confirmed by registry (with technical // reservations) 2008-07-01 de // dj : http://en.wikipedia.org/wiki/.dj dj // dk : http://en.wikipedia.org/wiki/.dk // Confirmed by registry 2008-06-17 dk // dm : http://en.wikipedia.org/wiki/.dm dm com.dm net.dm org.dm edu.dm gov.dm // do : http://en.wikipedia.org/wiki/.do do art.do com.do edu.do gob.do gov.do mil.do net.do org.do sld.do web.do // dz : http://en.wikipedia.org/wiki/.dz dz com.dz org.dz net.dz gov.dz edu.dz asso.dz pol.dz art.dz // ec : http://www.nic.ec/reg/paso1.asp // Submitted by registry 2008-07-04 ec com.ec info.ec net.ec fin.ec k12.ec med.ec pro.ec org.ec edu.ec gov.ec gob.ec mil.ec // edu : http://en.wikipedia.org/wiki/.edu edu // ee : http://www.eenet.ee/EENet/dom_reeglid.html#lisa_B ee edu.ee gov.ee riik.ee lib.ee med.ee com.ee pri.ee aip.ee org.ee fie.ee // eg : http://en.wikipedia.org/wiki/.eg eg com.eg edu.eg eun.eg gov.eg mil.eg name.eg net.eg org.eg sci.eg // er : http://en.wikipedia.org/wiki/.er *.er // es : https://www.nic.es/site_ingles/ingles/dominios/index.html es com.es nom.es org.es gob.es edu.es // et : http://en.wikipedia.org/wiki/.et *.et // eu : http://en.wikipedia.org/wiki/.eu eu // fi : http://en.wikipedia.org/wiki/.fi fi // aland.fi : http://en.wikipedia.org/wiki/.ax // This domain is being phased out in favor of .ax. As there are still many // domains under aland.fi, we still keep it on the list until aland.fi is // completely removed. // TODO: Check for updates (expected to be phased out around Q1/2009) aland.fi // fj : http://en.wikipedia.org/wiki/.fj *.fj // fk : http://en.wikipedia.org/wiki/.fk *.fk // fm : http://en.wikipedia.org/wiki/.fm fm // fo : http://en.wikipedia.org/wiki/.fo fo // fr : http://www.afnic.fr/ // domaines descriptifs : http://www.afnic.fr/obtenir/chartes/nommage-fr/annexe-descriptifs fr com.fr asso.fr nom.fr prd.fr presse.fr tm.fr // domaines sectoriels : http://www.afnic.fr/obtenir/chartes/nommage-fr/annexe-sectoriels aeroport.fr assedic.fr avocat.fr avoues.fr cci.fr chambagri.fr chirurgiens-dentistes.fr experts-comptables.fr geometre-expert.fr gouv.fr greta.fr huissier-justice.fr medecin.fr notaires.fr pharmacien.fr port.fr veterinaire.fr // ga : http://en.wikipedia.org/wiki/.ga ga // gb : This registry is effectively dormant // Submitted by registry 2008-06-12 // gd : http://en.wikipedia.org/wiki/.gd gd // ge : http://www.nic.net.ge/policy_en.pdf ge com.ge edu.ge gov.ge org.ge mil.ge net.ge pvt.ge // gf : http://en.wikipedia.org/wiki/.gf gf // gg : http://www.channelisles.net/applic/avextn.shtml gg co.gg org.gg net.gg sch.gg gov.gg // gh : http://en.wikipedia.org/wiki/.gh // see also: http://www.nic.gh/reg_now.php // Although domains directly at second level are not possible at the moment, // they have been possible for some time and may come back. gh com.gh edu.gh gov.gh org.gh mil.gh // gi : http://www.nic.gi/rules.html gi com.gi ltd.gi gov.gi mod.gi edu.gi org.gi // gl : http://en.wikipedia.org/wiki/.gl // http://nic.gl gl // gm : http://www.nic.gm/htmlpages%5Cgm-policy.htm gm // gn : http://psg.com/dns/gn/gn.txt // Submitted by registry 2008-06-17 ac.gn com.gn edu.gn gov.gn org.gn net.gn // gov : http://en.wikipedia.org/wiki/.gov gov // gp : http://www.nic.gp/index.php?lang=en gp com.gp net.gp mobi.gp edu.gp org.gp asso.gp // gq : http://en.wikipedia.org/wiki/.gq gq // gr : https://grweb.ics.forth.gr/english/1617-B-2005.html // Submitted by registry 2008-06-09 gr com.gr edu.gr net.gr org.gr gov.gr // gs : http://en.wikipedia.org/wiki/.gs gs // gt : http://www.gt/politicas_de_registro.html gt com.gt edu.gt gob.gt ind.gt mil.gt net.gt org.gt // gu : http://gadao.gov.gu/registration.txt *.gu // gw : http://en.wikipedia.org/wiki/.gw gw // gy : http://en.wikipedia.org/wiki/.gy // http://registry.gy/ gy co.gy com.gy net.gy // hk : https://www.hkdnr.hk // Submitted by registry 2008-06-11 hk com.hk edu.hk gov.hk idv.hk net.hk org.hk 公司.hk 教育.hk 敎育.hk 政府.hk 個人.hk 个人.hk 箇人.hk 網络.hk 网络.hk 组織.hk 網絡.hk 网絡.hk 组织.hk 組織.hk 組织.hk // hm : http://en.wikipedia.org/wiki/.hm hm // hn : http://www.nic.hn/politicas/ps02,,05.html hn com.hn edu.hn org.hn net.hn mil.hn gob.hn // hr : http://www.dns.hr/documents/pdf/HRTLD-regulations.pdf hr iz.hr from.hr name.hr com.hr // ht : http://www.nic.ht/info/charte.cfm ht com.ht shop.ht firm.ht info.ht adult.ht net.ht pro.ht org.ht med.ht art.ht coop.ht pol.ht asso.ht edu.ht rel.ht gouv.ht perso.ht // hu : http://www.domain.hu/domain/English/sld.html // Confirmed by registry 2008-06-12 hu co.hu info.hu org.hu priv.hu sport.hu tm.hu 2000.hu agrar.hu bolt.hu casino.hu city.hu erotica.hu erotika.hu film.hu forum.hu games.hu hotel.hu ingatlan.hu jogasz.hu konyvelo.hu lakas.hu media.hu news.hu reklam.hu sex.hu shop.hu suli.hu szex.hu tozsde.hu utazas.hu video.hu // id : https://register.pandi.or.id/ id ac.id biz.id co.id go.id mil.id my.id net.id or.id sch.id web.id // ie : http://en.wikipedia.org/wiki/.ie ie gov.ie // il : http://en.wikipedia.org/wiki/.il *.il // im : https://www.nic.im/pdfs/imfaqs.pdf im co.im ltd.co.im plc.co.im net.im gov.im org.im nic.im ac.im // in : http://en.wikipedia.org/wiki/.in // see also: http://www.inregistry.in/policies/ // Please note, that nic.in is not an offical eTLD, but used by most // government institutions. in co.in firm.in net.in org.in gen.in ind.in nic.in ac.in edu.in res.in gov.in mil.in // info : http://en.wikipedia.org/wiki/.info info // int : http://en.wikipedia.org/wiki/.int // Confirmed by registry 2008-06-18 int eu.int // io : http://www.nic.io/rules.html // list of other 2nd level tlds ? io com.io // iq : http://www.cmc.iq/english/iq/iqregister1.htm iq gov.iq edu.iq mil.iq com.iq org.iq net.iq // ir : http://www.nic.ir/Terms_and_Conditions_ir,_Appendix_1_Domain_Rules // Also see http://www.nic.ir/Internationalized_Domain_Names // Two .ir entries added at request of , 2010-04-16 ir ac.ir co.ir gov.ir id.ir net.ir org.ir sch.ir // xn--mgba3a4f16a.ir (.ir, Persian YEH) ایران.ir // xn--mgba3a4fra.ir (.ir, Arabic YEH) ايران.ir // is : http://www.isnic.is/domain/rules.php // Confirmed by registry 2008-12-06 is net.is com.is edu.is gov.is org.is int.is // it : http://en.wikipedia.org/wiki/.it it gov.it edu.it // list of reserved geo-names : // http://www.nic.it/documenti/regolamenti-e-linee-guida/regolamento-assegnazione-versione-6.0.pdf // (There is also a list of reserved geo-names corresponding to Italian // municipalities : http://www.nic.it/documenti/appendice-c.pdf , but it is // not included here.) agrigento.it ag.it alessandria.it al.it ancona.it an.it aosta.it aoste.it ao.it arezzo.it ar.it ascoli-piceno.it ascolipiceno.it ap.it asti.it at.it avellino.it av.it bari.it ba.it andria-barletta-trani.it andriabarlettatrani.it trani-barletta-andria.it tranibarlettaandria.it barletta-trani-andria.it barlettatraniandria.it andria-trani-barletta.it andriatranibarletta.it trani-andria-barletta.it traniandriabarletta.it bt.it belluno.it bl.it benevento.it bn.it bergamo.it bg.it biella.it bi.it bologna.it bo.it bolzano.it bozen.it balsan.it alto-adige.it altoadige.it suedtirol.it bz.it brescia.it bs.it brindisi.it br.it cagliari.it ca.it caltanissetta.it cl.it campobasso.it cb.it carboniaiglesias.it carbonia-iglesias.it iglesias-carbonia.it iglesiascarbonia.it ci.it caserta.it ce.it catania.it ct.it catanzaro.it cz.it chieti.it ch.it como.it co.it cosenza.it cs.it cremona.it cr.it crotone.it kr.it cuneo.it cn.it dell-ogliastra.it dellogliastra.it ogliastra.it og.it enna.it en.it ferrara.it fe.it fermo.it fm.it firenze.it florence.it fi.it foggia.it fg.it forli-cesena.it forlicesena.it cesena-forli.it cesenaforli.it fc.it frosinone.it fr.it genova.it genoa.it ge.it gorizia.it go.it grosseto.it gr.it imperia.it im.it isernia.it is.it laquila.it aquila.it aq.it la-spezia.it laspezia.it sp.it latina.it lt.it lecce.it le.it lecco.it lc.it livorno.it li.it lodi.it lo.it lucca.it lu.it macerata.it mc.it mantova.it mn.it massa-carrara.it massacarrara.it carrara-massa.it carraramassa.it ms.it matera.it mt.it medio-campidano.it mediocampidano.it campidano-medio.it campidanomedio.it vs.it messina.it me.it milano.it milan.it mi.it modena.it mo.it monza.it monza-brianza.it monzabrianza.it monzaebrianza.it monzaedellabrianza.it monza-e-della-brianza.it mb.it napoli.it naples.it na.it novara.it no.it nuoro.it nu.it oristano.it or.it padova.it padua.it pd.it palermo.it pa.it parma.it pr.it pavia.it pv.it perugia.it pg.it pescara.it pe.it pesaro-urbino.it pesarourbino.it urbino-pesaro.it urbinopesaro.it pu.it piacenza.it pc.it pisa.it pi.it pistoia.it pt.it pordenone.it pn.it potenza.it pz.it prato.it po.it ragusa.it rg.it ravenna.it ra.it reggio-calabria.it reggiocalabria.it rc.it reggio-emilia.it reggioemilia.it re.it rieti.it ri.it rimini.it rn.it roma.it rome.it rm.it rovigo.it ro.it salerno.it sa.it sassari.it ss.it savona.it sv.it siena.it si.it siracusa.it sr.it sondrio.it so.it taranto.it ta.it tempio-olbia.it tempioolbia.it olbia-tempio.it olbiatempio.it ot.it teramo.it te.it terni.it tr.it torino.it turin.it to.it trapani.it tp.it trento.it trentino.it tn.it treviso.it tv.it trieste.it ts.it udine.it ud.it varese.it va.it venezia.it venice.it ve.it verbania.it vb.it vercelli.it vc.it verona.it vr.it vibo-valentia.it vibovalentia.it vv.it vicenza.it vi.it viterbo.it vt.it // je : http://www.channelisles.net/applic/avextn.shtml je co.je org.je net.je sch.je gov.je // jm : http://www.com.jm/register.html *.jm // jo : http://www.dns.jo/Registration_policy.aspx jo com.jo org.jo net.jo edu.jo sch.jo gov.jo mil.jo name.jo // jobs : http://en.wikipedia.org/wiki/.jobs jobs // jp : http://en.wikipedia.org/wiki/.jp // http://jprs.co.jp/en/jpdomain.html // Updated by registry 2012-05-28 jp // jp organizational type names ac.jp ad.jp co.jp ed.jp go.jp gr.jp lg.jp ne.jp or.jp // jp preficture type names aichi.jp akita.jp aomori.jp chiba.jp ehime.jp fukui.jp fukuoka.jp fukushima.jp gifu.jp gunma.jp hiroshima.jp hokkaido.jp hyogo.jp ibaraki.jp ishikawa.jp iwate.jp kagawa.jp kagoshima.jp kanagawa.jp kochi.jp kumamoto.jp kyoto.jp mie.jp miyagi.jp miyazaki.jp nagano.jp nagasaki.jp nara.jp niigata.jp oita.jp okayama.jp okinawa.jp osaka.jp saga.jp saitama.jp shiga.jp shimane.jp shizuoka.jp tochigi.jp tokushima.jp tokyo.jp tottori.jp toyama.jp wakayama.jp yamagata.jp yamaguchi.jp yamanashi.jp // jp geographic type names // http://jprs.jp/doc/rule/saisoku-1.html *.kawasaki.jp *.kitakyushu.jp *.kobe.jp *.nagoya.jp *.sapporo.jp *.sendai.jp *.yokohama.jp !city.kawasaki.jp !city.kitakyushu.jp !city.kobe.jp !city.nagoya.jp !city.sapporo.jp !city.sendai.jp !city.yokohama.jp // 4th level registration aisai.aichi.jp ama.aichi.jp anjo.aichi.jp asuke.aichi.jp chiryu.aichi.jp chita.aichi.jp fuso.aichi.jp gamagori.aichi.jp handa.aichi.jp hazu.aichi.jp hekinan.aichi.jp higashiura.aichi.jp ichinomiya.aichi.jp inazawa.aichi.jp inuyama.aichi.jp isshiki.aichi.jp iwakura.aichi.jp kanie.aichi.jp kariya.aichi.jp kasugai.aichi.jp kira.aichi.jp kiyosu.aichi.jp komaki.aichi.jp konan.aichi.jp kota.aichi.jp mihama.aichi.jp miyoshi.aichi.jp nagakute.aichi.jp nishio.aichi.jp nisshin.aichi.jp obu.aichi.jp oguchi.aichi.jp oharu.aichi.jp okazaki.aichi.jp owariasahi.aichi.jp seto.aichi.jp shikatsu.aichi.jp shinshiro.aichi.jp shitara.aichi.jp tahara.aichi.jp takahama.aichi.jp tobishima.aichi.jp toei.aichi.jp togo.aichi.jp tokai.aichi.jp tokoname.aichi.jp toyoake.aichi.jp toyohashi.aichi.jp toyokawa.aichi.jp toyone.aichi.jp toyota.aichi.jp tsushima.aichi.jp yatomi.aichi.jp akita.akita.jp daisen.akita.jp fujisato.akita.jp gojome.akita.jp hachirogata.akita.jp happou.akita.jp higashinaruse.akita.jp honjo.akita.jp honjyo.akita.jp ikawa.akita.jp kamikoani.akita.jp kamioka.akita.jp katagami.akita.jp kazuno.akita.jp kitaakita.akita.jp kosaka.akita.jp kyowa.akita.jp misato.akita.jp mitane.akita.jp moriyoshi.akita.jp nikaho.akita.jp noshiro.akita.jp odate.akita.jp oga.akita.jp ogata.akita.jp semboku.akita.jp yokote.akita.jp yurihonjo.akita.jp aomori.aomori.jp gonohe.aomori.jp hachinohe.aomori.jp hashikami.aomori.jp hiranai.aomori.jp hirosaki.aomori.jp itayanagi.aomori.jp kuroishi.aomori.jp misawa.aomori.jp mutsu.aomori.jp nakadomari.aomori.jp noheji.aomori.jp oirase.aomori.jp owani.aomori.jp rokunohe.aomori.jp sannohe.aomori.jp shichinohe.aomori.jp shingo.aomori.jp takko.aomori.jp towada.aomori.jp tsugaru.aomori.jp tsuruta.aomori.jp abiko.chiba.jp asahi.chiba.jp chonan.chiba.jp chosei.chiba.jp choshi.chiba.jp chuo.chiba.jp funabashi.chiba.jp futtsu.chiba.jp hanamigawa.chiba.jp ichihara.chiba.jp ichikawa.chiba.jp ichinomiya.chiba.jp inzai.chiba.jp isumi.chiba.jp kamagaya.chiba.jp kamogawa.chiba.jp kashiwa.chiba.jp katori.chiba.jp katsuura.chiba.jp kimitsu.chiba.jp kisarazu.chiba.jp kozaki.chiba.jp kujukuri.chiba.jp kyonan.chiba.jp matsudo.chiba.jp midori.chiba.jp mihama.chiba.jp minamiboso.chiba.jp mobara.chiba.jp mutsuzawa.chiba.jp nagara.chiba.jp nagareyama.chiba.jp narashino.chiba.jp narita.chiba.jp noda.chiba.jp oamishirasato.chiba.jp omigawa.chiba.jp onjuku.chiba.jp otaki.chiba.jp sakae.chiba.jp sakura.chiba.jp shimofusa.chiba.jp shirako.chiba.jp shiroi.chiba.jp shisui.chiba.jp sodegaura.chiba.jp sosa.chiba.jp tako.chiba.jp tateyama.chiba.jp togane.chiba.jp tohnosho.chiba.jp tomisato.chiba.jp urayasu.chiba.jp yachimata.chiba.jp yachiyo.chiba.jp yokaichiba.chiba.jp yokoshibahikari.chiba.jp yotsukaido.chiba.jp ainan.ehime.jp honai.ehime.jp ikata.ehime.jp imabari.ehime.jp iyo.ehime.jp kamijima.ehime.jp kihoku.ehime.jp kumakogen.ehime.jp masaki.ehime.jp matsuno.ehime.jp matsuyama.ehime.jp namikata.ehime.jp niihama.ehime.jp ozu.ehime.jp saijo.ehime.jp seiyo.ehime.jp shikokuchuo.ehime.jp tobe.ehime.jp toon.ehime.jp uchiko.ehime.jp uwajima.ehime.jp yawatahama.ehime.jp echizen.fukui.jp eiheiji.fukui.jp fukui.fukui.jp ikeda.fukui.jp katsuyama.fukui.jp mihama.fukui.jp minamiechizen.fukui.jp obama.fukui.jp ohi.fukui.jp ono.fukui.jp sabae.fukui.jp sakai.fukui.jp takahama.fukui.jp tsuruga.fukui.jp wakasa.fukui.jp ashiya.fukuoka.jp buzen.fukuoka.jp chikugo.fukuoka.jp chikuho.fukuoka.jp chikujo.fukuoka.jp chikushino.fukuoka.jp chikuzen.fukuoka.jp chuo.fukuoka.jp dazaifu.fukuoka.jp fukuchi.fukuoka.jp hakata.fukuoka.jp higashi.fukuoka.jp hirokawa.fukuoka.jp hisayama.fukuoka.jp iizuka.fukuoka.jp inatsuki.fukuoka.jp kaho.fukuoka.jp kasuga.fukuoka.jp kasuya.fukuoka.jp kawara.fukuoka.jp keisen.fukuoka.jp koga.fukuoka.jp kurate.fukuoka.jp kurogi.fukuoka.jp kurume.fukuoka.jp minami.fukuoka.jp miyako.fukuoka.jp miyama.fukuoka.jp miyawaka.fukuoka.jp mizumaki.fukuoka.jp munakata.fukuoka.jp nakagawa.fukuoka.jp nakama.fukuoka.jp nishi.fukuoka.jp nogata.fukuoka.jp ogori.fukuoka.jp okagaki.fukuoka.jp okawa.fukuoka.jp oki.fukuoka.jp omuta.fukuoka.jp onga.fukuoka.jp onojo.fukuoka.jp oto.fukuoka.jp saigawa.fukuoka.jp sasaguri.fukuoka.jp shingu.fukuoka.jp shinyoshitomi.fukuoka.jp shonai.fukuoka.jp soeda.fukuoka.jp sue.fukuoka.jp tachiarai.fukuoka.jp tagawa.fukuoka.jp takata.fukuoka.jp toho.fukuoka.jp toyotsu.fukuoka.jp tsuiki.fukuoka.jp ukiha.fukuoka.jp umi.fukuoka.jp usui.fukuoka.jp yamada.fukuoka.jp yame.fukuoka.jp yanagawa.fukuoka.jp yukuhashi.fukuoka.jp aizubange.fukushima.jp aizumisato.fukushima.jp aizuwakamatsu.fukushima.jp asakawa.fukushima.jp bandai.fukushima.jp date.fukushima.jp fukushima.fukushima.jp furudono.fukushima.jp futaba.fukushima.jp hanawa.fukushima.jp higashi.fukushima.jp hirata.fukushima.jp hirono.fukushima.jp iitate.fukushima.jp inawashiro.fukushima.jp ishikawa.fukushima.jp iwaki.fukushima.jp izumizaki.fukushima.jp kagamiishi.fukushima.jp kaneyama.fukushima.jp kawamata.fukushima.jp kitakata.fukushima.jp kitashiobara.fukushima.jp koori.fukushima.jp koriyama.fukushima.jp kunimi.fukushima.jp miharu.fukushima.jp mishima.fukushima.jp namie.fukushima.jp nango.fukushima.jp nishiaizu.fukushima.jp nishigo.fukushima.jp okuma.fukushima.jp omotego.fukushima.jp ono.fukushima.jp otama.fukushima.jp samegawa.fukushima.jp shimogo.fukushima.jp shirakawa.fukushima.jp showa.fukushima.jp soma.fukushima.jp sukagawa.fukushima.jp taishin.fukushima.jp tamakawa.fukushima.jp tanagura.fukushima.jp tenei.fukushima.jp yabuki.fukushima.jp yamato.fukushima.jp yamatsuri.fukushima.jp yanaizu.fukushima.jp yugawa.fukushima.jp anpachi.gifu.jp ena.gifu.jp gifu.gifu.jp ginan.gifu.jp godo.gifu.jp gujo.gifu.jp hashima.gifu.jp hichiso.gifu.jp hida.gifu.jp higashishirakawa.gifu.jp ibigawa.gifu.jp ikeda.gifu.jp kakamigahara.gifu.jp kani.gifu.jp kasahara.gifu.jp kasamatsu.gifu.jp kawaue.gifu.jp kitagata.gifu.jp mino.gifu.jp minokamo.gifu.jp mitake.gifu.jp mizunami.gifu.jp motosu.gifu.jp nakatsugawa.gifu.jp ogaki.gifu.jp sakahogi.gifu.jp seki.gifu.jp sekigahara.gifu.jp shirakawa.gifu.jp tajimi.gifu.jp takayama.gifu.jp tarui.gifu.jp toki.gifu.jp tomika.gifu.jp wanouchi.gifu.jp yamagata.gifu.jp yaotsu.gifu.jp yoro.gifu.jp annaka.gunma.jp chiyoda.gunma.jp fujioka.gunma.jp higashiagatsuma.gunma.jp isesaki.gunma.jp itakura.gunma.jp kanna.gunma.jp kanra.gunma.jp katashina.gunma.jp kawaba.gunma.jp kiryu.gunma.jp kusatsu.gunma.jp maebashi.gunma.jp meiwa.gunma.jp midori.gunma.jp minakami.gunma.jp naganohara.gunma.jp nakanojo.gunma.jp nanmoku.gunma.jp numata.gunma.jp oizumi.gunma.jp ora.gunma.jp ota.gunma.jp shibukawa.gunma.jp shimonita.gunma.jp shinto.gunma.jp showa.gunma.jp takasaki.gunma.jp takayama.gunma.jp tamamura.gunma.jp tatebayashi.gunma.jp tomioka.gunma.jp tsukiyono.gunma.jp tsumagoi.gunma.jp ueno.gunma.jp yoshioka.gunma.jp asaminami.hiroshima.jp daiwa.hiroshima.jp etajima.hiroshima.jp fuchu.hiroshima.jp fukuyama.hiroshima.jp hatsukaichi.hiroshima.jp higashihiroshima.hiroshima.jp hongo.hiroshima.jp jinsekikogen.hiroshima.jp kaita.hiroshima.jp kui.hiroshima.jp kumano.hiroshima.jp kure.hiroshima.jp mihara.hiroshima.jp miyoshi.hiroshima.jp naka.hiroshima.jp onomichi.hiroshima.jp osakikamijima.hiroshima.jp otake.hiroshima.jp saka.hiroshima.jp sera.hiroshima.jp seranishi.hiroshima.jp shinichi.hiroshima.jp shobara.hiroshima.jp takehara.hiroshima.jp abashiri.hokkaido.jp abira.hokkaido.jp aibetsu.hokkaido.jp akabira.hokkaido.jp akkeshi.hokkaido.jp asahikawa.hokkaido.jp ashibetsu.hokkaido.jp ashoro.hokkaido.jp assabu.hokkaido.jp atsuma.hokkaido.jp bibai.hokkaido.jp biei.hokkaido.jp bifuka.hokkaido.jp bihoro.hokkaido.jp biratori.hokkaido.jp chippubetsu.hokkaido.jp chitose.hokkaido.jp date.hokkaido.jp ebetsu.hokkaido.jp embetsu.hokkaido.jp eniwa.hokkaido.jp erimo.hokkaido.jp esan.hokkaido.jp esashi.hokkaido.jp fukagawa.hokkaido.jp fukushima.hokkaido.jp furano.hokkaido.jp furubira.hokkaido.jp haboro.hokkaido.jp hakodate.hokkaido.jp hamatonbetsu.hokkaido.jp hidaka.hokkaido.jp higashikagura.hokkaido.jp higashikawa.hokkaido.jp hiroo.hokkaido.jp hokuryu.hokkaido.jp hokuto.hokkaido.jp honbetsu.hokkaido.jp horokanai.hokkaido.jp horonobe.hokkaido.jp ikeda.hokkaido.jp imakane.hokkaido.jp ishikari.hokkaido.jp iwamizawa.hokkaido.jp iwanai.hokkaido.jp kamifurano.hokkaido.jp kamikawa.hokkaido.jp kamishihoro.hokkaido.jp kamisunagawa.hokkaido.jp kamoenai.hokkaido.jp kayabe.hokkaido.jp kembuchi.hokkaido.jp kikonai.hokkaido.jp kimobetsu.hokkaido.jp kitahiroshima.hokkaido.jp kitami.hokkaido.jp kiyosato.hokkaido.jp koshimizu.hokkaido.jp kunneppu.hokkaido.jp kuriyama.hokkaido.jp kuromatsunai.hokkaido.jp kushiro.hokkaido.jp kutchan.hokkaido.jp kyowa.hokkaido.jp mashike.hokkaido.jp matsumae.hokkaido.jp mikasa.hokkaido.jp minamifurano.hokkaido.jp mombetsu.hokkaido.jp moseushi.hokkaido.jp mukawa.hokkaido.jp muroran.hokkaido.jp naie.hokkaido.jp nakagawa.hokkaido.jp nakasatsunai.hokkaido.jp nakatombetsu.hokkaido.jp nanae.hokkaido.jp nanporo.hokkaido.jp nayoro.hokkaido.jp nemuro.hokkaido.jp niikappu.hokkaido.jp niki.hokkaido.jp nishiokoppe.hokkaido.jp noboribetsu.hokkaido.jp numata.hokkaido.jp obihiro.hokkaido.jp obira.hokkaido.jp oketo.hokkaido.jp okoppe.hokkaido.jp otaru.hokkaido.jp otobe.hokkaido.jp otofuke.hokkaido.jp otoineppu.hokkaido.jp oumu.hokkaido.jp ozora.hokkaido.jp pippu.hokkaido.jp rankoshi.hokkaido.jp rebun.hokkaido.jp rikubetsu.hokkaido.jp rishiri.hokkaido.jp rishirifuji.hokkaido.jp saroma.hokkaido.jp sarufutsu.hokkaido.jp shakotan.hokkaido.jp shari.hokkaido.jp shibecha.hokkaido.jp shibetsu.hokkaido.jp shikabe.hokkaido.jp shikaoi.hokkaido.jp shimamaki.hokkaido.jp shimizu.hokkaido.jp shimokawa.hokkaido.jp shinshinotsu.hokkaido.jp shintoku.hokkaido.jp shiranuka.hokkaido.jp shiraoi.hokkaido.jp shiriuchi.hokkaido.jp sobetsu.hokkaido.jp sunagawa.hokkaido.jp taiki.hokkaido.jp takasu.hokkaido.jp takikawa.hokkaido.jp takinoue.hokkaido.jp teshikaga.hokkaido.jp tobetsu.hokkaido.jp tohma.hokkaido.jp tomakomai.hokkaido.jp tomari.hokkaido.jp toya.hokkaido.jp toyako.hokkaido.jp toyotomi.hokkaido.jp toyoura.hokkaido.jp tsubetsu.hokkaido.jp tsukigata.hokkaido.jp urakawa.hokkaido.jp urausu.hokkaido.jp uryu.hokkaido.jp utashinai.hokkaido.jp wakkanai.hokkaido.jp wassamu.hokkaido.jp yakumo.hokkaido.jp yoichi.hokkaido.jp aioi.hyogo.jp akashi.hyogo.jp ako.hyogo.jp amagasaki.hyogo.jp aogaki.hyogo.jp asago.hyogo.jp ashiya.hyogo.jp awaji.hyogo.jp fukusaki.hyogo.jp goshiki.hyogo.jp harima.hyogo.jp himeji.hyogo.jp ichikawa.hyogo.jp inagawa.hyogo.jp itami.hyogo.jp kakogawa.hyogo.jp kamigori.hyogo.jp kamikawa.hyogo.jp kasai.hyogo.jp kasuga.hyogo.jp kawanishi.hyogo.jp miki.hyogo.jp minamiawaji.hyogo.jp nishinomiya.hyogo.jp nishiwaki.hyogo.jp ono.hyogo.jp sanda.hyogo.jp sannan.hyogo.jp sasayama.hyogo.jp sayo.hyogo.jp shingu.hyogo.jp shinonsen.hyogo.jp shiso.hyogo.jp sumoto.hyogo.jp taishi.hyogo.jp taka.hyogo.jp takarazuka.hyogo.jp takasago.hyogo.jp takino.hyogo.jp tamba.hyogo.jp tatsuno.hyogo.jp toyooka.hyogo.jp yabu.hyogo.jp yashiro.hyogo.jp yoka.hyogo.jp yokawa.hyogo.jp ami.ibaraki.jp asahi.ibaraki.jp bando.ibaraki.jp chikusei.ibaraki.jp daigo.ibaraki.jp fujishiro.ibaraki.jp hitachi.ibaraki.jp hitachinaka.ibaraki.jp hitachiomiya.ibaraki.jp hitachiota.ibaraki.jp ibaraki.ibaraki.jp ina.ibaraki.jp inashiki.ibaraki.jp itako.ibaraki.jp iwama.ibaraki.jp joso.ibaraki.jp kamisu.ibaraki.jp kasama.ibaraki.jp kashima.ibaraki.jp kasumigaura.ibaraki.jp koga.ibaraki.jp miho.ibaraki.jp mito.ibaraki.jp moriya.ibaraki.jp naka.ibaraki.jp namegata.ibaraki.jp oarai.ibaraki.jp ogawa.ibaraki.jp omitama.ibaraki.jp ryugasaki.ibaraki.jp sakai.ibaraki.jp sakuragawa.ibaraki.jp shimodate.ibaraki.jp shimotsuma.ibaraki.jp shirosato.ibaraki.jp sowa.ibaraki.jp suifu.ibaraki.jp takahagi.ibaraki.jp tamatsukuri.ibaraki.jp tokai.ibaraki.jp tomobe.ibaraki.jp tone.ibaraki.jp toride.ibaraki.jp tsuchiura.ibaraki.jp tsukuba.ibaraki.jp uchihara.ibaraki.jp ushiku.ibaraki.jp yachiyo.ibaraki.jp yamagata.ibaraki.jp yawara.ibaraki.jp yuki.ibaraki.jp anamizu.ishikawa.jp hakui.ishikawa.jp hakusan.ishikawa.jp kaga.ishikawa.jp kahoku.ishikawa.jp kanazawa.ishikawa.jp kawakita.ishikawa.jp komatsu.ishikawa.jp nakanoto.ishikawa.jp nanao.ishikawa.jp nomi.ishikawa.jp nonoichi.ishikawa.jp noto.ishikawa.jp shika.ishikawa.jp suzu.ishikawa.jp tsubata.ishikawa.jp tsurugi.ishikawa.jp uchinada.ishikawa.jp wajima.ishikawa.jp fudai.iwate.jp fujisawa.iwate.jp hanamaki.iwate.jp hiraizumi.iwate.jp hirono.iwate.jp ichinohe.iwate.jp ichinoseki.iwate.jp iwaizumi.iwate.jp iwate.iwate.jp joboji.iwate.jp kamaishi.iwate.jp kanegasaki.iwate.jp karumai.iwate.jp kawai.iwate.jp kitakami.iwate.jp kuji.iwate.jp kunohe.iwate.jp kuzumaki.iwate.jp miyako.iwate.jp mizusawa.iwate.jp morioka.iwate.jp ninohe.iwate.jp noda.iwate.jp ofunato.iwate.jp oshu.iwate.jp otsuchi.iwate.jp rikuzentakata.iwate.jp shiwa.iwate.jp shizukuishi.iwate.jp sumita.iwate.jp takizawa.iwate.jp tanohata.iwate.jp tono.iwate.jp yahaba.iwate.jp yamada.iwate.jp ayagawa.kagawa.jp higashikagawa.kagawa.jp kanonji.kagawa.jp kotohira.kagawa.jp manno.kagawa.jp marugame.kagawa.jp mitoyo.kagawa.jp naoshima.kagawa.jp sanuki.kagawa.jp tadotsu.kagawa.jp takamatsu.kagawa.jp tonosho.kagawa.jp uchinomi.kagawa.jp utazu.kagawa.jp zentsuji.kagawa.jp akune.kagoshima.jp amami.kagoshima.jp hioki.kagoshima.jp isa.kagoshima.jp isen.kagoshima.jp izumi.kagoshima.jp kagoshima.kagoshima.jp kanoya.kagoshima.jp kawanabe.kagoshima.jp kinko.kagoshima.jp kouyama.kagoshima.jp makurazaki.kagoshima.jp matsumoto.kagoshima.jp minamitane.kagoshima.jp nakatane.kagoshima.jp nishinoomote.kagoshima.jp satsumasendai.kagoshima.jp soo.kagoshima.jp tarumizu.kagoshima.jp yusui.kagoshima.jp aikawa.kanagawa.jp atsugi.kanagawa.jp ayase.kanagawa.jp chigasaki.kanagawa.jp ebina.kanagawa.jp fujisawa.kanagawa.jp hadano.kanagawa.jp hakone.kanagawa.jp hiratsuka.kanagawa.jp isehara.kanagawa.jp kaisei.kanagawa.jp kamakura.kanagawa.jp kiyokawa.kanagawa.jp matsuda.kanagawa.jp minamiashigara.kanagawa.jp miura.kanagawa.jp nakai.kanagawa.jp ninomiya.kanagawa.jp odawara.kanagawa.jp oi.kanagawa.jp oiso.kanagawa.jp sagamihara.kanagawa.jp samukawa.kanagawa.jp tsukui.kanagawa.jp yamakita.kanagawa.jp yamato.kanagawa.jp yokosuka.kanagawa.jp yugawara.kanagawa.jp zama.kanagawa.jp zushi.kanagawa.jp aki.kochi.jp geisei.kochi.jp hidaka.kochi.jp higashitsuno.kochi.jp ino.kochi.jp kagami.kochi.jp kami.kochi.jp kitagawa.kochi.jp kochi.kochi.jp mihara.kochi.jp motoyama.kochi.jp muroto.kochi.jp nahari.kochi.jp nakamura.kochi.jp nankoku.kochi.jp nishitosa.kochi.jp niyodogawa.kochi.jp ochi.kochi.jp okawa.kochi.jp otoyo.kochi.jp otsuki.kochi.jp sakawa.kochi.jp sukumo.kochi.jp susaki.kochi.jp tosa.kochi.jp tosashimizu.kochi.jp toyo.kochi.jp tsuno.kochi.jp umaji.kochi.jp yasuda.kochi.jp yusuhara.kochi.jp amakusa.kumamoto.jp arao.kumamoto.jp aso.kumamoto.jp choyo.kumamoto.jp gyokuto.kumamoto.jp hitoyoshi.kumamoto.jp kamiamakusa.kumamoto.jp kashima.kumamoto.jp kikuchi.kumamoto.jp kosa.kumamoto.jp kumamoto.kumamoto.jp mashiki.kumamoto.jp mifune.kumamoto.jp minamata.kumamoto.jp minamioguni.kumamoto.jp nagasu.kumamoto.jp nishihara.kumamoto.jp oguni.kumamoto.jp ozu.kumamoto.jp sumoto.kumamoto.jp takamori.kumamoto.jp uki.kumamoto.jp uto.kumamoto.jp yamaga.kumamoto.jp yamato.kumamoto.jp yatsushiro.kumamoto.jp ayabe.kyoto.jp fukuchiyama.kyoto.jp higashiyama.kyoto.jp ide.kyoto.jp ine.kyoto.jp joyo.kyoto.jp kameoka.kyoto.jp kamo.kyoto.jp kita.kyoto.jp kizu.kyoto.jp kumiyama.kyoto.jp kyotamba.kyoto.jp kyotanabe.kyoto.jp kyotango.kyoto.jp maizuru.kyoto.jp minami.kyoto.jp minamiyamashiro.kyoto.jp miyazu.kyoto.jp muko.kyoto.jp nagaokakyo.kyoto.jp nakagyo.kyoto.jp nantan.kyoto.jp oyamazaki.kyoto.jp sakyo.kyoto.jp seika.kyoto.jp tanabe.kyoto.jp uji.kyoto.jp ujitawara.kyoto.jp wazuka.kyoto.jp yamashina.kyoto.jp yawata.kyoto.jp asahi.mie.jp inabe.mie.jp ise.mie.jp kameyama.mie.jp kawagoe.mie.jp kiho.mie.jp kisosaki.mie.jp kiwa.mie.jp komono.mie.jp kumano.mie.jp kuwana.mie.jp matsusaka.mie.jp meiwa.mie.jp mihama.mie.jp minamiise.mie.jp misugi.mie.jp miyama.mie.jp nabari.mie.jp shima.mie.jp suzuka.mie.jp tado.mie.jp taiki.mie.jp taki.mie.jp tamaki.mie.jp toba.mie.jp tsu.mie.jp udono.mie.jp ureshino.mie.jp watarai.mie.jp yokkaichi.mie.jp furukawa.miyagi.jp higashimatsushima.miyagi.jp ishinomaki.miyagi.jp iwanuma.miyagi.jp kakuda.miyagi.jp kami.miyagi.jp kawasaki.miyagi.jp kesennuma.miyagi.jp marumori.miyagi.jp matsushima.miyagi.jp minamisanriku.miyagi.jp misato.miyagi.jp murata.miyagi.jp natori.miyagi.jp ogawara.miyagi.jp ohira.miyagi.jp onagawa.miyagi.jp osaki.miyagi.jp rifu.miyagi.jp semine.miyagi.jp shibata.miyagi.jp shichikashuku.miyagi.jp shikama.miyagi.jp shiogama.miyagi.jp shiroishi.miyagi.jp tagajo.miyagi.jp taiwa.miyagi.jp tome.miyagi.jp tomiya.miyagi.jp wakuya.miyagi.jp watari.miyagi.jp yamamoto.miyagi.jp zao.miyagi.jp aya.miyazaki.jp ebino.miyazaki.jp gokase.miyazaki.jp hyuga.miyazaki.jp kadogawa.miyazaki.jp kawaminami.miyazaki.jp kijo.miyazaki.jp kitagawa.miyazaki.jp kitakata.miyazaki.jp kitaura.miyazaki.jp kobayashi.miyazaki.jp kunitomi.miyazaki.jp kushima.miyazaki.jp mimata.miyazaki.jp miyakonojo.miyazaki.jp miyazaki.miyazaki.jp morotsuka.miyazaki.jp nichinan.miyazaki.jp nishimera.miyazaki.jp nobeoka.miyazaki.jp saito.miyazaki.jp shiiba.miyazaki.jp shintomi.miyazaki.jp takaharu.miyazaki.jp takanabe.miyazaki.jp takazaki.miyazaki.jp tsuno.miyazaki.jp achi.nagano.jp agematsu.nagano.jp anan.nagano.jp aoki.nagano.jp asahi.nagano.jp azumino.nagano.jp chikuhoku.nagano.jp chikuma.nagano.jp chino.nagano.jp fujimi.nagano.jp hakuba.nagano.jp hara.nagano.jp hiraya.nagano.jp iida.nagano.jp iijima.nagano.jp iiyama.nagano.jp iizuna.nagano.jp ikeda.nagano.jp ikusaka.nagano.jp ina.nagano.jp karuizawa.nagano.jp kawakami.nagano.jp kiso.nagano.jp kisofukushima.nagano.jp kitaaiki.nagano.jp komagane.nagano.jp komoro.nagano.jp matsukawa.nagano.jp matsumoto.nagano.jp miasa.nagano.jp minamiaiki.nagano.jp minamimaki.nagano.jp minamiminowa.nagano.jp minowa.nagano.jp miyada.nagano.jp miyota.nagano.jp mochizuki.nagano.jp nagano.nagano.jp nagawa.nagano.jp nagiso.nagano.jp nakagawa.nagano.jp nakano.nagano.jp nozawaonsen.nagano.jp obuse.nagano.jp ogawa.nagano.jp okaya.nagano.jp omachi.nagano.jp omi.nagano.jp ookuwa.nagano.jp ooshika.nagano.jp otaki.nagano.jp otari.nagano.jp sakae.nagano.jp sakaki.nagano.jp saku.nagano.jp sakuho.nagano.jp shimosuwa.nagano.jp shinanomachi.nagano.jp shiojiri.nagano.jp suwa.nagano.jp suzaka.nagano.jp takagi.nagano.jp takamori.nagano.jp takayama.nagano.jp tateshina.nagano.jp tatsuno.nagano.jp togakushi.nagano.jp togura.nagano.jp tomi.nagano.jp ueda.nagano.jp wada.nagano.jp yamagata.nagano.jp yamanouchi.nagano.jp yasaka.nagano.jp yasuoka.nagano.jp chijiwa.nagasaki.jp futsu.nagasaki.jp goto.nagasaki.jp hasami.nagasaki.jp hirado.nagasaki.jp iki.nagasaki.jp isahaya.nagasaki.jp kawatana.nagasaki.jp kuchinotsu.nagasaki.jp matsuura.nagasaki.jp nagasaki.nagasaki.jp obama.nagasaki.jp omura.nagasaki.jp oseto.nagasaki.jp saikai.nagasaki.jp sasebo.nagasaki.jp seihi.nagasaki.jp shimabara.nagasaki.jp shinkamigoto.nagasaki.jp togitsu.nagasaki.jp tsushima.nagasaki.jp unzen.nagasaki.jp ando.nara.jp gose.nara.jp heguri.nara.jp higashiyoshino.nara.jp ikaruga.nara.jp ikoma.nara.jp kamikitayama.nara.jp kanmaki.nara.jp kashiba.nara.jp kashihara.nara.jp katsuragi.nara.jp kawai.nara.jp kawakami.nara.jp kawanishi.nara.jp koryo.nara.jp kurotaki.nara.jp mitsue.nara.jp miyake.nara.jp nara.nara.jp nosegawa.nara.jp oji.nara.jp ouda.nara.jp oyodo.nara.jp sakurai.nara.jp sango.nara.jp shimoichi.nara.jp shimokitayama.nara.jp shinjo.nara.jp soni.nara.jp takatori.nara.jp tawaramoto.nara.jp tenkawa.nara.jp tenri.nara.jp uda.nara.jp yamatokoriyama.nara.jp yamatotakada.nara.jp yamazoe.nara.jp yoshino.nara.jp aga.niigata.jp agano.niigata.jp gosen.niigata.jp itoigawa.niigata.jp izumozaki.niigata.jp joetsu.niigata.jp kamo.niigata.jp kariwa.niigata.jp kashiwazaki.niigata.jp minamiuonuma.niigata.jp mitsuke.niigata.jp muika.niigata.jp murakami.niigata.jp myoko.niigata.jp nagaoka.niigata.jp niigata.niigata.jp ojiya.niigata.jp omi.niigata.jp sado.niigata.jp sanjo.niigata.jp seiro.niigata.jp seirou.niigata.jp sekikawa.niigata.jp shibata.niigata.jp tagami.niigata.jp tainai.niigata.jp tochio.niigata.jp tokamachi.niigata.jp tsubame.niigata.jp tsunan.niigata.jp uonuma.niigata.jp yahiko.niigata.jp yoita.niigata.jp yuzawa.niigata.jp beppu.oita.jp bungoono.oita.jp bungotakada.oita.jp hasama.oita.jp hiji.oita.jp himeshima.oita.jp hita.oita.jp kamitsue.oita.jp kokonoe.oita.jp kuju.oita.jp kunisaki.oita.jp kusu.oita.jp oita.oita.jp saiki.oita.jp taketa.oita.jp tsukumi.oita.jp usa.oita.jp usuki.oita.jp yufu.oita.jp akaiwa.okayama.jp asakuchi.okayama.jp bizen.okayama.jp hayashima.okayama.jp ibara.okayama.jp kagamino.okayama.jp kasaoka.okayama.jp kibichuo.okayama.jp kumenan.okayama.jp kurashiki.okayama.jp maniwa.okayama.jp misaki.okayama.jp nagi.okayama.jp niimi.okayama.jp nishiawakura.okayama.jp okayama.okayama.jp satosho.okayama.jp setouchi.okayama.jp shinjo.okayama.jp shoo.okayama.jp soja.okayama.jp takahashi.okayama.jp tamano.okayama.jp tsuyama.okayama.jp wake.okayama.jp yakage.okayama.jp aguni.okinawa.jp ginowan.okinawa.jp ginoza.okinawa.jp gushikami.okinawa.jp haebaru.okinawa.jp higashi.okinawa.jp hirara.okinawa.jp iheya.okinawa.jp ishigaki.okinawa.jp ishikawa.okinawa.jp itoman.okinawa.jp izena.okinawa.jp kadena.okinawa.jp kin.okinawa.jp kitadaito.okinawa.jp kitanakagusuku.okinawa.jp kumejima.okinawa.jp kunigami.okinawa.jp minamidaito.okinawa.jp motobu.okinawa.jp nago.okinawa.jp naha.okinawa.jp nakagusuku.okinawa.jp nakijin.okinawa.jp nanjo.okinawa.jp nishihara.okinawa.jp ogimi.okinawa.jp okinawa.okinawa.jp onna.okinawa.jp shimoji.okinawa.jp taketomi.okinawa.jp tarama.okinawa.jp tokashiki.okinawa.jp tomigusuku.okinawa.jp tonaki.okinawa.jp urasoe.okinawa.jp uruma.okinawa.jp yaese.okinawa.jp yomitan.okinawa.jp yonabaru.okinawa.jp yonaguni.okinawa.jp zamami.okinawa.jp abeno.osaka.jp chihayaakasaka.osaka.jp chuo.osaka.jp daito.osaka.jp fujiidera.osaka.jp habikino.osaka.jp hannan.osaka.jp higashiosaka.osaka.jp higashisumiyoshi.osaka.jp higashiyodogawa.osaka.jp hirakata.osaka.jp ibaraki.osaka.jp ikeda.osaka.jp izumi.osaka.jp izumiotsu.osaka.jp izumisano.osaka.jp kadoma.osaka.jp kaizuka.osaka.jp kanan.osaka.jp kashiwara.osaka.jp katano.osaka.jp kawachinagano.osaka.jp kishiwada.osaka.jp kita.osaka.jp kumatori.osaka.jp matsubara.osaka.jp minato.osaka.jp minoh.osaka.jp misaki.osaka.jp moriguchi.osaka.jp neyagawa.osaka.jp nishi.osaka.jp nose.osaka.jp osakasayama.osaka.jp sakai.osaka.jp sayama.osaka.jp sennan.osaka.jp settsu.osaka.jp shijonawate.osaka.jp shimamoto.osaka.jp suita.osaka.jp tadaoka.osaka.jp taishi.osaka.jp tajiri.osaka.jp takaishi.osaka.jp takatsuki.osaka.jp tondabayashi.osaka.jp toyonaka.osaka.jp toyono.osaka.jp yao.osaka.jp ariake.saga.jp arita.saga.jp fukudomi.saga.jp genkai.saga.jp hamatama.saga.jp hizen.saga.jp imari.saga.jp kamimine.saga.jp kanzaki.saga.jp karatsu.saga.jp kashima.saga.jp kitagata.saga.jp kitahata.saga.jp kiyama.saga.jp kouhoku.saga.jp kyuragi.saga.jp nishiarita.saga.jp ogi.saga.jp omachi.saga.jp ouchi.saga.jp saga.saga.jp shiroishi.saga.jp taku.saga.jp tara.saga.jp tosu.saga.jp yoshinogari.saga.jp arakawa.saitama.jp asaka.saitama.jp chichibu.saitama.jp fujimi.saitama.jp fujimino.saitama.jp fukaya.saitama.jp hanno.saitama.jp hanyu.saitama.jp hasuda.saitama.jp hatogaya.saitama.jp hatoyama.saitama.jp hidaka.saitama.jp higashichichibu.saitama.jp higashimatsuyama.saitama.jp honjo.saitama.jp ina.saitama.jp iruma.saitama.jp iwatsuki.saitama.jp kamiizumi.saitama.jp kamikawa.saitama.jp kamisato.saitama.jp kasukabe.saitama.jp kawagoe.saitama.jp kawaguchi.saitama.jp kawajima.saitama.jp kazo.saitama.jp kitamoto.saitama.jp koshigaya.saitama.jp kounosu.saitama.jp kuki.saitama.jp kumagaya.saitama.jp matsubushi.saitama.jp minano.saitama.jp misato.saitama.jp miyashiro.saitama.jp miyoshi.saitama.jp moroyama.saitama.jp nagatoro.saitama.jp namegawa.saitama.jp niiza.saitama.jp ogano.saitama.jp ogawa.saitama.jp ogose.saitama.jp okegawa.saitama.jp omiya.saitama.jp otaki.saitama.jp ranzan.saitama.jp ryokami.saitama.jp saitama.saitama.jp sakado.saitama.jp satte.saitama.jp sayama.saitama.jp shiki.saitama.jp shiraoka.saitama.jp soka.saitama.jp sugito.saitama.jp toda.saitama.jp tokigawa.saitama.jp tokorozawa.saitama.jp tsurugashima.saitama.jp urawa.saitama.jp warabi.saitama.jp yashio.saitama.jp yokoze.saitama.jp yono.saitama.jp yorii.saitama.jp yoshida.saitama.jp yoshikawa.saitama.jp yoshimi.saitama.jp aisho.shiga.jp gamo.shiga.jp higashiomi.shiga.jp hikone.shiga.jp koka.shiga.jp konan.shiga.jp kosei.shiga.jp koto.shiga.jp kusatsu.shiga.jp maibara.shiga.jp moriyama.shiga.jp nagahama.shiga.jp nishiazai.shiga.jp notogawa.shiga.jp omihachiman.shiga.jp otsu.shiga.jp ritto.shiga.jp ryuoh.shiga.jp takashima.shiga.jp takatsuki.shiga.jp torahime.shiga.jp toyosato.shiga.jp yasu.shiga.jp akagi.shimane.jp ama.shimane.jp gotsu.shimane.jp hamada.shimane.jp higashiizumo.shimane.jp hikawa.shimane.jp hikimi.shimane.jp izumo.shimane.jp kakinoki.shimane.jp masuda.shimane.jp matsue.shimane.jp misato.shimane.jp nishinoshima.shimane.jp ohda.shimane.jp okinoshima.shimane.jp okuizumo.shimane.jp shimane.shimane.jp tamayu.shimane.jp tsuwano.shimane.jp unnan.shimane.jp yakumo.shimane.jp yasugi.shimane.jp yatsuka.shimane.jp arai.shizuoka.jp atami.shizuoka.jp fuji.shizuoka.jp fujieda.shizuoka.jp fujikawa.shizuoka.jp fujinomiya.shizuoka.jp fukuroi.shizuoka.jp gotemba.shizuoka.jp haibara.shizuoka.jp hamamatsu.shizuoka.jp higashiizu.shizuoka.jp ito.shizuoka.jp iwata.shizuoka.jp izu.shizuoka.jp izunokuni.shizuoka.jp kakegawa.shizuoka.jp kannami.shizuoka.jp kawanehon.shizuoka.jp kawazu.shizuoka.jp kikugawa.shizuoka.jp kosai.shizuoka.jp makinohara.shizuoka.jp matsuzaki.shizuoka.jp minamiizu.shizuoka.jp mishima.shizuoka.jp morimachi.shizuoka.jp nishiizu.shizuoka.jp numazu.shizuoka.jp omaezaki.shizuoka.jp shimada.shizuoka.jp shimizu.shizuoka.jp shimoda.shizuoka.jp shizuoka.shizuoka.jp susono.shizuoka.jp yaizu.shizuoka.jp yoshida.shizuoka.jp ashikaga.tochigi.jp bato.tochigi.jp haga.tochigi.jp ichikai.tochigi.jp iwafune.tochigi.jp kaminokawa.tochigi.jp kanuma.tochigi.jp karasuyama.tochigi.jp kuroiso.tochigi.jp mashiko.tochigi.jp mibu.tochigi.jp moka.tochigi.jp motegi.tochigi.jp nasu.tochigi.jp nasushiobara.tochigi.jp nikko.tochigi.jp nishikata.tochigi.jp nogi.tochigi.jp ohira.tochigi.jp ohtawara.tochigi.jp oyama.tochigi.jp sakura.tochigi.jp sano.tochigi.jp shimotsuke.tochigi.jp shioya.tochigi.jp takanezawa.tochigi.jp tochigi.tochigi.jp tsuga.tochigi.jp ujiie.tochigi.jp utsunomiya.tochigi.jp yaita.tochigi.jp aizumi.tokushima.jp anan.tokushima.jp ichiba.tokushima.jp itano.tokushima.jp kainan.tokushima.jp komatsushima.tokushima.jp matsushige.tokushima.jp mima.tokushima.jp minami.tokushima.jp miyoshi.tokushima.jp mugi.tokushima.jp nakagawa.tokushima.jp naruto.tokushima.jp sanagochi.tokushima.jp shishikui.tokushima.jp tokushima.tokushima.jp wajiki.tokushima.jp adachi.tokyo.jp akiruno.tokyo.jp akishima.tokyo.jp aogashima.tokyo.jp arakawa.tokyo.jp bunkyo.tokyo.jp chiyoda.tokyo.jp chofu.tokyo.jp chuo.tokyo.jp edogawa.tokyo.jp fuchu.tokyo.jp fussa.tokyo.jp hachijo.tokyo.jp hachioji.tokyo.jp hamura.tokyo.jp higashikurume.tokyo.jp higashimurayama.tokyo.jp higashiyamato.tokyo.jp hino.tokyo.jp hinode.tokyo.jp hinohara.tokyo.jp inagi.tokyo.jp itabashi.tokyo.jp katsushika.tokyo.jp kita.tokyo.jp kiyose.tokyo.jp kodaira.tokyo.jp koganei.tokyo.jp kokubunji.tokyo.jp komae.tokyo.jp koto.tokyo.jp kouzushima.tokyo.jp kunitachi.tokyo.jp machida.tokyo.jp meguro.tokyo.jp minato.tokyo.jp mitaka.tokyo.jp mizuho.tokyo.jp musashimurayama.tokyo.jp musashino.tokyo.jp nakano.tokyo.jp nerima.tokyo.jp ogasawara.tokyo.jp okutama.tokyo.jp ome.tokyo.jp oshima.tokyo.jp ota.tokyo.jp setagaya.tokyo.jp shibuya.tokyo.jp shinagawa.tokyo.jp shinjuku.tokyo.jp suginami.tokyo.jp sumida.tokyo.jp tachikawa.tokyo.jp taito.tokyo.jp tama.tokyo.jp toshima.tokyo.jp chizu.tottori.jp hino.tottori.jp kawahara.tottori.jp koge.tottori.jp kotoura.tottori.jp misasa.tottori.jp nanbu.tottori.jp nichinan.tottori.jp sakaiminato.tottori.jp tottori.tottori.jp wakasa.tottori.jp yazu.tottori.jp yonago.tottori.jp asahi.toyama.jp fuchu.toyama.jp fukumitsu.toyama.jp funahashi.toyama.jp himi.toyama.jp imizu.toyama.jp inami.toyama.jp johana.toyama.jp kamiichi.toyama.jp kurobe.toyama.jp nakaniikawa.toyama.jp namerikawa.toyama.jp nanto.toyama.jp nyuzen.toyama.jp oyabe.toyama.jp taira.toyama.jp takaoka.toyama.jp tateyama.toyama.jp toga.toyama.jp tonami.toyama.jp toyama.toyama.jp unazuki.toyama.jp uozu.toyama.jp yamada.toyama.jp arida.wakayama.jp aridagawa.wakayama.jp gobo.wakayama.jp hashimoto.wakayama.jp hidaka.wakayama.jp hirogawa.wakayama.jp inami.wakayama.jp iwade.wakayama.jp kainan.wakayama.jp kamitonda.wakayama.jp katsuragi.wakayama.jp kimino.wakayama.jp kinokawa.wakayama.jp kitayama.wakayama.jp koya.wakayama.jp koza.wakayama.jp kozagawa.wakayama.jp kudoyama.wakayama.jp kushimoto.wakayama.jp mihama.wakayama.jp misato.wakayama.jp nachikatsuura.wakayama.jp shingu.wakayama.jp shirahama.wakayama.jp taiji.wakayama.jp tanabe.wakayama.jp wakayama.wakayama.jp yuasa.wakayama.jp yura.wakayama.jp asahi.yamagata.jp funagata.yamagata.jp higashine.yamagata.jp iide.yamagata.jp kahoku.yamagata.jp kaminoyama.yamagata.jp kaneyama.yamagata.jp kawanishi.yamagata.jp mamurogawa.yamagata.jp mikawa.yamagata.jp murayama.yamagata.jp nagai.yamagata.jp nakayama.yamagata.jp nanyo.yamagata.jp nishikawa.yamagata.jp obanazawa.yamagata.jp oe.yamagata.jp oguni.yamagata.jp ohkura.yamagata.jp oishida.yamagata.jp sagae.yamagata.jp sakata.yamagata.jp sakegawa.yamagata.jp shinjo.yamagata.jp shirataka.yamagata.jp shonai.yamagata.jp takahata.yamagata.jp tendo.yamagata.jp tozawa.yamagata.jp tsuruoka.yamagata.jp yamagata.yamagata.jp yamanobe.yamagata.jp yonezawa.yamagata.jp yuza.yamagata.jp abu.yamaguchi.jp hagi.yamaguchi.jp hikari.yamaguchi.jp hofu.yamaguchi.jp iwakuni.yamaguchi.jp kudamatsu.yamaguchi.jp mitou.yamaguchi.jp nagato.yamaguchi.jp oshima.yamaguchi.jp shimonoseki.yamaguchi.jp shunan.yamaguchi.jp tabuse.yamaguchi.jp tokuyama.yamaguchi.jp toyota.yamaguchi.jp ube.yamaguchi.jp yuu.yamaguchi.jp chuo.yamanashi.jp doshi.yamanashi.jp fuefuki.yamanashi.jp fujikawa.yamanashi.jp fujikawaguchiko.yamanashi.jp fujiyoshida.yamanashi.jp hayakawa.yamanashi.jp hokuto.yamanashi.jp ichikawamisato.yamanashi.jp kai.yamanashi.jp kofu.yamanashi.jp koshu.yamanashi.jp kosuge.yamanashi.jp minami-alps.yamanashi.jp minobu.yamanashi.jp nakamichi.yamanashi.jp nanbu.yamanashi.jp narusawa.yamanashi.jp nirasaki.yamanashi.jp nishikatsura.yamanashi.jp oshino.yamanashi.jp otsuki.yamanashi.jp showa.yamanashi.jp tabayama.yamanashi.jp tsuru.yamanashi.jp uenohara.yamanashi.jp yamanakako.yamanashi.jp yamanashi.yamanashi.jp // ke : http://www.kenic.or.ke/index.php?option=com_content&task=view&id=117&Itemid=145 *.ke // kg : http://www.domain.kg/dmn_n.html kg org.kg net.kg com.kg edu.kg gov.kg mil.kg // kh : http://www.mptc.gov.kh/dns_registration.htm *.kh // ki : http://www.ki/dns/index.html ki edu.ki biz.ki net.ki org.ki gov.ki info.ki com.ki // km : http://en.wikipedia.org/wiki/.km // http://www.domaine.km/documents/charte.doc km org.km nom.km gov.km prd.km tm.km edu.km mil.km ass.km com.km // These are only mentioned as proposed suggestions at domaine.km, but // http://en.wikipedia.org/wiki/.km says they're available for registration: coop.km asso.km presse.km medecin.km notaires.km pharmaciens.km veterinaire.km gouv.km // kn : http://en.wikipedia.org/wiki/.kn // http://www.dot.kn/domainRules.html kn net.kn org.kn edu.kn gov.kn // kp : http://www.kcce.kp/en_index.php com.kp edu.kp gov.kp org.kp rep.kp tra.kp // kr : http://en.wikipedia.org/wiki/.kr // see also: http://domain.nida.or.kr/eng/registration.jsp kr ac.kr co.kr es.kr go.kr hs.kr kg.kr mil.kr ms.kr ne.kr or.kr pe.kr re.kr sc.kr // kr geographical names busan.kr chungbuk.kr chungnam.kr daegu.kr daejeon.kr gangwon.kr gwangju.kr gyeongbuk.kr gyeonggi.kr gyeongnam.kr incheon.kr jeju.kr jeonbuk.kr jeonnam.kr seoul.kr ulsan.kr // kw : http://en.wikipedia.org/wiki/.kw *.kw // ky : http://www.icta.ky/da_ky_reg_dom.php // Confirmed by registry 2008-06-17 ky edu.ky gov.ky com.ky org.ky net.ky // kz : http://en.wikipedia.org/wiki/.kz // see also: http://www.nic.kz/rules/index.jsp kz org.kz edu.kz net.kz gov.kz mil.kz com.kz // la : http://en.wikipedia.org/wiki/.la // Submitted by registry 2008-06-10 la int.la net.la info.la edu.la gov.la per.la com.la org.la // lb : http://en.wikipedia.org/wiki/.lb // Submitted by registry 2008-06-17 com.lb edu.lb gov.lb net.lb org.lb // lc : http://en.wikipedia.org/wiki/.lc // see also: http://www.nic.lc/rules.htm lc com.lc net.lc co.lc org.lc edu.lc gov.lc // li : http://en.wikipedia.org/wiki/.li li // lk : http://www.nic.lk/seclevpr.html lk gov.lk sch.lk net.lk int.lk com.lk org.lk edu.lk ngo.lk soc.lk web.lk ltd.lk assn.lk grp.lk hotel.lk // lr : http://psg.com/dns/lr/lr.txt // Submitted by registry 2008-06-17 com.lr edu.lr gov.lr org.lr net.lr // ls : http://en.wikipedia.org/wiki/.ls ls co.ls org.ls // lt : http://en.wikipedia.org/wiki/.lt lt // gov.lt : http://www.gov.lt/index_en.php gov.lt // lu : http://www.dns.lu/en/ lu // lv : http://www.nic.lv/DNS/En/generic.php lv com.lv edu.lv gov.lv org.lv mil.lv id.lv net.lv asn.lv conf.lv // ly : http://www.nic.ly/regulations.php ly com.ly net.ly gov.ly plc.ly edu.ly sch.ly med.ly org.ly id.ly // ma : http://en.wikipedia.org/wiki/.ma // http://www.anrt.ma/fr/admin/download/upload/file_fr782.pdf ma co.ma net.ma gov.ma org.ma ac.ma press.ma // mc : http://www.nic.mc/ mc tm.mc asso.mc // md : http://en.wikipedia.org/wiki/.md md // me : http://en.wikipedia.org/wiki/.me me co.me net.me org.me edu.me ac.me gov.me its.me priv.me // mg : http://www.nic.mg/tarif.htm mg org.mg nom.mg gov.mg prd.mg tm.mg edu.mg mil.mg com.mg // mh : http://en.wikipedia.org/wiki/.mh mh // mil : http://en.wikipedia.org/wiki/.mil mil // mk : http://en.wikipedia.org/wiki/.mk // see also: http://dns.marnet.net.mk/postapka.php mk com.mk org.mk net.mk edu.mk gov.mk inf.mk name.mk // ml : http://www.gobin.info/domainname/ml-template.doc // see also: http://en.wikipedia.org/wiki/.ml ml com.ml edu.ml gouv.ml gov.ml net.ml org.ml presse.ml // mm : http://en.wikipedia.org/wiki/.mm *.mm // mn : http://en.wikipedia.org/wiki/.mn mn gov.mn edu.mn org.mn // mo : http://www.monic.net.mo/ mo com.mo net.mo org.mo edu.mo gov.mo // mobi : http://en.wikipedia.org/wiki/.mobi mobi // mp : http://www.dot.mp/ // Confirmed by registry 2008-06-17 mp // mq : http://en.wikipedia.org/wiki/.mq mq // mr : http://en.wikipedia.org/wiki/.mr mr gov.mr // ms : http://en.wikipedia.org/wiki/.ms ms // mt : https://www.nic.org.mt/dotmt/ *.mt // mu : http://en.wikipedia.org/wiki/.mu mu com.mu net.mu org.mu gov.mu ac.mu co.mu or.mu // museum : http://about.museum/naming/ // http://index.museum/ museum academy.museum agriculture.museum air.museum airguard.museum alabama.museum alaska.museum amber.museum ambulance.museum american.museum americana.museum americanantiques.museum americanart.museum amsterdam.museum and.museum annefrank.museum anthro.museum anthropology.museum antiques.museum aquarium.museum arboretum.museum archaeological.museum archaeology.museum architecture.museum art.museum artanddesign.museum artcenter.museum artdeco.museum arteducation.museum artgallery.museum arts.museum artsandcrafts.museum asmatart.museum assassination.museum assisi.museum association.museum astronomy.museum atlanta.museum austin.museum australia.museum automotive.museum aviation.museum axis.museum badajoz.museum baghdad.museum bahn.museum bale.museum baltimore.museum barcelona.museum baseball.museum basel.museum baths.museum bauern.museum beauxarts.museum beeldengeluid.museum bellevue.museum bergbau.museum berkeley.museum berlin.museum bern.museum bible.museum bilbao.museum bill.museum birdart.museum birthplace.museum bonn.museum boston.museum botanical.museum botanicalgarden.museum botanicgarden.museum botany.museum brandywinevalley.museum brasil.museum bristol.museum british.museum britishcolumbia.museum broadcast.museum brunel.museum brussel.museum brussels.museum bruxelles.museum building.museum burghof.museum bus.museum bushey.museum cadaques.museum california.museum cambridge.museum can.museum canada.museum capebreton.museum carrier.museum cartoonart.museum casadelamoneda.museum castle.museum castres.museum celtic.museum center.museum chattanooga.museum cheltenham.museum chesapeakebay.museum chicago.museum children.museum childrens.museum childrensgarden.museum chiropractic.museum chocolate.museum christiansburg.museum cincinnati.museum cinema.museum circus.museum civilisation.museum civilization.museum civilwar.museum clinton.museum clock.museum coal.museum coastaldefence.museum cody.museum coldwar.museum collection.museum colonialwilliamsburg.museum coloradoplateau.museum columbia.museum columbus.museum communication.museum communications.museum community.museum computer.museum computerhistory.museum comunicações.museum contemporary.museum contemporaryart.museum convent.museum copenhagen.museum corporation.museum correios-e-telecomunicações.museum corvette.museum costume.museum countryestate.museum county.museum crafts.museum cranbrook.museum creation.museum cultural.museum culturalcenter.museum culture.museum cyber.museum cymru.museum dali.museum dallas.museum database.museum ddr.museum decorativearts.museum delaware.museum delmenhorst.museum denmark.museum depot.museum design.museum detroit.museum dinosaur.museum discovery.museum dolls.museum donostia.museum durham.museum eastafrica.museum eastcoast.museum education.museum educational.museum egyptian.museum eisenbahn.museum elburg.museum elvendrell.museum embroidery.museum encyclopedic.museum england.museum entomology.museum environment.museum environmentalconservation.museum epilepsy.museum essex.museum estate.museum ethnology.museum exeter.museum exhibition.museum family.museum farm.museum farmequipment.museum farmers.museum farmstead.museum field.museum figueres.museum filatelia.museum film.museum fineart.museum finearts.museum finland.museum flanders.museum florida.museum force.museum fortmissoula.museum fortworth.museum foundation.museum francaise.museum frankfurt.museum franziskaner.museum freemasonry.museum freiburg.museum fribourg.museum frog.museum fundacio.museum furniture.museum gallery.museum garden.museum gateway.museum geelvinck.museum gemological.museum geology.museum georgia.museum giessen.museum glas.museum glass.museum gorge.museum grandrapids.museum graz.museum guernsey.museum halloffame.museum hamburg.museum handson.museum harvestcelebration.museum hawaii.museum health.museum heimatunduhren.museum hellas.museum helsinki.museum hembygdsforbund.museum heritage.museum histoire.museum historical.museum historicalsociety.museum historichouses.museum historisch.museum historisches.museum history.museum historyofscience.museum horology.museum house.museum humanities.museum illustration.museum imageandsound.museum indian.museum indiana.museum indianapolis.museum indianmarket.museum intelligence.museum interactive.museum iraq.museum iron.museum isleofman.museum jamison.museum jefferson.museum jerusalem.museum jewelry.museum jewish.museum jewishart.museum jfk.museum journalism.museum judaica.museum judygarland.museum juedisches.museum juif.museum karate.museum karikatur.museum kids.museum koebenhavn.museum koeln.museum kunst.museum kunstsammlung.museum kunstunddesign.museum labor.museum labour.museum lajolla.museum lancashire.museum landes.museum lans.museum läns.museum larsson.museum lewismiller.museum lincoln.museum linz.museum living.museum livinghistory.museum localhistory.museum london.museum losangeles.museum louvre.museum loyalist.museum lucerne.museum luxembourg.museum luzern.museum mad.museum madrid.museum mallorca.museum manchester.museum mansion.museum mansions.museum manx.museum marburg.museum maritime.museum maritimo.museum maryland.museum marylhurst.museum media.museum medical.museum medizinhistorisches.museum meeres.museum memorial.museum mesaverde.museum michigan.museum midatlantic.museum military.museum mill.museum miners.museum mining.museum minnesota.museum missile.museum missoula.museum modern.museum moma.museum money.museum monmouth.museum monticello.museum montreal.museum moscow.museum motorcycle.museum muenchen.museum muenster.museum mulhouse.museum muncie.museum museet.museum museumcenter.museum museumvereniging.museum music.museum national.museum nationalfirearms.museum nationalheritage.museum nativeamerican.museum naturalhistory.museum naturalhistorymuseum.museum naturalsciences.museum nature.museum naturhistorisches.museum natuurwetenschappen.museum naumburg.museum naval.museum nebraska.museum neues.museum newhampshire.museum newjersey.museum newmexico.museum newport.museum newspaper.museum newyork.museum niepce.museum norfolk.museum north.museum nrw.museum nuernberg.museum nuremberg.museum nyc.museum nyny.museum oceanographic.museum oceanographique.museum omaha.museum online.museum ontario.museum openair.museum oregon.museum oregontrail.museum otago.museum oxford.museum pacific.museum paderborn.museum palace.museum paleo.museum palmsprings.museum panama.museum paris.museum pasadena.museum pharmacy.museum philadelphia.museum philadelphiaarea.museum philately.museum phoenix.museum photography.museum pilots.museum pittsburgh.museum planetarium.museum plantation.museum plants.museum plaza.museum portal.museum portland.museum portlligat.museum posts-and-telecommunications.museum preservation.museum presidio.museum press.museum project.museum public.museum pubol.museum quebec.museum railroad.museum railway.museum research.museum resistance.museum riodejaneiro.museum rochester.museum rockart.museum roma.museum russia.museum saintlouis.museum salem.museum salvadordali.museum salzburg.museum sandiego.museum sanfrancisco.museum santabarbara.museum santacruz.museum santafe.museum saskatchewan.museum satx.museum savannahga.museum schlesisches.museum schoenbrunn.museum schokoladen.museum school.museum schweiz.museum science.museum scienceandhistory.museum scienceandindustry.museum sciencecenter.museum sciencecenters.museum science-fiction.museum sciencehistory.museum sciences.museum sciencesnaturelles.museum scotland.museum seaport.museum settlement.museum settlers.museum shell.museum sherbrooke.museum sibenik.museum silk.museum ski.museum skole.museum society.museum sologne.museum soundandvision.museum southcarolina.museum southwest.museum space.museum spy.museum square.museum stadt.museum stalbans.museum starnberg.museum state.museum stateofdelaware.museum station.museum steam.museum steiermark.museum stjohn.museum stockholm.museum stpetersburg.museum stuttgart.museum suisse.museum surgeonshall.museum surrey.museum svizzera.museum sweden.museum sydney.museum tank.museum tcm.museum technology.museum telekommunikation.museum television.museum texas.museum textile.museum theater.museum time.museum timekeeping.museum topology.museum torino.museum touch.museum town.museum transport.museum tree.museum trolley.museum trust.museum trustee.museum uhren.museum ulm.museum undersea.museum university.museum usa.museum usantiques.museum usarts.museum uscountryestate.museum usculture.museum usdecorativearts.museum usgarden.museum ushistory.museum ushuaia.museum uslivinghistory.museum utah.museum uvic.museum valley.museum vantaa.museum versailles.museum viking.museum village.museum virginia.museum virtual.museum virtuel.museum vlaanderen.museum volkenkunde.museum wales.museum wallonie.museum war.museum washingtondc.museum watchandclock.museum watch-and-clock.museum western.museum westfalen.museum whaling.museum wildlife.museum williamsburg.museum windmill.museum workshop.museum york.museum yorkshire.museum yosemite.museum youth.museum zoological.museum zoology.museum ירושלים.museum иком.museum // mv : http://en.wikipedia.org/wiki/.mv // "mv" included because, contra Wikipedia, google.mv exists. mv aero.mv biz.mv com.mv coop.mv edu.mv gov.mv info.mv int.mv mil.mv museum.mv name.mv net.mv org.mv pro.mv // mw : http://www.registrar.mw/ mw ac.mw biz.mw co.mw com.mw coop.mw edu.mw gov.mw int.mw museum.mw net.mw org.mw // mx : http://www.nic.mx/ // Submitted by registry 2008-06-19 mx com.mx org.mx gob.mx edu.mx net.mx // my : http://www.mynic.net.my/ my com.my net.my org.my gov.my edu.my mil.my name.my // mz : http://www.gobin.info/domainname/mz-template.doc *.mz !teledata.mz // na : http://www.na-nic.com.na/ // http://www.info.na/domain/ na info.na pro.na name.na school.na or.na dr.na us.na mx.na ca.na in.na cc.na tv.na ws.na mobi.na co.na com.na org.na // name : has 2nd-level tlds, but there's no list of them name // nc : http://www.cctld.nc/ nc asso.nc // ne : http://en.wikipedia.org/wiki/.ne ne // net : http://en.wikipedia.org/wiki/.net net // nf : http://en.wikipedia.org/wiki/.nf nf com.nf net.nf per.nf rec.nf web.nf arts.nf firm.nf info.nf other.nf store.nf // ng : http://psg.com/dns/ng/ // Submitted by registry 2008-06-17 ac.ng com.ng edu.ng gov.ng net.ng org.ng // ni : http://www.nic.ni/dominios.htm *.ni // nl : http://www.domain-registry.nl/ace.php/c,728,122,,,,Home.html // Confirmed by registry (with technical // reservations) 2008-06-08 nl // BV.nl will be a registry for dutch BV's (besloten vennootschap) bv.nl // no : http://www.norid.no/regelverk/index.en.html // The Norwegian registry has declined to notify us of updates. The web pages // referenced below are the official source of the data. There is also an // announce mailing list: // https://postlister.uninett.no/sympa/info/norid-diskusjon no // Norid generic domains : http://www.norid.no/regelverk/vedlegg-c.en.html fhs.no vgs.no fylkesbibl.no folkebibl.no museum.no idrett.no priv.no // Non-Norid generic domains : http://www.norid.no/regelverk/vedlegg-d.en.html mil.no stat.no dep.no kommune.no herad.no // no geographical names : http://www.norid.no/regelverk/vedlegg-b.en.html // counties aa.no ah.no bu.no fm.no hl.no hm.no jan-mayen.no mr.no nl.no nt.no of.no ol.no oslo.no rl.no sf.no st.no svalbard.no tm.no tr.no va.no vf.no // primary and lower secondary schools per county gs.aa.no gs.ah.no gs.bu.no gs.fm.no gs.hl.no gs.hm.no gs.jan-mayen.no gs.mr.no gs.nl.no gs.nt.no gs.of.no gs.ol.no gs.oslo.no gs.rl.no gs.sf.no gs.st.no gs.svalbard.no gs.tm.no gs.tr.no gs.va.no gs.vf.no // cities akrehamn.no åkrehamn.no algard.no ålgård.no arna.no brumunddal.no bryne.no bronnoysund.no brønnøysund.no drobak.no drøbak.no egersund.no fetsund.no floro.no florø.no fredrikstad.no hokksund.no honefoss.no hønefoss.no jessheim.no jorpeland.no jørpeland.no kirkenes.no kopervik.no krokstadelva.no langevag.no langevåg.no leirvik.no mjondalen.no mjøndalen.no mo-i-rana.no mosjoen.no mosjøen.no nesoddtangen.no orkanger.no osoyro.no osøyro.no raholt.no råholt.no sandnessjoen.no sandnessjøen.no skedsmokorset.no slattum.no spjelkavik.no stathelle.no stavern.no stjordalshalsen.no stjørdalshalsen.no tananger.no tranby.no vossevangen.no // communities afjord.no åfjord.no agdenes.no al.no ål.no alesund.no ålesund.no alstahaug.no alta.no áltá.no alaheadju.no álaheadju.no alvdal.no amli.no åmli.no amot.no åmot.no andebu.no andoy.no andøy.no andasuolo.no ardal.no årdal.no aremark.no arendal.no ås.no aseral.no åseral.no asker.no askim.no askvoll.no askoy.no askøy.no asnes.no åsnes.no audnedaln.no aukra.no aure.no aurland.no aurskog-holand.no aurskog-høland.no austevoll.no austrheim.no averoy.no averøy.no balestrand.no ballangen.no balat.no bálát.no balsfjord.no bahccavuotna.no báhccavuotna.no bamble.no bardu.no beardu.no beiarn.no bajddar.no bájddar.no baidar.no báidár.no berg.no bergen.no berlevag.no berlevåg.no bearalvahki.no bearalváhki.no bindal.no birkenes.no bjarkoy.no bjarkøy.no bjerkreim.no bjugn.no bodo.no bodø.no badaddja.no bådåddjå.no budejju.no bokn.no bremanger.no bronnoy.no brønnøy.no bygland.no bykle.no barum.no bærum.no bo.telemark.no bø.telemark.no bo.nordland.no bø.nordland.no bievat.no bievát.no bomlo.no bømlo.no batsfjord.no båtsfjord.no bahcavuotna.no báhcavuotna.no dovre.no drammen.no drangedal.no dyroy.no dyrøy.no donna.no dønna.no eid.no eidfjord.no eidsberg.no eidskog.no eidsvoll.no eigersund.no elverum.no enebakk.no engerdal.no etne.no etnedal.no evenes.no evenassi.no evenášši.no evje-og-hornnes.no farsund.no fauske.no fuossko.no fuoisku.no fedje.no fet.no finnoy.no finnøy.no fitjar.no fjaler.no fjell.no flakstad.no flatanger.no flekkefjord.no flesberg.no flora.no fla.no flå.no folldal.no forsand.no fosnes.no frei.no frogn.no froland.no frosta.no frana.no fræna.no froya.no frøya.no fusa.no fyresdal.no forde.no førde.no gamvik.no gangaviika.no gáŋgaviika.no gaular.no gausdal.no gildeskal.no gildeskål.no giske.no gjemnes.no gjerdrum.no gjerstad.no gjesdal.no gjovik.no gjøvik.no gloppen.no gol.no gran.no grane.no granvin.no gratangen.no grimstad.no grong.no kraanghke.no kråanghke.no grue.no gulen.no hadsel.no halden.no halsa.no hamar.no hamaroy.no habmer.no hábmer.no hapmir.no hápmir.no hammerfest.no hammarfeasta.no hámmárfeasta.no haram.no hareid.no harstad.no hasvik.no aknoluokta.no ákŋoluokta.no hattfjelldal.no aarborte.no haugesund.no hemne.no hemnes.no hemsedal.no heroy.more-og-romsdal.no herøy.møre-og-romsdal.no heroy.nordland.no herøy.nordland.no hitra.no hjartdal.no hjelmeland.no hobol.no hobøl.no hof.no hol.no hole.no holmestrand.no holtalen.no holtålen.no hornindal.no horten.no hurdal.no hurum.no hvaler.no hyllestad.no hagebostad.no hægebostad.no hoyanger.no høyanger.no hoylandet.no høylandet.no ha.no hå.no ibestad.no inderoy.no inderøy.no iveland.no jevnaker.no jondal.no jolster.no jølster.no karasjok.no karasjohka.no kárášjohka.no karlsoy.no galsa.no gálsá.no karmoy.no karmøy.no kautokeino.no guovdageaidnu.no klepp.no klabu.no klæbu.no kongsberg.no kongsvinger.no kragero.no kragerø.no kristiansand.no kristiansund.no krodsherad.no krødsherad.no kvalsund.no rahkkeravju.no ráhkkerávju.no kvam.no kvinesdal.no kvinnherad.no kviteseid.no kvitsoy.no kvitsøy.no kvafjord.no kvæfjord.no giehtavuoatna.no kvanangen.no kvænangen.no navuotna.no návuotna.no kafjord.no kåfjord.no gaivuotna.no gáivuotna.no larvik.no lavangen.no lavagis.no loabat.no loabát.no lebesby.no davvesiida.no leikanger.no leirfjord.no leka.no leksvik.no lenvik.no leangaviika.no leaŋgaviika.no lesja.no levanger.no lier.no lierne.no lillehammer.no lillesand.no lindesnes.no lindas.no lindås.no lom.no loppa.no lahppi.no láhppi.no lund.no lunner.no luroy.no lurøy.no luster.no lyngdal.no lyngen.no ivgu.no lardal.no lerdal.no lærdal.no lodingen.no lødingen.no lorenskog.no lørenskog.no loten.no løten.no malvik.no masoy.no måsøy.no muosat.no muosát.no mandal.no marker.no marnardal.no masfjorden.no meland.no meldal.no melhus.no meloy.no meløy.no meraker.no meråker.no moareke.no moåreke.no midsund.no midtre-gauldal.no modalen.no modum.no molde.no moskenes.no moss.no mosvik.no malselv.no målselv.no malatvuopmi.no málatvuopmi.no namdalseid.no aejrie.no namsos.no namsskogan.no naamesjevuemie.no nååmesjevuemie.no laakesvuemie.no nannestad.no narvik.no narviika.no naustdal.no nedre-eiker.no nes.akershus.no nes.buskerud.no nesna.no nesodden.no nesseby.no unjarga.no unjárga.no nesset.no nissedal.no nittedal.no nord-aurdal.no nord-fron.no nord-odal.no norddal.no nordkapp.no davvenjarga.no davvenjárga.no nordre-land.no nordreisa.no raisa.no ráisa.no nore-og-uvdal.no notodden.no naroy.no nærøy.no notteroy.no nøtterøy.no odda.no oksnes.no øksnes.no oppdal.no oppegard.no oppegård.no orkdal.no orland.no ørland.no orskog.no ørskog.no orsta.no ørsta.no os.hedmark.no os.hordaland.no osen.no osteroy.no osterøy.no ostre-toten.no østre-toten.no overhalla.no ovre-eiker.no øvre-eiker.no oyer.no øyer.no oygarden.no øygarden.no oystre-slidre.no øystre-slidre.no porsanger.no porsangu.no porsáŋgu.no porsgrunn.no radoy.no radøy.no rakkestad.no rana.no ruovat.no randaberg.no rauma.no rendalen.no rennebu.no rennesoy.no rennesøy.no rindal.no ringebu.no ringerike.no ringsaker.no rissa.no risor.no risør.no roan.no rollag.no rygge.no ralingen.no rælingen.no rodoy.no rødøy.no romskog.no rømskog.no roros.no røros.no rost.no røst.no royken.no røyken.no royrvik.no røyrvik.no rade.no råde.no salangen.no siellak.no saltdal.no salat.no sálát.no sálat.no samnanger.no sande.more-og-romsdal.no sande.møre-og-romsdal.no sande.vestfold.no sandefjord.no sandnes.no sandoy.no sandøy.no sarpsborg.no sauda.no sauherad.no sel.no selbu.no selje.no seljord.no sigdal.no siljan.no sirdal.no skaun.no skedsmo.no ski.no skien.no skiptvet.no skjervoy.no skjervøy.no skierva.no skiervá.no skjak.no skjåk.no skodje.no skanland.no skånland.no skanit.no skánit.no smola.no smøla.no snillfjord.no snasa.no snåsa.no snoasa.no snaase.no snåase.no sogndal.no sokndal.no sola.no solund.no songdalen.no sortland.no spydeberg.no stange.no stavanger.no steigen.no steinkjer.no stjordal.no stjørdal.no stokke.no stor-elvdal.no stord.no stordal.no storfjord.no omasvuotna.no strand.no stranda.no stryn.no sula.no suldal.no sund.no sunndal.no surnadal.no sveio.no svelvik.no sykkylven.no sogne.no søgne.no somna.no sømna.no sondre-land.no søndre-land.no sor-aurdal.no sør-aurdal.no sor-fron.no sør-fron.no sor-odal.no sør-odal.no sor-varanger.no sør-varanger.no matta-varjjat.no mátta-várjjat.no sorfold.no sørfold.no sorreisa.no sørreisa.no sorum.no sørum.no tana.no deatnu.no time.no tingvoll.no tinn.no tjeldsund.no dielddanuorri.no tjome.no tjøme.no tokke.no tolga.no torsken.no tranoy.no tranøy.no tromso.no tromsø.no tromsa.no romsa.no trondheim.no troandin.no trysil.no trana.no træna.no trogstad.no trøgstad.no tvedestrand.no tydal.no tynset.no tysfjord.no divtasvuodna.no divttasvuotna.no tysnes.no tysvar.no tysvær.no tonsberg.no tønsberg.no ullensaker.no ullensvang.no ulvik.no utsira.no vadso.no vadsø.no cahcesuolo.no čáhcesuolo.no vaksdal.no valle.no vang.no vanylven.no vardo.no vardø.no varggat.no várggát.no vefsn.no vaapste.no vega.no vegarshei.no vegårshei.no vennesla.no verdal.no verran.no vestby.no vestnes.no vestre-slidre.no vestre-toten.no vestvagoy.no vestvågøy.no vevelstad.no vik.no vikna.no vindafjord.no volda.no voss.no varoy.no værøy.no vagan.no vågan.no voagat.no vagsoy.no vågsøy.no vaga.no vågå.no valer.ostfold.no våler.østfold.no valer.hedmark.no våler.hedmark.no // np : http://www.mos.com.np/register.html *.np // nr : http://cenpac.net.nr/dns/index.html // Confirmed by registry 2008-06-17 nr biz.nr info.nr gov.nr edu.nr org.nr net.nr com.nr // nu : http://en.wikipedia.org/wiki/.nu nu // nz : http://en.wikipedia.org/wiki/.nz *.nz // om : http://en.wikipedia.org/wiki/.om *.om !mediaphone.om !nawrastelecom.om !nawras.om !omanmobile.om !omanpost.om !omantel.om !rakpetroleum.om !siemens.om !songfest.om !statecouncil.om // org : http://en.wikipedia.org/wiki/.org org // pa : http://www.nic.pa/ // Some additional second level "domains" resolve directly as hostnames, such as // pannet.pa, so we add a rule for "pa". pa ac.pa gob.pa com.pa org.pa sld.pa edu.pa net.pa ing.pa abo.pa med.pa nom.pa // pe : https://www.nic.pe/InformeFinalComision.pdf pe edu.pe gob.pe nom.pe mil.pe org.pe com.pe net.pe // pf : http://www.gobin.info/domainname/formulaire-pf.pdf pf com.pf org.pf edu.pf // pg : http://en.wikipedia.org/wiki/.pg *.pg // ph : http://www.domains.ph/FAQ2.asp // Submitted by registry 2008-06-13 ph com.ph net.ph org.ph gov.ph edu.ph ngo.ph mil.ph i.ph // pk : http://pk5.pknic.net.pk/pk5/msgNamepk.PK pk com.pk net.pk edu.pk org.pk fam.pk biz.pk web.pk gov.pk gob.pk gok.pk gon.pk gop.pk gos.pk info.pk // pl : http://www.dns.pl/english/ pl // NASK functional domains (nask.pl / dns.pl) : http://www.dns.pl/english/dns-funk.html aid.pl agro.pl atm.pl auto.pl biz.pl com.pl edu.pl gmina.pl gsm.pl info.pl mail.pl miasta.pl media.pl mil.pl net.pl nieruchomosci.pl nom.pl org.pl pc.pl powiat.pl priv.pl realestate.pl rel.pl sex.pl shop.pl sklep.pl sos.pl szkola.pl targi.pl tm.pl tourism.pl travel.pl turystyka.pl // ICM functional domains (icm.edu.pl) 6bone.pl art.pl mbone.pl // Government domains (administred by ippt.gov.pl) gov.pl uw.gov.pl um.gov.pl ug.gov.pl upow.gov.pl starostwo.gov.pl so.gov.pl sr.gov.pl po.gov.pl pa.gov.pl // other functional domains ngo.pl irc.pl usenet.pl // NASK geographical domains : http://www.dns.pl/english/dns-regiony.html augustow.pl babia-gora.pl bedzin.pl beskidy.pl bialowieza.pl bialystok.pl bielawa.pl bieszczady.pl boleslawiec.pl bydgoszcz.pl bytom.pl cieszyn.pl czeladz.pl czest.pl dlugoleka.pl elblag.pl elk.pl glogow.pl gniezno.pl gorlice.pl grajewo.pl ilawa.pl jaworzno.pl jelenia-gora.pl jgora.pl kalisz.pl kazimierz-dolny.pl karpacz.pl kartuzy.pl kaszuby.pl katowice.pl kepno.pl ketrzyn.pl klodzko.pl kobierzyce.pl kolobrzeg.pl konin.pl konskowola.pl kutno.pl lapy.pl lebork.pl legnica.pl lezajsk.pl limanowa.pl lomza.pl lowicz.pl lubin.pl lukow.pl malbork.pl malopolska.pl mazowsze.pl mazury.pl mielec.pl mielno.pl mragowo.pl naklo.pl nowaruda.pl nysa.pl olawa.pl olecko.pl olkusz.pl olsztyn.pl opoczno.pl opole.pl ostroda.pl ostroleka.pl ostrowiec.pl ostrowwlkp.pl pila.pl pisz.pl podhale.pl podlasie.pl polkowice.pl pomorze.pl pomorskie.pl prochowice.pl pruszkow.pl przeworsk.pl pulawy.pl radom.pl rawa-maz.pl rybnik.pl rzeszow.pl sanok.pl sejny.pl siedlce.pl slask.pl slupsk.pl sosnowiec.pl stalowa-wola.pl skoczow.pl starachowice.pl stargard.pl suwalki.pl swidnica.pl swiebodzin.pl swinoujscie.pl szczecin.pl szczytno.pl tarnobrzeg.pl tgory.pl turek.pl tychy.pl ustka.pl walbrzych.pl warmia.pl warszawa.pl waw.pl wegrow.pl wielun.pl wlocl.pl wloclawek.pl wodzislaw.pl wolomin.pl wroclaw.pl zachpomor.pl zagan.pl zarow.pl zgora.pl zgorzelec.pl // TASK geographical domains (www.task.gda.pl/uslugi/dns) gda.pl gdansk.pl gdynia.pl med.pl sopot.pl // other geographical domains gliwice.pl krakow.pl poznan.pl wroc.pl zakopane.pl // pm : http://www.afnic.fr/medias/documents/AFNIC-naming-policy2012.pdf pm // pn : http://www.government.pn/PnRegistry/policies.htm pn gov.pn co.pn org.pn edu.pn net.pn // post : http://en.wikipedia.org/wiki/.post post // pr : http://www.nic.pr/index.asp?f=1 pr com.pr net.pr org.pr gov.pr edu.pr isla.pr pro.pr biz.pr info.pr name.pr // these aren't mentioned on nic.pr, but on http://en.wikipedia.org/wiki/.pr est.pr prof.pr ac.pr // pro : http://www.nic.pro/support_faq.htm pro aca.pro bar.pro cpa.pro jur.pro law.pro med.pro eng.pro // ps : http://en.wikipedia.org/wiki/.ps // http://www.nic.ps/registration/policy.html#reg ps edu.ps gov.ps sec.ps plo.ps com.ps org.ps net.ps // pt : http://online.dns.pt/dns/start_dns pt net.pt gov.pt org.pt edu.pt int.pt publ.pt com.pt nome.pt // pw : http://en.wikipedia.org/wiki/.pw pw co.pw ne.pw or.pw ed.pw go.pw belau.pw // py : http://www.nic.py/pautas.html#seccion_9 // Confirmed by registry 2012-10-03 py com.py coop.py edu.py gov.py mil.py net.py org.py // qa : http://domains.qa/en/ qa com.qa edu.qa gov.qa mil.qa name.qa net.qa org.qa sch.qa // re : http://www.afnic.re/obtenir/chartes/nommage-re/annexe-descriptifs re com.re asso.re nom.re // ro : http://www.rotld.ro/ ro com.ro org.ro tm.ro nt.ro nom.ro info.ro rec.ro arts.ro firm.ro store.ro www.ro // rs : http://en.wikipedia.org/wiki/.rs rs co.rs org.rs edu.rs ac.rs gov.rs in.rs // ru : http://www.cctld.ru/ru/docs/aktiv_8.php // Industry domains ru ac.ru com.ru edu.ru int.ru net.ru org.ru pp.ru // Geographical domains adygeya.ru altai.ru amur.ru arkhangelsk.ru astrakhan.ru bashkiria.ru belgorod.ru bir.ru bryansk.ru buryatia.ru cbg.ru chel.ru chelyabinsk.ru chita.ru chukotka.ru chuvashia.ru dagestan.ru dudinka.ru e-burg.ru grozny.ru irkutsk.ru ivanovo.ru izhevsk.ru jar.ru joshkar-ola.ru kalmykia.ru kaluga.ru kamchatka.ru karelia.ru kazan.ru kchr.ru kemerovo.ru khabarovsk.ru khakassia.ru khv.ru kirov.ru koenig.ru komi.ru kostroma.ru krasnoyarsk.ru kuban.ru kurgan.ru kursk.ru lipetsk.ru magadan.ru mari.ru mari-el.ru marine.ru mordovia.ru mosreg.ru msk.ru murmansk.ru nalchik.ru nnov.ru nov.ru novosibirsk.ru nsk.ru omsk.ru orenburg.ru oryol.ru palana.ru penza.ru perm.ru pskov.ru ptz.ru rnd.ru ryazan.ru sakhalin.ru samara.ru saratov.ru simbirsk.ru smolensk.ru spb.ru stavropol.ru stv.ru surgut.ru tambov.ru tatarstan.ru tom.ru tomsk.ru tsaritsyn.ru tsk.ru tula.ru tuva.ru tver.ru tyumen.ru udm.ru udmurtia.ru ulan-ude.ru vladikavkaz.ru vladimir.ru vladivostok.ru volgograd.ru vologda.ru voronezh.ru vrn.ru vyatka.ru yakutia.ru yamal.ru yaroslavl.ru yekaterinburg.ru yuzhno-sakhalinsk.ru // More geographical domains amursk.ru baikal.ru cmw.ru fareast.ru jamal.ru kms.ru k-uralsk.ru kustanai.ru kuzbass.ru magnitka.ru mytis.ru nakhodka.ru nkz.ru norilsk.ru oskol.ru pyatigorsk.ru rubtsovsk.ru snz.ru syzran.ru vdonsk.ru zgrad.ru // State domains gov.ru mil.ru // Technical domains test.ru // rw : http://www.nic.rw/cgi-bin/policy.pl rw gov.rw net.rw edu.rw ac.rw com.rw co.rw int.rw mil.rw gouv.rw // sa : http://www.nic.net.sa/ sa com.sa net.sa org.sa gov.sa med.sa pub.sa edu.sa sch.sa // sb : http://www.sbnic.net.sb/ // Submitted by registry 2008-06-08 sb com.sb edu.sb gov.sb net.sb org.sb // sc : http://www.nic.sc/ sc com.sc gov.sc net.sc org.sc edu.sc // sd : http://www.isoc.sd/sudanic.isoc.sd/billing_pricing.htm // Submitted by registry 2008-06-17 sd com.sd net.sd org.sd edu.sd med.sd tv.sd gov.sd info.sd // se : http://en.wikipedia.org/wiki/.se // Submitted by registry 2008-06-24 se a.se ac.se b.se bd.se brand.se c.se d.se e.se f.se fh.se fhsk.se fhv.se g.se h.se i.se k.se komforb.se kommunalforbund.se komvux.se l.se lanbib.se m.se n.se naturbruksgymn.se o.se org.se p.se parti.se pp.se press.se r.se s.se sshn.se t.se tm.se u.se w.se x.se y.se z.se // sg : http://www.nic.net.sg/page/registration-policies-procedures-and-guidelines sg com.sg net.sg org.sg gov.sg edu.sg per.sg // sh : http://www.nic.sh/registrar.html sh com.sh net.sh gov.sh org.sh mil.sh // si : http://en.wikipedia.org/wiki/.si si // sj : No registrations at this time. // Submitted by registry 2008-06-16 // sk : http://en.wikipedia.org/wiki/.sk // list of 2nd level domains ? sk // sl : http://www.nic.sl // Submitted by registry 2008-06-12 sl com.sl net.sl edu.sl gov.sl org.sl // sm : http://en.wikipedia.org/wiki/.sm sm // sn : http://en.wikipedia.org/wiki/.sn sn art.sn com.sn edu.sn gouv.sn org.sn perso.sn univ.sn // so : http://www.soregistry.com/ so com.so net.so org.so // sr : http://en.wikipedia.org/wiki/.sr sr // st : http://www.nic.st/html/policyrules/ st co.st com.st consulado.st edu.st embaixada.st gov.st mil.st net.st org.st principe.st saotome.st store.st // su : http://en.wikipedia.org/wiki/.su su // sv : http://www.svnet.org.sv/svpolicy.html *.sv // sx : http://en.wikipedia.org/wiki/.sx // Confirmed by registry 2012-05-31 sx gov.sx // sy : http://en.wikipedia.org/wiki/.sy // see also: http://www.gobin.info/domainname/sy.doc sy edu.sy gov.sy net.sy mil.sy com.sy org.sy // sz : http://en.wikipedia.org/wiki/.sz // http://www.sispa.org.sz/ sz co.sz ac.sz org.sz // tc : http://en.wikipedia.org/wiki/.tc tc // td : http://en.wikipedia.org/wiki/.td td // tel: http://en.wikipedia.org/wiki/.tel // http://www.telnic.org/ tel // tf : http://en.wikipedia.org/wiki/.tf tf // tg : http://en.wikipedia.org/wiki/.tg // http://www.nic.tg/ tg // th : http://en.wikipedia.org/wiki/.th // Submitted by registry 2008-06-17 th ac.th co.th go.th in.th mi.th net.th or.th // tj : http://www.nic.tj/policy.html tj ac.tj biz.tj co.tj com.tj edu.tj go.tj gov.tj int.tj mil.tj name.tj net.tj nic.tj org.tj test.tj web.tj // tk : http://en.wikipedia.org/wiki/.tk tk // tl : http://en.wikipedia.org/wiki/.tl tl gov.tl // tm : http://www.nic.tm/local.html tm com.tm co.tm org.tm net.tm nom.tm gov.tm mil.tm edu.tm // tn : http://en.wikipedia.org/wiki/.tn // http://whois.ati.tn/ tn com.tn ens.tn fin.tn gov.tn ind.tn intl.tn nat.tn net.tn org.tn info.tn perso.tn tourism.tn edunet.tn rnrt.tn rns.tn rnu.tn mincom.tn agrinet.tn defense.tn turen.tn // to : http://en.wikipedia.org/wiki/.to // Submitted by registry 2008-06-17 to com.to gov.to net.to org.to edu.to mil.to // tr : http://en.wikipedia.org/wiki/.tr *.tr !nic.tr // Used by government in the TRNC // http://en.wikipedia.org/wiki/.nc.tr gov.nc.tr // travel : http://en.wikipedia.org/wiki/.travel travel // tt : http://www.nic.tt/ tt co.tt com.tt org.tt net.tt biz.tt info.tt pro.tt int.tt coop.tt jobs.tt mobi.tt travel.tt museum.tt aero.tt name.tt gov.tt edu.tt // tv : http://en.wikipedia.org/wiki/.tv // Not listing any 2LDs as reserved since none seem to exist in practice, // Wikipedia notwithstanding. tv // tw : http://en.wikipedia.org/wiki/.tw tw edu.tw gov.tw mil.tw com.tw net.tw org.tw idv.tw game.tw ebiz.tw club.tw 網路.tw 組織.tw 商業.tw // tz : http://www.tznic.or.tz/index.php/domains // Confirmed by registry 2013-01-22 ac.tz co.tz go.tz hotel.tz info.tz me.tz mil.tz mobi.tz ne.tz or.tz sc.tz tv.tz // ua : https://hostmaster.ua/policy/?ua // Submitted by registry 2012-04-27 ua // ua 2LD com.ua edu.ua gov.ua in.ua net.ua org.ua // ua geographic names // https://hostmaster.ua/2ld/ cherkassy.ua cherkasy.ua chernigov.ua chernihiv.ua chernivtsi.ua chernovtsy.ua ck.ua cn.ua cr.ua crimea.ua cv.ua dn.ua dnepropetrovsk.ua dnipropetrovsk.ua dominic.ua donetsk.ua dp.ua if.ua ivano-frankivsk.ua kh.ua kharkiv.ua kharkov.ua kherson.ua khmelnitskiy.ua khmelnytskyi.ua kiev.ua kirovograd.ua km.ua kr.ua krym.ua ks.ua kv.ua kyiv.ua lg.ua lt.ua lugansk.ua lutsk.ua lv.ua lviv.ua mk.ua mykolaiv.ua nikolaev.ua od.ua odesa.ua odessa.ua pl.ua poltava.ua rivne.ua rovno.ua rv.ua sb.ua sebastopol.ua sevastopol.ua sm.ua sumy.ua te.ua ternopil.ua uz.ua uzhgorod.ua vinnica.ua vinnytsia.ua vn.ua volyn.ua yalta.ua zaporizhzhe.ua zaporizhzhia.ua zhitomir.ua zhytomyr.ua zp.ua zt.ua // Private registries in .ua co.ua pp.ua // ug : https://www.registry.co.ug/ ug co.ug or.ug ac.ug sc.ug go.ug ne.ug com.ug org.ug // uk : http://en.wikipedia.org/wiki/.uk // Submitted by registry 2012-10-02 // and tweaked by us pending further consultation. *.uk *.sch.uk !bl.uk !british-library.uk !jet.uk !mod.uk !national-library-scotland.uk !nel.uk !nic.uk !nls.uk !parliament.uk // us : http://en.wikipedia.org/wiki/.us us dni.us fed.us isa.us kids.us nsn.us // us geographic names ak.us al.us ar.us as.us az.us ca.us co.us ct.us dc.us de.us fl.us ga.us gu.us hi.us ia.us id.us il.us in.us ks.us ky.us la.us ma.us md.us me.us mi.us mn.us mo.us ms.us mt.us nc.us nd.us ne.us nh.us nj.us nm.us nv.us ny.us oh.us ok.us or.us pa.us pr.us ri.us sc.us sd.us tn.us tx.us ut.us vi.us vt.us va.us wa.us wi.us wv.us wy.us // The registrar notes several more specific domains available in each state, // such as state.*.us, dst.*.us, etc., but resolution of these is somewhat // haphazard; in some states these domains resolve as addresses, while in others // only subdomains are available, or even nothing at all. We include the // most common ones where it's clear that different sites are different // entities. k12.ak.us k12.al.us k12.ar.us k12.as.us k12.az.us k12.ca.us k12.co.us k12.ct.us k12.dc.us k12.de.us k12.fl.us k12.ga.us k12.gu.us // k12.hi.us Hawaii has a state-wide DOE login: bug 614565 k12.ia.us k12.id.us k12.il.us k12.in.us k12.ks.us k12.ky.us k12.la.us k12.ma.us k12.md.us k12.me.us k12.mi.us k12.mn.us k12.mo.us k12.ms.us k12.mt.us k12.nc.us k12.nd.us k12.ne.us k12.nh.us k12.nj.us k12.nm.us k12.nv.us k12.ny.us k12.oh.us k12.ok.us k12.or.us k12.pa.us k12.pr.us k12.ri.us k12.sc.us k12.sd.us k12.tn.us k12.tx.us k12.ut.us k12.vi.us k12.vt.us k12.va.us k12.wa.us k12.wi.us k12.wv.us k12.wy.us cc.ak.us cc.al.us cc.ar.us cc.as.us cc.az.us cc.ca.us cc.co.us cc.ct.us cc.dc.us cc.de.us cc.fl.us cc.ga.us cc.gu.us cc.hi.us cc.ia.us cc.id.us cc.il.us cc.in.us cc.ks.us cc.ky.us cc.la.us cc.ma.us cc.md.us cc.me.us cc.mi.us cc.mn.us cc.mo.us cc.ms.us cc.mt.us cc.nc.us cc.nd.us cc.ne.us cc.nh.us cc.nj.us cc.nm.us cc.nv.us cc.ny.us cc.oh.us cc.ok.us cc.or.us cc.pa.us cc.pr.us cc.ri.us cc.sc.us cc.sd.us cc.tn.us cc.tx.us cc.ut.us cc.vi.us cc.vt.us cc.va.us cc.wa.us cc.wi.us cc.wv.us cc.wy.us lib.ak.us lib.al.us lib.ar.us lib.as.us lib.az.us lib.ca.us lib.co.us lib.ct.us lib.dc.us lib.de.us lib.fl.us lib.ga.us lib.gu.us lib.hi.us lib.ia.us lib.id.us lib.il.us lib.in.us lib.ks.us lib.ky.us lib.la.us lib.ma.us lib.md.us lib.me.us lib.mi.us lib.mn.us lib.mo.us lib.ms.us lib.mt.us lib.nc.us lib.nd.us lib.ne.us lib.nh.us lib.nj.us lib.nm.us lib.nv.us lib.ny.us lib.oh.us lib.ok.us lib.or.us lib.pa.us lib.pr.us lib.ri.us lib.sc.us lib.sd.us lib.tn.us lib.tx.us lib.ut.us lib.vi.us lib.vt.us lib.va.us lib.wa.us lib.wi.us lib.wv.us lib.wy.us // k12.ma.us contains school districts in Massachusetts. The 4LDs are // managed indepedently except for private (PVT), charter (CHTR) and // parochial (PAROCH) schools. Those are delegated dorectly to the // 5LD operators. pvt.k12.ma.us chtr.k12.ma.us paroch.k12.ma.us // uy : http://www.nic.org.uy/ uy com.uy edu.uy gub.uy mil.uy net.uy org.uy // uz : http://www.reg.uz/ uz co.uz com.uz net.uz org.uz // va : http://en.wikipedia.org/wiki/.va va // vc : http://en.wikipedia.org/wiki/.vc // Submitted by registry 2008-06-13 vc com.vc net.vc org.vc gov.vc mil.vc edu.vc // ve : https://registro.nic.ve/ // Confirmed by registry 2012-10-04 ve co.ve com.ve e12.ve edu.ve gov.ve info.ve mil.ve net.ve org.ve web.ve // vg : http://en.wikipedia.org/wiki/.vg vg // vi : http://www.nic.vi/newdomainform.htm // http://www.nic.vi/Domain_Rules/body_domain_rules.html indicates some other // TLDs are "reserved", such as edu.vi and gov.vi, but doesn't actually say they // are available for registration (which they do not seem to be). vi co.vi com.vi k12.vi net.vi org.vi // vn : https://www.dot.vn/vnnic/vnnic/domainregistration.jsp vn com.vn net.vn org.vn edu.vn gov.vn int.vn ac.vn biz.vn info.vn name.vn pro.vn health.vn // vu : http://en.wikipedia.org/wiki/.vu // list of 2nd level tlds ? vu // wf : http://www.afnic.fr/medias/documents/AFNIC-naming-policy2012.pdf wf // ws : http://en.wikipedia.org/wiki/.ws // http://samoanic.ws/index.dhtml ws com.ws net.ws org.ws gov.ws edu.ws // yt : http://www.afnic.fr/medias/documents/AFNIC-naming-policy2012.pdf yt // IDN ccTLDs // Please sort by ISO 3166 ccTLD, then punicode string // when submitting patches and follow this format: // ("" ) : // [optional sponsoring org] // // xn--mgbaam7a8h ("Emerat" Arabic) : AE // http://nic.ae/english/arabicdomain/rules.jsp امارات // xn--54b7fta0cc ("Bangla" Bangla) : BD বাংলা // xn--fiqs8s ("China" Chinese-Han-Simplified <.Zhonggou>) : CN // CNNIC // http://cnnic.cn/html/Dir/2005/10/11/3218.htm 中国 // xn--fiqz9s ("China" Chinese-Han-Traditional <.Zhonggou>) : CN // CNNIC // http://cnnic.cn/html/Dir/2005/10/11/3218.htm 中國 // xn--lgbbat1ad8j ("Algeria / Al Jazair" Arabic) : DZ الجزائر // xn--wgbh1c ("Egypt" Arabic .masr) : EG // http://www.dotmasr.eg/ مصر // xn--node ("ge" Georgian (Mkhedruli)) : GE გე // xn--j6w193g ("Hong Kong" Chinese-Han) : HK // https://www2.hkirc.hk/register/rules.jsp 香港 // xn--h2brj9c ("Bharat" Devanagari) : IN // India भारत // xn--mgbbh1a71e ("Bharat" Arabic) : IN // India بھارت // xn--fpcrj9c3d ("Bharat" Telugu) : IN // India భారత్ // xn--gecrj9c ("Bharat" Gujarati) : IN // India ભારત // xn--s9brj9c ("Bharat" Gurmukhi) : IN // India ਭਾਰਤ // xn--45brj9c ("Bharat" Bengali) : IN // India ভারত // xn--xkc2dl3a5ee0h ("India" Tamil) : IN // India இந்தியா // xn--mgba3a4f16a ("Iran" Persian) : IR ایران // xn--mgba3a4fra ("Iran" Arabic) : IR ايران // xn--mgbayh7gpa ("al-Ordon" Arabic) : JO // National Information Technology Center (NITC) // Royal Scientific Society, Al-Jubeiha الاردن // xn--3e0b707e ("Republic of Korea" Hangul) : KR 한국 // xn--fzc2c9e2c ("Lanka" Sinhalese-Sinhala) : LK // http://nic.lk ලංකා // xn--xkc2al3hye2a ("Ilangai" Tamil) : LK // http://nic.lk இலங்கை // xn--mgbc0a9azcg ("Morocco / al-Maghrib" Arabic) : MA المغرب // xn--mgb9awbf ("Oman" Arabic) : OM عمان // xn--ygbi2ammx ("Falasteen" Arabic) : PS // The Palestinian National Internet Naming Authority (PNINA) // http://www.pnina.ps فلسطين // xn--90a3ac ("srb" Cyrillic) : RS срб // xn--p1ai ("rf" Russian-Cyrillic) : RU // http://www.cctld.ru/en/docs/rulesrf.php рф // xn--wgbl6a ("Qatar" Arabic) : QA // http://www.ict.gov.qa/ قطر // xn--mgberp4a5d4ar ("AlSaudiah" Arabic) : SA // http://www.nic.net.sa/ السعودية // xn--mgberp4a5d4a87g ("AlSaudiah" Arabic) variant : SA السعودیة // xn--mgbqly7c0a67fbc ("AlSaudiah" Arabic) variant : SA السعودیۃ // xn--mgbqly7cvafr ("AlSaudiah" Arabic) variant : SA السعوديه // xn--ogbpf8fl ("Syria" Arabic) : SY سورية // xn--mgbtf8fl ("Syria" Arabic) variant : SY سوريا // xn--yfro4i67o Singapore ("Singapore" Chinese-Han) : SG 新加坡 // xn--clchc0ea0b2g2a9gcd ("Singapore" Tamil) : SG சிங்கப்பூர் // xn--o3cw4h ("Thai" Thai) : TH // http://www.thnic.co.th ไทย // xn--pgbs0dh ("Tunis") : TN // http://nic.tn تونس // xn--kpry57d ("Taiwan" Chinese-Han-Traditional) : TW // http://www.twnic.net/english/dn/dn_07a.htm 台灣 // xn--kprw13d ("Taiwan" Chinese-Han-Simplified) : TW // http://www.twnic.net/english/dn/dn_07a.htm 台湾 // xn--nnx388a ("Taiwan") variant : TW 臺灣 // xn--j1amh ("ukr" Cyrillic) : UA укр // xn--mgb2ddes ("AlYemen" Arabic) : YE اليمن // xxx : http://icmregistry.com xxx // ye : http://www.y.net.ye/services/domain_name.htm *.ye // za : http://www.zadna.org.za/slds.html *.za // zm : http://en.wikipedia.org/wiki/.zm *.zm // zw : http://en.wikipedia.org/wiki/.zw *.zw // ===END ICANN DOMAINS=== // ===BEGIN PRIVATE DOMAINS=== // Amazon CloudFront : https://aws.amazon.com/cloudfront/ // Requested by Donavan Miller 2013-03-22 cloudfront.net // Amazon Elastic Load Balancing : https://aws.amazon.com/elasticloadbalancing/ // Requested by Scott Vidmar 2013-03-27 elb.amazonaws.com // Amazon S3 : https://aws.amazon.com/s3/ // Requested by Courtney Eckhardt 2013-03-22 s3.amazonaws.com s3-us-west-2.amazonaws.com s3-us-west-1.amazonaws.com s3-eu-west-1.amazonaws.com s3-ap-southeast-1.amazonaws.com s3-ap-southeast-2.amazonaws.com s3-ap-northeast-1.amazonaws.com s3-sa-east-1.amazonaws.com s3-us-gov-west-1.amazonaws.com s3-fips-us-gov-west-1.amazonaws.com s3-website-us-east-1.amazonaws.com s3-website-us-west-2.amazonaws.com s3-website-us-west-1.amazonaws.com s3-website-eu-west-1.amazonaws.com s3-website-ap-southeast-1.amazonaws.com s3-website-ap-southeast-2.amazonaws.com s3-website-ap-northeast-1.amazonaws.com s3-website-sa-east-1.amazonaws.com s3-website-us-gov-west-1.amazonaws.com // BetaInABox // Requested by adrian@betainabox.com 2012-09-13 betainabox.com // CentralNic : http://www.centralnic.com/names/domains // Requested by registry 2012-09-27 ae.org ar.com br.com cn.com com.de de.com eu.com gb.com gb.net gr.com hu.com hu.net jp.net jpn.com kr.com no.com qc.com ru.com sa.com se.com se.net uk.com uk.net us.com us.org uy.com za.com // c.la : http://www.c.la/ c.la // co.ca : http://registry.co.ca/ co.ca // CoDNS B.V. co.nl co.no // DreamHost : http://www.dreamhost.com/ // Requested by Andrew Farmer 2012-10-02 dreamhosters.com // DynDNS.com : http://www.dyndns.com/services/dns/dyndns/ dyndns-at-home.com dyndns-at-work.com dyndns-blog.com dyndns-free.com dyndns-home.com dyndns-ip.com dyndns-mail.com dyndns-office.com dyndns-pics.com dyndns-remote.com dyndns-server.com dyndns-web.com dyndns-wiki.com dyndns-work.com dyndns.biz dyndns.info dyndns.org dyndns.tv at-band-camp.net ath.cx barrel-of-knowledge.info barrell-of-knowledge.info better-than.tv blogdns.com blogdns.net blogdns.org blogsite.org boldlygoingnowhere.org broke-it.net buyshouses.net cechire.com dnsalias.com dnsalias.net dnsalias.org dnsdojo.com dnsdojo.net dnsdojo.org does-it.net doesntexist.com doesntexist.org dontexist.com dontexist.net dontexist.org doomdns.com doomdns.org dvrdns.org dyn-o-saur.com dynalias.com dynalias.net dynalias.org dynathome.net dyndns.ws endofinternet.net endofinternet.org endoftheinternet.org est-a-la-maison.com est-a-la-masion.com est-le-patron.com est-mon-blogueur.com for-better.biz for-more.biz for-our.info for-some.biz for-the.biz forgot.her.name forgot.his.name from-ak.com from-al.com from-ar.com from-az.net from-ca.com from-co.net from-ct.com from-dc.com from-de.com from-fl.com from-ga.com from-hi.com from-ia.com from-id.com from-il.com from-in.com from-ks.com from-ky.com from-la.net from-ma.com from-md.com from-me.org from-mi.com from-mn.com from-mo.com from-ms.com from-mt.com from-nc.com from-nd.com from-ne.com from-nh.com from-nj.com from-nm.com from-nv.com from-ny.net from-oh.com from-ok.com from-or.com from-pa.com from-pr.com from-ri.com from-sc.com from-sd.com from-tn.com from-tx.com from-ut.com from-va.com from-vt.com from-wa.com from-wi.com from-wv.com from-wy.com ftpaccess.cc fuettertdasnetz.de game-host.org game-server.cc getmyip.com gets-it.net go.dyndns.org gotdns.com gotdns.org groks-the.info groks-this.info ham-radio-op.net here-for-more.info hobby-site.com hobby-site.org home.dyndns.org homedns.org homeftp.net homeftp.org homeip.net homelinux.com homelinux.net homelinux.org homeunix.com homeunix.net homeunix.org iamallama.com in-the-band.net is-a-anarchist.com is-a-blogger.com is-a-bookkeeper.com is-a-bruinsfan.org is-a-bulls-fan.com is-a-candidate.org is-a-caterer.com is-a-celticsfan.org is-a-chef.com is-a-chef.net is-a-chef.org is-a-conservative.com is-a-cpa.com is-a-cubicle-slave.com is-a-democrat.com is-a-designer.com is-a-doctor.com is-a-financialadvisor.com is-a-geek.com is-a-geek.net is-a-geek.org is-a-green.com is-a-guru.com is-a-hard-worker.com is-a-hunter.com is-a-knight.org is-a-landscaper.com is-a-lawyer.com is-a-liberal.com is-a-libertarian.com is-a-linux-user.org is-a-llama.com is-a-musician.com is-a-nascarfan.com is-a-nurse.com is-a-painter.com is-a-patsfan.org is-a-personaltrainer.com is-a-photographer.com is-a-player.com is-a-republican.com is-a-rockstar.com is-a-socialist.com is-a-soxfan.org is-a-student.com is-a-teacher.com is-a-techie.com is-a-therapist.com is-an-accountant.com is-an-actor.com is-an-actress.com is-an-anarchist.com is-an-artist.com is-an-engineer.com is-an-entertainer.com is-by.us is-certified.com is-found.org is-gone.com is-into-anime.com is-into-cars.com is-into-cartoons.com is-into-games.com is-leet.com is-lost.org is-not-certified.com is-saved.org is-slick.com is-uberleet.com is-very-bad.org is-very-evil.org is-very-good.org is-very-nice.org is-very-sweet.org is-with-theband.com isa-geek.com isa-geek.net isa-geek.org isa-hockeynut.com issmarterthanyou.com isteingeek.de istmein.de kicks-ass.net kicks-ass.org knowsitall.info land-4-sale.us lebtimnetz.de leitungsen.de likes-pie.com likescandy.com merseine.nu mine.nu misconfused.org mypets.ws myphotos.cc neat-url.com office-on-the.net on-the-web.tv podzone.net podzone.org readmyblog.org saves-the-whales.com scrapper-site.net scrapping.cc selfip.biz selfip.com selfip.info selfip.net selfip.org sells-for-less.com sells-for-u.com sells-it.net sellsyourhome.org servebbs.com servebbs.net servebbs.org serveftp.net serveftp.org servegame.org shacknet.nu simple-url.com space-to-rent.com stuff-4-sale.org stuff-4-sale.us teaches-yoga.com thruhere.net traeumtgerade.de webhop.biz webhop.info webhop.net webhop.org worse-than.tv writesthisblog.com // Google, Inc. // Requested by Eduardo Vela 2012-10-24 appspot.com blogspot.be blogspot.bj blogspot.ca blogspot.cf blogspot.ch blogspot.co.at blogspot.co.il blogspot.co.nz blogspot.co.uk blogspot.com blogspot.com.ar blogspot.com.au blogspot.com.br blogspot.com.es blogspot.cv blogspot.cz blogspot.de blogspot.dk blogspot.fi blogspot.fr blogspot.gr blogspot.hk blogspot.hu blogspot.ie blogspot.in blogspot.it blogspot.jp blogspot.kr blogspot.mr blogspot.mx blogspot.nl blogspot.no blogspot.pt blogspot.re blogspot.ro blogspot.se blogspot.sg blogspot.sk blogspot.td blogspot.tw codespot.com googleapis.com googlecode.com // iki.fi // Requested by Hannu Aronsson 2009-11-05 iki.fi // info.at : http://www.info.at/ biz.at info.at // Michau Enterprises Limited : http://www.co.pl/ co.pl // NYC.mn : http://www.information.nyc.mn // Requested by Matthew Brown 2013-03-11 nyc.mn // Opera Software, A.S.A. // Requested by Yngve Pettersen 2009-11-26 operaunite.com // Red Hat, Inc. OpenShift : https://openshift.redhat.com/ // Requested by Tim Kramer 2012-10-24 rhcloud.com // priv.at : http://www.nic.priv.at/ // Requested by registry 2008-06-09 priv.at // ZaNiC : http://www.za.net/ // Requested by registry 2009-10-03 za.net za.org // ===END PRIVATE DOMAINS=== qpsmtpd-0.94/t/config/rcpthosts000066400000000000000000000000121240247602400166140ustar00rootroot00000000000000localhost qpsmtpd-0.94/t/config/relayclients000066400000000000000000000006631240247602400172750ustar00rootroot00000000000000# used by plugins/relay # IPv4 format is IP, or IP part with trailing dot # e.g. "127.0.0.1", or "192.168." 127.0.0.1 # leading/trailing whitespace is ignored 192.0. # # IPv6 formats can be compressed or expanded, may include a prefixlen, # and can end on any nibble boundary. Nibble boundaries must be expressed # in expanded format. (RFC 3849 example) 2001:0DB8 2001:DB8::1 2001:DB8::1/32 2001:0DB8:0000:0000:0000:0000:0000:0001 qpsmtpd-0.94/t/helo.t000066400000000000000000000006701240247602400145210ustar00rootroot00000000000000use Test::More tests => 12; use strict; use lib 't'; use_ok('Test::Qpsmtpd'); ok(my ($smtpd, $conn) = Test::Qpsmtpd->new_conn(), "get new connection"); is(($smtpd->command('HELO localhost'))[0], 250, 'HELO localhost'); is(($smtpd->command('EHLO localhost'))[0], 503, 'EHLO localhost (duplicate!)'); ok(($smtpd, $conn) = Test::Qpsmtpd->new_conn(), "get new connection"); is(($smtpd->command('EHLO localhost'))[0], 250, 'EHLO localhost'); qpsmtpd-0.94/t/misc.t000066400000000000000000000013101240247602400145150ustar00rootroot00000000000000use Test::More tests => 12; use strict; use lib 't'; use_ok('Test::Qpsmtpd'); ok(my ($smtpd, $conn) = Test::Qpsmtpd->new_conn(), "get new connection"); # fault method is(($smtpd->fault)->[0], 451, 'fault returns 451'); is(($smtpd->fault("test message"))->[1], "Internal error - try again later - test message", 'returns the input message'); # vrfy command is(($smtpd->command('VRFY '))[0], 252, 'VRFY command'); # plugins/count_unrecognized_commands is(($smtpd->command('nonsense'))[0], 500, 'bad command 1'); is(($smtpd->command('nonsense'))[0], 500, 'bad command 2'); is(($smtpd->command('nonsense'))[0], 500, 'bad command 3'); is(($smtpd->command('nonsense'))[0], 521, 'bad command 4'); qpsmtpd-0.94/t/plugin_tests.t000066400000000000000000000003651240247602400163130ustar00rootroot00000000000000#!/usr/bin/perl -w use strict; use lib 't'; use Test::Qpsmtpd; my $qp = Test::Qpsmtpd->new(); $qp->run_plugin_tests(); foreach my $file ("./t/config/greylist.dbm", "./t/config/greylist.dbm.lock") { next if !-f $file; unlink $file; } qpsmtpd-0.94/t/plugin_tests/000077500000000000000000000000001240247602400161225ustar00rootroot00000000000000qpsmtpd-0.94/t/plugin_tests/auth/000077500000000000000000000000001240247602400170635ustar00rootroot00000000000000qpsmtpd-0.94/t/plugin_tests/auth/auth_checkpassword000066400000000000000000000022421240247602400226670ustar00rootroot00000000000000#!perl -w warn "loaded auth_checkpassword\n"; sub register_tests { my $self = shift; my ($vpopdir) = (getpwnam('vpopmail'))[7]; if ( ! $vpopdir ) { warn "skipping tests, vpopmail not installed\n"; return; }; if ( ! -d "$vpopdir/domains/example.com" ) { warn "skipping tests, no example users set up.\n"; return; }; $self->register_test("test_auth_checkpassword", 3); } my @u_list = qw ( good bad none ); my %u_data = ( good => [ 'postmaster@example.com', OK, 'Good Strong Passphrase' ], bad => [ 'bad@example.com', DENY, 'not_bad_pass' ], none => [ 'none@example.com', DECLINED, '' ], ); sub test_auth_checkpassword { my $self = shift; my ($tran, $ret, $note, $u, $r, $p, $a ); $tran = $self->qp->transaction; for $u ( @u_list ) { ( $a,$r,$p ) = @{$u_data{$u}}; ($ret, $note) = $self->auth_checkpassword($tran,'LOGIN',$a,$p); defined $note or $note='No-Message'; is ($ret, $r, $note); ($ret, $note) = $self->auth_checkpassword($tran,'PLAIN',$a,$p); defined $note or $note='No-Message'; is ($ret, $r, $note); } } qpsmtpd-0.94/t/plugin_tests/auth/auth_flat_file000066400000000000000000000013021240247602400217500ustar00rootroot00000000000000#!perl -w sub register_tests { my $self = shift; $self->register_test("test_auth_flat_file", 3); } my @u_list = qw ( good bad none ); my %u_data = ( good => [ 'good@example.com', OK, 'good_pass' ], bad => [ 'bad@example.com', DENY, 'not_bad_pass' ], none => [ 'none@example.com', DECLINED, '' ], ); sub test_auth_flat_file { my $self = shift; my ($tran, $ret, $note, $u, $r, $p, $a ); $tran = $self->qp->transaction; for $u ( @u_list ) { ( $a,$r,$p ) = @{$u_data{$u}}; ($ret, $note) = $self->auth_flat_file($tran,'CRAMMD5',$a,$p); defined $note or $note='authflat: No-Message'; is ($ret, $r, $note); # - for debugging. # warn "$note\n"; } } qpsmtpd-0.94/t/plugin_tests/auth/auth_vpopmail000066400000000000000000000016461240247602400216650ustar00rootroot00000000000000#!perl -w use strict; use warnings; use Qpsmtpd::Constants; sub register_tests { my $self = shift; $self->register_test("test_auth_vpopmail", 3); } my @u_list = qw ( good bad none ); my %u_data = ( good => [ 'postmaster@example.com', OK, 'Good Strong Passphrase' ], bad => [ 'bad@example.com', DENY, 'not_bad_pass' ], none => [ 'none@example.com', DECLINED, '' ], ); sub test_auth_vpopmail { my $self = shift; if ( ! $self->test_vpopmail_module ) { warn "vpopmail plugin not configured\n"; foreach ( 0..2) { ok( 1, "skipped") }; return; }; my ($tran, $ret, $note, $u, $r, $p, $a ); $tran = $self->qp->transaction; for $u ( @u_list ) { ( $a,$r,$p ) = @{$u_data{$u}}; ($ret, $note) = $self->auth_vpopmail($tran,'CRAMMD5',$a,$p); defined $note or $note='auth_vpopmail: No-Message'; is ($ret, $r, $note); } } qpsmtpd-0.94/t/plugin_tests/auth/auth_vpopmail_sql000066400000000000000000000021661240247602400225420ustar00rootroot00000000000000#!perl -w use strict; use warnings; sub register_tests { my $self = shift; eval 'use DBI'; if ( $@ ) { warn "skipping auth_vpopmail_sql tests, is DBI installed?\n"; return; }; $self->register_test("auth_vpopmail_sql", 3); } sub auth_vpopmail_sql { my $self = shift; my ( $transaction, $method, $user, $passClear, $passHash, $ticket ) = @_; my $dbh = $self->get_db_handle() or do { foreach ( 0..2 ) { ok( 1, "skipped (no DB)" ); }; return; }; ok( $dbh, "auth_vpopmail_sql, got a dbh" ); my $vuser = $self->get_vpopmail_user( $dbh, 'postmaster@example.com' ); if ( ! $vuser || ! $vuser->{pw_passwd} ) { foreach ( 0..1 ) { ok( 1, "no example.com domain" ); }; return; }; ok( ref $vuser, "found example.com domain" ); ok( $self->auth_vmysql( $self->qp->transaction, 'PLAIN', 'postmaster@example.com', $vuser->{pw_clear_passwd}, $vuser->{pw_passwd}, $ticket, ), "postmaster" ); } qpsmtpd-0.94/t/plugin_tests/auth/auth_vpopmaild000066400000000000000000000013101240247602400220150ustar00rootroot00000000000000#!perl -w warn "loaded test auth_vpopmaild\n"; sub register_tests { my $self = shift; $self->register_test("test_auth_vpopmaild", 3); } my @u_list = qw ( good bad none ); my %u_data = ( good => [ 'postmaster@example.com', OK, 'Good Strong Passphrase' ], bad => [ 'bad@example.com', DENY, 'not_bad_pass' ], none => [ 'none@example.com', DECLINED, '' ], ); sub test_auth_vpopmaild { my $self = shift; my ($tran, $ret, $note, $u, $r, $p, $a ); $tran = $self->qp->transaction; for $u ( @u_list ) { ( $a,$r,$p ) = @{$u_data{$u}}; ($ret, $note) = $self->auth_vpopmaild($tran,'LOGIN',$a,$p); defined $note or $note='No-Message'; is ($ret, $r, $note); } } qpsmtpd-0.94/t/plugin_tests/auth/authdeny000066400000000000000000000005731240247602400206340ustar00rootroot00000000000000#!perl -w sub register_tests { my $self = shift; $self->register_test("test_authdeny", 1); } sub test_authdeny { my $self = shift; my $address = Qpsmtpd::Address->parse(''); my ($ret, $note) = $self->hook_auth($self->qp->transaction, 'bogus_method', 'bogus_user'); is ($ret, DECLINED, "bogus_user is not free to abuse my relay"); } qpsmtpd-0.94/t/plugin_tests/auth/authnull000066400000000000000000000005611240247602400206440ustar00rootroot00000000000000#!perl -w sub register_tests { my $self = shift; $self->register_test("test_authnull", 1); } sub test_authnull { my $self = shift; my $address = Qpsmtpd::Address->parse(''); my ($ret, $note) = $self->hook_auth($self->qp->transaction, 'bogus_method', 'bogus_user'); is ($ret, OK, "bogus_user is free to abuse my relay"); } qpsmtpd-0.94/t/plugin_tests/badmailfrom000066400000000000000000000064141240247602400203270ustar00rootroot00000000000000#!perl -w use strict; use Data::Dumper; use Qpsmtpd::Address; use Qpsmtpd::Constants; sub register_tests { my $self = shift; $self->register_test("test_badmailfrom_is_immune_sender", 5); $self->register_test("test_badmailfrom_match", 7); $self->register_test("test_badmailfrom_hook_mail", 4); } sub test_badmailfrom_is_immune_sender { my $self = shift; my $transaction = $self->qp->transaction; my $test_email = 'matt@test.com'; my $address = Qpsmtpd::Address->new( "<$test_email>" ); $transaction->sender($address); ok( $self->is_immune_sender( $transaction->sender, [] ), "empty list"); $address = Qpsmtpd::Address->new( '<>' ); $transaction->sender($address); ok( $self->is_immune_sender( $transaction->sender, ['bad@example.com'] ), "null sender"); $address = Qpsmtpd::Address->new( '' ); $transaction->sender($address); ok( $self->is_immune_sender( $transaction->sender, ['bad@example.com'] ), "missing host"); $address = Qpsmtpd::Address->new( '<@example.com>' ); $transaction->sender($address); ok( $self->is_immune_sender( $transaction->sender, ['bad@example.com'] ), "missing user"); $address = Qpsmtpd::Address->new( '' ); $transaction->sender($address); ok( ! $self->is_immune_sender( $transaction->sender, ['bad@example.com'] ), "false"); }; sub test_badmailfrom_hook_mail { my $self = shift; $self->_reset_connection_flags(); my $transaction = $self->qp->transaction; my $test_email = 'matt@test.com'; my $address = Qpsmtpd::Address->new( "<$test_email>" ); $transaction->sender($address); $self->{_badmailfrom_config} = ['matt@test.net','matt@test.com']; $self->{_args}{reject} = 1; $transaction->notes('naughty', ''); my ($r, $err) = $self->hook_mail( $transaction, $address ); cmp_ok( $r, '==', DENY, "hook_mail rc"); cmp_ok( $err, 'eq', 'Your envelope sender is in my badmailfrom list', "default reason"); $self->{_badmailfrom_config} = ['matt@test.net','matt@test.com Yer a spammin bastert']; $transaction->notes('naughty', ''); ($r, $err) = $self->hook_mail( $transaction, $address ); cmp_ok( $r, '==', DENY, "hook_mail rc"); cmp_ok( $err, 'eq', 'Yer a spammin bastert', "custom reason"); }; sub test_badmailfrom_match { my $self = shift; # is_match receives ( $from, $bad, $host ) my $r = $self->is_match( 'matt@test.net', 'matt@test.net', 'test.net' ); ok($r, "match"); ok( ! $self->is_match( 'matt@test.net', 'matt@test.com', 'tnpi.net' ), "non-match"); ok( $self->is_match( 'matt@test.net', '@test.net', 'test.net' ), "match host"); ok( ! $self->is_match( 'matt@test.net', '@test.not', 'test.net' ), "non-match host"); ok( ! $self->is_match( 'matt@test.net', '@test.net', 'test.not' ), "non-match host"); ok( $self->is_match( 'matt@test.net', 'test.net$', 'tnpi.net' ), "pattern match"); ok( ! $self->is_match( 'matt@test.net', 'test.not$', 'tnpi.net' ), "pattern non-match"); }; sub _reset_connection_flags { my $self = shift; $self->qp->connection->relay_client(0); $self->qp->connection->notes('whitelisthost', 0); $self->connection->notes('naughty',0); $self->connection->notes('rejected', 0); }; qpsmtpd-0.94/t/plugin_tests/badmailfromto000066400000000000000000000022421240247602400206650ustar00rootroot00000000000000#!perl -w use strict; use Data::Dumper; use Qpsmtpd::Address; sub register_tests { my $self = shift; $self->register_test("test_badmailfromto_is_sender_immune", 5); } sub test_badmailfromto_is_sender_immune { my $self = shift; my $transaction = $self->qp->transaction; my $test_email = 'matt@test.com'; $transaction->sender( Qpsmtpd::Address->new( "<$test_email>" ) ); ok( $self->is_sender_immune( $transaction->sender, [] ), "is_immune, empty list"); $transaction->sender( Qpsmtpd::Address->new( '<>' ) ); ok( $self->is_sender_immune( $transaction->sender, ['bad@example.com'] ), "null sender"); my $address = Qpsmtpd::Address->new( '' ); $transaction->sender($address); ok( $self->is_sender_immune( $transaction->sender, ['bad@example.com'] ), "missing host"); $address = Qpsmtpd::Address->new( '<@example.com>' ); $transaction->sender($address); ok( $self->is_sender_immune( $transaction->sender, ['bad@example.com'] ), "missing user"); $transaction->sender( Qpsmtpd::Address->new( '' ) ); ok( ! $self->is_sender_immune( $transaction->sender, ['bad@example.com'] ), "false"); }; qpsmtpd-0.94/t/plugin_tests/badrcptto000066400000000000000000000063041240247602400200320ustar00rootroot00000000000000#!perl -w use strict; use warnings; use Qpsmtpd::Constants; sub register_tests { my $self = shift; $self->register_test("test_is_match", 10); $self->register_test("test_hook_rcpt", 3); $self->register_test("test_get_host_and_to", 8); } sub _reset_connection_flags { my $self = shift; $self->qp->connection->relay_client(0); $self->qp->connection->notes('whitelisthost', 0); $self->connection->notes('naughty',0); $self->connection->notes('rejected', 0); }; sub test_is_match { my $self = shift; # is_match receives ( $to, $bad, $host ) my $r = $self->is_match( 'matt@example.com', 'matt@example.com', 'example.com' ); ok($r, "match"); ok( $self->is_match( 'matt@exAmple.com', 'matt@example.com', 'tnpi.com' ), "case insensitive match"); ok( $self->is_match( 'mAtt@example.com', 'matt@example.com', 'tnpi.com' ), "case insensitive match +"); ok( ! $self->is_match( 'matt@exmple.com', 'matt@example.com', 'tnpi.com' ), "non-match"); ok( ! $self->is_match( 'matt@example.com', 'matt@exAple.com', 'tnpi.com' ), "case insensitive non-match"); ok( $self->is_match( 'matt@example.com', '@example.com', 'example.com' ), "match host"); ok( ! $self->is_match( 'matt@example.com', '@example.not', 'example.com' ), "non-match host"); ok( ! $self->is_match( 'matt@example.com', '@example.com', 'example.not' ), "non-match host"); ok( $self->is_match( 'matt@example.com', 'example.com$', 'tnpi.com' ), "pattern match"); ok( ! $self->is_match( 'matt@example.com', 'example.not$', 'tnpi.com' ), "pattern non-match"); }; sub test_hook_rcpt { my $self = shift; $self->_reset_connection_flags(); my $transaction = $self->qp->transaction; my $recipient = Qpsmtpd::Address->new( '' ); my ($r, $mess) = $self->hook_rcpt( $transaction, $recipient ); cmp_ok( $r, '==', DECLINED, "valid +"); $recipient = Qpsmtpd::Address->new( '' ); ($r, $mess) = $self->hook_rcpt( $transaction, $recipient ); cmp_ok( $r, '==', DENY, "bad match, +, $mess"); $recipient = Qpsmtpd::Address->new( '' ); ($r, $mess) = $self->hook_rcpt( $transaction, $recipient ); cmp_ok( $r, '==', DENY, "bad host match, +, $mess"); }; sub test_get_host_and_to { my $self = shift; my $recipient = Qpsmtpd::Address->new( '<>' ); my ($host, $to) = $self->get_host_and_to( $recipient ); ok( ! $host, "null recipient -"); $recipient = Qpsmtpd::Address->new( '' ); ($host, $to) = $self->get_host_and_to( $recipient ); ok( ! $host, "missing host -"); ok( ! $to, "unparseable to -"); $recipient = Qpsmtpd::Address->new( '' ); ($host, $to) = $self->get_host_and_to( $recipient ); ok( $host, "valid host +"); ok( $to, "valid to +"); cmp_ok( $to, 'eq', 'user@example.com', "valid to +"); $recipient = Qpsmtpd::Address->new( '' ); ($host, $to) = $self->get_host_and_to( $recipient ); cmp_ok( $host, 'eq', 'example.com', "case normalized +"); cmp_ok( $to, 'eq', 'user@example.com', "case normalized +"); }; qpsmtpd-0.94/t/plugin_tests/count_unrecognized_commands000066400000000000000000000015111240247602400236300ustar00rootroot00000000000000#!perl -w use strict; use warnings; use Qpsmtpd::Constants; sub register_tests { my $self = shift; $self->register_test('test_hook_unrecognized_command', 4); }; sub test_hook_unrecognized_command { my $self = shift; $self->{_unrec_cmd_max} = 2; $self->connection->notes( 'unrec_cmd_count', 0 ); my ($code, $mess) = $self->hook_unrecognized_command(undef,'hiya'); cmp_ok( $code, '==', DECLINED, "good" ); $self->connection->notes( 'unrec_cmd_count', 2 ); ($code, $mess) = $self->hook_unrecognized_command(undef,'snookums'); cmp_ok( $code, '==', DENY_DISCONNECT, "limit" ); ($code, $mess) = $self->hook_unrecognized_command(undef,'wtf'); cmp_ok( $code, '==', DENY_DISCONNECT, "over limit" ); cmp_ok( $self->connection->notes( 'unrec_cmd_count'), '==', 4, "correct increment" ); }; qpsmtpd-0.94/t/plugin_tests/dmarc000066400000000000000000000034371240247602400171420ustar00rootroot00000000000000#!perl -w use strict; use Data::Dumper; use POSIX qw(strftime); use Qpsmtpd::Address; use Qpsmtpd::Constants; my $test_email = 'matt@tnpi.net'; sub register_tests { my $self = shift; # TODO: test against newer DMARC plugin that uses Mail::DMARC } sub setup_test_headers { my $self = shift; my $transaction = $self->qp->transaction; my $address = Qpsmtpd::Address->new( "<$test_email>" ); my $header = Mail::Header->new(Modify => 0, MailFrom => "COERCE"); my $now = strftime "%a %b %e %H:%M:%S %Y", localtime time; $transaction->sender($address); $transaction->header($header); $transaction->header->add('From', "<$test_email>"); $transaction->header->add('Date', $now ); $transaction->body_write( "test message body " ); $self->qp->connection->relay_client(0); }; sub test_fetch_dmarc_record { my $self = shift; foreach ( qw/ tnpi.net nictool.com / ) { my @matches = $self->fetch_dmarc_record($_); #warn Data::Dumper::Dumper(\@matches); cmp_ok( scalar @matches, '==', 1, 'fetch_dmarc_record'); }; foreach ( qw/ example.com / ) { my @matches = $self->fetch_dmarc_record($_); cmp_ok( scalar @matches, '==', 0, 'fetch_dmarc_record'); }; }; sub test_get_organizational_domain { my $self = shift; $self->setup_test_headers(); my $transaction = $self->qp->transaction; cmp_ok( $self->get_organizational_domain('test.www.tnpi.net'), 'eq', 'tnpi.net' ); cmp_ok( $self->get_organizational_domain('www.example.co.uk'), 'eq', 'example.co.uk' ); cmp_ok( $self->get_organizational_domain('plus.google.com'), 'eq', 'google.com' ); }; sub test_discover_policy { my $self = shift; $self->setup_test_headers(); ok( $self->discover_policy( 'tnpi.net' ), 'discover_policy' ); }; qpsmtpd-0.94/t/plugin_tests/dnsbl000066400000000000000000000043271240247602400171550ustar00rootroot00000000000000#!perl -w use strict; use warnings; use Qpsmtpd::Constants; sub register_tests { my $self = shift; $self->register_test('test_hook_connect', 1); $self->register_test('test_ip_whitelisted', 3); $self->register_test('test_is_set_rblsmtpd', 4); $self->register_test('test_reject_type', 3); } sub test_ip_whitelisted { my $self = shift; $self->qp->connection->remote_ip('192.168.99.5'); ok( $self->ip_whitelisted(), "+"); $self->qp->connection->remote_ip('192.168.99.6'); ok( ! $self->ip_whitelisted(), "-"); $self->qp->connection->remote_ip('192.168.99.5'); $self->qp->connection->notes('whitelisthost', 'hello honey!'); ok( $self->ip_whitelisted(), "+"); $self->qp->connection->notes('whitelisthost', undef); }; sub test_is_set_rblsmtpd { my $self = shift; $self->qp->connection->remote_ip('10.1.1.1'); ok( ! defined $self->is_set_rblsmtpd('10.1.1.1'), "undef"); $ENV{RBLSMTPD} = "Yes we can!"; cmp_ok( 'Yes we can!','eq',$self->is_set_rblsmtpd('10.1.1.1'), "value"); $ENV{RBLSMTPD} = "Oh yeah?"; cmp_ok( 'Oh yeah?','eq',$self->is_set_rblsmtpd('10.1.1.1'), "value"); $ENV{RBLSMTPD} = ''; cmp_ok( 1,'==',$self->is_set_rblsmtpd('10.1.1.1'), "empty"); }; sub test_hook_connect { my $self = shift; # reset values that other tests may have fiddled with my $conn = $self->qp->connection; $conn->relay_client(0); # other tests may leave it enabled $conn->notes('whitelisthost', undef ); $conn->notes('whitelistsender', undef); $conn->notes('naughty', undef); $conn->remote_ip('127.0.0.2'); # standard dnsbl test value my ($rc, $mess) = $self->hook_connect($self->qp->transaction); if ( $rc == DENY ) { cmp_ok( $rc, '==', DENY, "connect +"); } else { ok( 1, "connect +, skipped (is DNS working?)" ); }; } sub test_reject_type { my $self = shift; $self->{_args}{reject_type} = undef; cmp_ok( $self->get_reject_type(), '==', DENY, "default"); $self->{_args}{reject_type} = 'temp'; cmp_ok( $self->get_reject_type(), '==', DENYSOFT, "defer"); $self->{_args}{reject_type} = 'disconnect'; cmp_ok( $self->get_reject_type(), '==', DENY_DISCONNECT, "disconnect"); }; qpsmtpd-0.94/t/plugin_tests/dspam000066400000000000000000000062121240247602400171520ustar00rootroot00000000000000#!perl -w use strict; use warnings; use Mail::Header; use Qpsmtpd::Constants; my $r; sub register_tests { my $self = shift; $self->register_test('test_get_dspam_results', 6); $self->register_test('test_log_and_return', 6); $self->register_test('test_reject_type', 3); } sub test_log_and_return { my $self = shift; my $transaction = $self->qp->transaction; # reject not set $self->{_args}{reject} = undef; $transaction->notes('dspam', { class=> 'Spam', probability => .99, confidence=>1 } ); ($r) = $self->log_and_return( $transaction ); cmp_ok( $r, '==', DECLINED, "($r)"); # reject exceeded $self->{_args}{reject} = .95; $transaction->notes('dspam', { class=> 'Spam', probability => .99, confidence=>1 } ); ($r) = $self->log_and_return( $transaction ); cmp_ok( $r, '==', DENY, "($r)"); # below reject threshold $transaction->notes('dspam', { class=> 'Spam', probability => .94, confidence=>1 } ); ($r) = $self->log_and_return( $transaction ); cmp_ok( $r, '==', DECLINED, "($r)"); # requires agreement $self->{_args}{reject} = 'agree'; $transaction->notes('spamassassin', { is_spam => 'Yes', score => 25 } ); $transaction->notes('dspam', { class=> 'Spam', probability => .90, confidence=>1 } ); ($r) = $self->log_and_return( $transaction ); cmp_ok( $r, '==', DENY, "($r)"); # requires agreement $transaction->notes('spamassassin', { is_spam => 'No', score => 15 } ); $transaction->notes('dspam', { class=> 'Spam', probability => .96, confidence=>1 } ); ($r) = $self->log_and_return( $transaction ); cmp_ok( $r, '==', DECLINED, "($r)"); # requires agreement $transaction->notes('spamassassin', { is_spam => 'Yes', score => 10 } ); $transaction->notes('dspam', { class=> 'Innocent', probability => .96, confidence=>1 } ); ($r) = $self->log_and_return( $transaction ); cmp_ok( $r, '==', DECLINED, "($r)"); }; sub test_get_dspam_results { my $self = shift; my $transaction = $self->qp->transaction; my $header = Mail::Header->new(Modify => 0, MailFrom => "COERCE"); $transaction->header( $header ); my @dspam_sample_headers = ( 'Innocent, probability=0.0000, confidence=0.69', 'Innocent, probability=0.0000, confidence=0.85', 'Innocent, probability=0.0023, confidence=1.00', 'Spam, probability=1.0000, confidence=0.87', 'Spam, probability=1.0000, confidence=0.99', 'Whitelisted', ); foreach my $header ( @dspam_sample_headers ) { $transaction->header->delete('X-DSPAM-Result'); $transaction->header->add('X-DSPAM-Result', $header); my $r = $self->get_dspam_results($transaction); ok( ref $r, "r: ($header)" ); #warn Data::Dumper::Dumper($r); }; }; sub test_reject_type { my $self = shift; $self->{_args}{reject_type} = undef; cmp_ok( $self->get_reject_type(), '==', DENY, "default"); $self->{_args}{reject_type} = 'temp'; cmp_ok( $self->get_reject_type(), '==', DENYSOFT, "defer"); $self->{_args}{reject_type} = 'disconnect'; cmp_ok( $self->get_reject_type(), '==', DENY_DISCONNECT, "disconnect"); }; qpsmtpd-0.94/t/plugin_tests/earlytalker000066400000000000000000000104651240247602400203720ustar00rootroot00000000000000#!perl -w use strict; use warnings; use Qpsmtpd::Constants; sub register_tests { my $self = shift; $self->register_test('test_reject_type', 3); $self->register_test('test_log_and_pass', 1); $self->register_test('test_log_and_deny', 3); $self->register_test('test_data_handler', 3); $self->register_test('test_connect_handler', 3); $self->register_test('test_apr_data_handler', 3); $self->register_test('test_apr_connect_handler', 3); $self->register_test('test_mail_handler', 4); } sub test_apr_connect_handler { my $self = shift; $self->{_args}{'check-at'} = undef; my ($code, $mess) = $self->apr_connect_handler(); cmp_ok( $code, '==', DECLINED, "no check-at set"); $self->{_args}{'check-at'}{'DATA'} = 1; $self->qp->connection->notes('whitelisthost', 1); ($code, $mess) = $self->apr_connect_handler(); cmp_ok( $code, '==', DECLINED, "whitelisted host"); $self->qp->connection->notes('whitelisthost', 0); ($code, $mess) = $self->apr_connect_handler(); cmp_ok( $code, '==', DECLINED, "not sure"); }; sub test_apr_data_handler { my $self = shift; $self->{_args}{'check-at'} = undef; my ($code, $mess) = $self->apr_data_handler(); cmp_ok( $code, '==', DECLINED, "no check-at set"); $self->{_args}{'check-at'}{'DATA'} = 1; $self->qp->connection->notes('whitelisthost', 1); ($code, $mess) = $self->apr_data_handler(); cmp_ok( $code, '==', DECLINED, "whitelisted host"); $self->qp->connection->notes('whitelisthost', 0); ($code, $mess) = $self->apr_data_handler(); cmp_ok( $code, '==', DECLINED, "not sure"); }; sub test_connect_handler { my $self = shift; $self->{_args}{'check-at'} = undef; my ($code, $mess) = $self->connect_handler(); cmp_ok( $code, '==', DECLINED, "no check-at set"); $self->{_args}{'check-at'}{'CONNECT'} = 1; $self->qp->connection->notes('whitelisthost', 1); ($code, $mess) = $self->connect_handler(); cmp_ok( $code, '==', DECLINED, "whitelisted host"); $self->qp->connection->notes('whitelisthost', 0); ($code, $mess) = $self->connect_handler(); cmp_ok( $code, '==', DECLINED, "not sure"); }; sub test_data_handler { my $self = shift; $self->{_args}{'check-at'} = undef; my ($code, $mess) = $self->data_handler(); cmp_ok( $code, '==', DECLINED, "no check-at set"); $self->{_args}{'check-at'}{'DATA'} = 1; $self->qp->connection->notes('whitelisthost', 1); ($code, $mess) = $self->data_handler(); cmp_ok( $code, '==', DECLINED, "whitelisted host"); $self->qp->connection->notes('whitelisthost', 0); ($code, $mess) = $self->data_handler(); cmp_ok( $code, '==', DECLINED, "not sure"); }; sub test_log_and_pass { my $self = shift; my ($code, $mess) = $self->log_and_pass(); cmp_ok( $code, '==', DECLINED, "default"); }; sub test_log_and_deny { my $self = shift; $self->{_args}{reject_type} = undef; my ($code, $mess) = $self->log_and_deny(); cmp_ok( $code, '==', DENY, "default"); $self->{_args}{reject_type} = 'temp'; ($code, $mess) = $self->log_and_deny(); cmp_ok( $code, '==', DENYSOFT, "bad, temp"); $self->{_args}{reject_type} = 'disconnect'; ($code, $mess) = $self->log_and_deny(); cmp_ok( $code, '==', DENY_DISCONNECT, "bad, disconnect"); }; sub test_mail_handler { my $self = shift; $self->{_args}{reject_type} = undef; $self->qp->connection->notes('earlytalker', 0); my ($code, $mess) = $self->mail_handler(); cmp_ok( $code, '==', DECLINED, "good"); $self->qp->connection->notes('earlytalker', 1); ($code, $mess) = $self->mail_handler(); cmp_ok( $code, '==', DENY, "bad"); $self->{_args}{reject_type} = 'temp'; ($code, $mess) = $self->mail_handler(); cmp_ok( $code, '==', DENYSOFT, "bad, temp"); $self->{_args}{reject_type} = 'disconnect'; ($code, $mess) = $self->mail_handler(); cmp_ok( $code, '==', DENY_DISCONNECT, "bad, disconnect"); }; sub test_reject_type { my $self = shift; $self->{_args}{reject_type} = undef; cmp_ok( $self->get_reject_type(), '==', DENY, "default"); $self->{_args}{reject_type} = 'temp'; cmp_ok( $self->get_reject_type(), '==', DENYSOFT, "defer"); $self->{_args}{reject_type} = 'disconnect'; cmp_ok( $self->get_reject_type(), '==', DENY_DISCONNECT, "disconnect"); }; qpsmtpd-0.94/t/plugin_tests/greylisting000066400000000000000000000112621240247602400204070ustar00rootroot00000000000000#!perl -w use strict; use warnings; use Qpsmtpd::Address; use Qpsmtpd::Constants; my $test_email = 'user@example.com'; my @greydbs = qw( denysoft_greylist.dbm denysoft_greylist.dbm.lock ); foreach ( @greydbs ) { unlink $_ if -f $_; }; sub register_tests { my $self = shift; $self->register_test('test_hook_data', 4); $self->register_test('test_get_db_key', 4); $self->register_test('test_get_db_location', 1); $self->register_test("test_greylist_geoip", 7); $self->register_test("test_greylist_p0f_genre", 2); $self->register_test("test_greylist_p0f_distance", 2); $self->register_test("test_greylist_p0f_link", 2); $self->register_test("test_greylist_p0f_uptime", 2); } sub test_hook_data { my $self = shift; my $transaction = $self->qp->transaction; my ($code, $mess) = $self->hook_data( $transaction ); cmp_ok( $code, '==', DECLINED, "no note" ); $transaction->notes('greylist', 1); ($code, $mess) = $self->hook_data( $transaction ); cmp_ok( $code, '==', DECLINED, "no recipients"); my $address = Qpsmtpd::Address->new( "<$test_email>" ); $transaction->recipients( $address ); $transaction->notes('whitelistrcpt', 2); ($code, $mess) = $self->hook_data( $transaction ); cmp_ok( $code, '==', DENYSOFT, "missing recipients"); $transaction->notes('whitelistrcpt', 1); ($code, $mess) = $self->hook_data( $transaction ); cmp_ok( $code, '==', DECLINED, "missing recipients"); }; sub test_get_db_key { my $self = shift; $self->{_args}{sender} = 0; $self->{_args}{recipient} = 0; $self->{_args}{remote_ip} = 0; my $test_ip = '192.168.1.1'; my $address = Qpsmtpd::Address->new( "<$test_email>" ); $self->qp->transaction->sender( $address ); $self->qp->transaction->add_recipient( $address ); $self->qp->connection->remote_ip($test_ip); my $key = $self->get_db_key(); ok( ! $key, "db key empty: -"); $self->{_args}{remote_ip} = 1; $key = $self->get_db_key( $address, $address ); cmp_ok( $key, 'eq', '3232235777', "db key: $key"); $self->{_args}{sender} = 1; $key = $self->get_db_key( $address, $address ); cmp_ok( $key, 'eq', "3232235777:$test_email", "db key: $key"); $self->{_args}{recipient} = 1; $key = $self->get_db_key( $address, $address ); cmp_ok( $key, 'eq', "3232235777:$test_email:$test_email", "db key: $key"); }; sub test_get_db_location { my $self = shift; my $db = $self->get_db_location(); ok( $db, "db location: $db"); }; sub test_greylist_geoip { my $self = shift; $self->{_args}{'geoip'} = 'US,UK,HU'; my @valid = qw/ US us UK hu /; my @invalid = qw/ PK RU ru /; foreach my $cc ( @valid ) { $self->connection->notes('geoip_country', $cc ); ok( $self->geoip_match(), "match + ($cc)"); }; foreach my $cc ( @invalid ) { $self->connection->notes('geoip_country', $cc ); ok( ! $self->geoip_match(), "bad - ($cc)"); }; }; sub test_greylist_p0f_genre { my $self = shift; $self->{_args}{'p0f'} = 'genre,Linux'; $self->connection->notes('p0f'=> { genre => 'windows', link => 'dsl' } ); ok( ! $self->p0f_match(), 'p0f genre miss'); $self->{_args}{'p0f'} = 'genre,Windows'; $self->connection->notes('p0f'=> { genre => 'windows', link => 'dsl' } ); ok( $self->p0f_match(), 'p0f genre hit'); } sub test_greylist_p0f_distance { my $self = shift; $self->{_args}{'p0f'} = 'distance,8'; $self->connection->notes('p0f'=> { distance=>9 } ); ok( $self->p0f_match(), 'p0f distance hit'); $self->{_args}{'p0f'} = 'distance,8'; $self->connection->notes('p0f'=> { distance=>7 } ); ok( ! $self->p0f_match(), 'p0f distance miss'); } sub test_greylist_p0f_link { my $self = shift; $self->{_args}{'p0f'} = 'link,dsl'; $self->connection->notes('p0f'=> { link=>'DSL' } ); ok( $self->p0f_match(), 'p0f link hit'); $self->{_args}{'p0f'} = 'link,dsl'; $self->connection->notes('p0f'=> { link=>'Ethernet' } ); ok( ! $self->p0f_match(), 'p0f link miss'); } sub test_greylist_p0f_uptime { my $self = shift; $self->{_args}{'p0f'} = 'uptime,100'; $self->connection->notes('p0f'=> { uptime=> 99 } ); ok( $self->p0f_match(), 'p0f uptime hit'); $self->{_args}{'p0f'} = 'uptime,100'; $self->connection->notes('p0f'=> { uptime=>500 } ); ok( ! $self->p0f_match(), 'p0f uptime miss'); } sub _reset_transaction { my $self = shift; $self->qp->connection->relay_client(0); $self->qp->transaction->notes('whitelistsender',0); $self->connection->notes('whitelisthost',0); $self->qp->transaction->notes('tls_enabled',0); $self->{_args}{p0f} = undef; $self->{_args}{geoip} = undef; }; qpsmtpd-0.94/t/plugin_tests/headers000066400000000000000000000102401240247602400174550ustar00rootroot00000000000000#!perl -w use strict; use Data::Dumper; use POSIX qw(strftime); use Qpsmtpd::Address; use Qpsmtpd::Constants; my $test_email = 'matt@example.com'; sub register_tests { my $self = shift; $self->register_test('test_invalid_date_range', 7); $self->register_test("test_hook_data_post", 7); } sub setup_test_headers { my $self = shift; my $transaction = $self->qp->transaction; my $address = Qpsmtpd::Address->new( "<$test_email>" ); my $header = Mail::Header->new(Modify => 0, MailFrom => "COERCE"); my $now = strftime "%a %b %e %H:%M:%S %Y", localtime time; $transaction->sender($address); $transaction->header($header); $transaction->header->add('From', "<$test_email>"); $transaction->header->add('Date', $now ); $transaction->body_write( "test message body " ); $self->qp->connection->relay_client(0); $self->qp->transaction->notes('whitelistsender', 0); $self->connection->notes('whitelisthost', 0); $self->connection->notes('naughty', 0); }; sub test_invalid_date_range { my $self = shift; my $header = Mail::Header->new(Modify => 0, MailFrom => "COERCE"); my $transaction = $self->qp->transaction->header($header); my $now = strftime "%a %b %e %H:%M:%S %Y", localtime time; my $r = $self->invalid_date_range($now); ok( ! $r, "valid +") or print "$r\n"; $self->{_args}{future} = 2; my $future_6 = strftime "%a %b %e %H:%M:%S %Y", localtime time + 518400; #6d $r = $self->invalid_date_range( $future_6 ); ok( $r, "too new -" ); my $future_3 = strftime "%a %b %e %H:%M:%S %Y", localtime time + 259200; #3d $r = $self->invalid_date_range( $future_3 ); ok( $r, "too new -" ); my $future_1 = strftime "%a %b %e %H:%M:%S %Y", localtime time + 86400; #1d $r = $self->invalid_date_range( $future_1 ); ok( ! $r, "a little new, +" ) or warn "$r\n"; $self->{_args}{past} = 2; my $past_6 = strftime "%a %b %e %H:%M:%S %Y", localtime time - 518400; #6d $r = $self->invalid_date_range( $past_6 ); ok( $r, "too old -" ); my $past_3 = strftime "%a %b %e %H:%M:%S %Y", localtime time - 259200; #3d $r = $self->invalid_date_range( $past_3 ); ok( $r, "too old -" ); my $past_1 = strftime "%a %b %e %H:%M:%S %Y", localtime time - 86400; #1d $r = $self->invalid_date_range( $past_1 ); ok( ! $r, "a little old +" ); }; sub test_hook_data_post { my $self = shift; $self->{_args}{reject} = 1; my $reject = $self->{_args}{reject_type}; my $deny = $reject =~ /^temp|soft$/i ? DENYSOFT : DENY; $self->setup_test_headers(); my $transaction = $self->qp->transaction; my ($code, $mess) = $self->hook_data_post( $transaction ); $mess ||= ''; # avoid undef warning cmp_ok( DECLINED, '==', $code, "okay $code, $mess" ); $transaction->header->delete('Date'); ($code, $mess) = $self->hook_data_post( $transaction ); cmp_ok( $code, '==', $deny, "missing date ( $code, $mess )" ); my $now = strftime "%a %b %e %H:%M:%S %Y", localtime time; $transaction->header->add('Date', $now ); $transaction->header->delete('From'); ($code, $mess) = $self->hook_data_post( $transaction ); cmp_ok( $deny, '==', $code, "missing from ( $code, $mess )" ); $transaction->header->add('From', "<$test_email>"); $self->{_args}{future} = 5; my $future = strftime "%a %b %e %H:%M:%S %Y", localtime time + 518400; #6d $transaction->header->replace('Date', $future ); ($code, $mess) = $self->hook_data_post( $transaction ); cmp_ok( $deny, '==', $code, "too new ( $code, $mess )" ); $self->{_args}{past} = 5; my $past = strftime "%a %b %e %H:%M:%S %Y", localtime time - 518400; #6d $transaction->header->replace('Date', $past ); ($code, $mess) = $self->hook_data_post( $transaction ); cmp_ok( $deny, '==', $code, "too old ( $code, $mess )" ); $self->{_args}{reject_type} = 'temp'; ($code, $mess) = $self->hook_data_post( $transaction ); cmp_ok( DENYSOFT, '==', $code, "defer, not deny ( $code, $mess )" ); $self->{_args}{reject_type} = 'perm'; ($code, $mess) = $self->hook_data_post( $transaction ); cmp_ok( DENY, '==', $code, "deny ( $code, $mess )" ); }; qpsmtpd-0.94/t/plugin_tests/helo000066400000000000000000000123411240247602400167750ustar00rootroot00000000000000#!perl -w use strict; use warnings; use Qpsmtpd::Constants; sub register_tests { my $self = shift; $self->register_test('test_init_resolver', 2); $self->register_test('test_is_in_badhelo', 2); $self->register_test('test_is_regex_match', 3); $self->register_test('test_invalid_localhost', 4); $self->register_test('test_is_plain_ip', 3); $self->register_test('test_is_address_literal', 3); $self->register_test('test_no_forward_dns', 2); $self->register_test('test_no_reverse_dns', 3); $self->register_test('test_no_matching_dns', 2); $self->register_test('test_helo_handler', 1); $self->register_test('test_check_ip_match', 3); $self->register_test('test_check_name_match', 3); } sub test_helo_handler { my $self = shift; cmp_ok( $self->helo_handler(undef, undef), '==', DECLINED, "empty host"); }; sub test_init_resolver { my $self = shift; my $net_dns = $self->init_resolver(); ok( $net_dns, "net::dns" ); cmp_ok( ref $net_dns, 'eq', 'Net::DNS::Resolver', "ref ok"); }; sub test_is_in_badhelo { my $self = shift; my ($err, $why) = $self->is_in_badhelo('yahoo.com'); ok( $err, "yahoo.com, $why"); ($err, $why) = $self->is_in_badhelo('example.com'); ok( ! $err, "example.com"); }; sub test_is_regex_match { my $self = shift; my ($err, $why) = $self->is_regex_match('yahoo.com', 'ya.oo\.com$' ); ok( $err, "yahoo.com, $why"); ($err, $why) = $self->is_regex_match('yoda.com', 'ya.oo\.com$' ); ok( ! $err, "yahoo.com"); ($err, $why) = $self->is_regex_match('host-only', '!\.' ); ok( $err, "negated pattern, $why"); }; sub test_invalid_localhost { my $self = shift; $self->qp->connection->remote_ip(undef); my ($err, $why) = $self->invalid_localhost('localhost' ); ok( $err, "localhost, undefined remote IP: $why"); $self->qp->connection->remote_ip(''); ($err, $why) = $self->invalid_localhost('localhost' ); ok( $err, "localhost, empty remote IP: $why"); $self->qp->connection->remote_ip('192.0.99.5'); ($err, $why) = $self->invalid_localhost('localhost'); ok( $err, "localhost, invalid remote IP: $why"); $self->qp->connection->remote_ip('127.0.0.1'); ($err, $why) = $self->invalid_localhost('localhost'); ok( ! $err, "localhost, correct remote IP"); }; sub test_is_plain_ip { my $self = shift; my ($err, $why) = $self->is_plain_ip('0.0.0.0'); ok( $err, "plain IP, $why"); ($err, $why) = $self->is_plain_ip('255.255.255.255'); ok( $err, "plain IP, $why"); ($err, $why) = $self->is_plain_ip('[255.255.255.255]'); ok( ! $err, "address literal"); }; sub test_is_address_literal { my $self = shift; my ($err, $why) = $self->is_address_literal('[0.0.0.0]'); ok( $err, "plain IP, $why"); ($err, $why) = $self->is_address_literal('[255.255.255.255]'); ok( $err, "plain IP, $why"); ($err, $why) = $self->is_address_literal('255.255.255.255'); ok( ! $err, "address literal"); }; sub test_no_forward_dns { my $self = shift; my ($err, $why) = $self->no_forward_dns('perl.org'); ok( ! $err, "perl.org"); # reserved .test TLD: http://tools.ietf.org/html/rfc2606 ($err, $why) = $self->no_forward_dns('perl.org.test'); ok( $err, "test.perl.org.test"); }; sub test_no_reverse_dns { my $self = shift; my ($err, $why) = $self->no_reverse_dns('test-host', '192.0.2.0'); ok( $err, "192.0.2.0, $why"); ($err, $why) = $self->no_reverse_dns('test-host', '192.0.2.1'); ok( $err, "192.0.2.1, $why"); ($err, $why) = $self->no_reverse_dns('mail.theartfarm.com', '208.75.177.101'); ok( ! $err, "208.75.177.101"); }; sub test_no_matching_dns { my $self = shift; $self->qp->connection->notes('helo_forward_match', undef); $self->qp->connection->notes('helo_reverse_match', undef); my ($err, $why) = $self->no_matching_dns('matt.test'); ok( $err, "fail, $why"); $self->qp->connection->notes('helo_forward_match', 1); ($err, $why) = $self->no_matching_dns('matt.test'); ok( ! $err, "pass"); }; sub test_check_ip_match { my $self = shift; $self->qp->connection->remote_ip('192.0.2.1'); $self->connection->notes('helo_forward_match', 0); $self->check_ip_match('192.0.2.1'); ok( $self->connection->notes('helo_forward_match'), "exact"); $self->connection->notes('helo_forward_match', 0); $self->check_ip_match('192.0.2.2'); ok( $self->connection->notes('helo_forward_match'), "network"); $self->connection->notes('helo_forward_match', 0); $self->check_ip_match('192.0.1.1'); ok( ! $self->connection->notes('helo_forward_match'), "miss"); }; sub test_check_name_match { my $self = shift; $self->connection->notes('helo_reverse_match', 0); $self->check_name_match('mx0.example.com', 'mx0.example.com'); ok( $self->connection->notes('helo_reverse_match'), "exact"); $self->connection->notes('helo_reverse_match', 0); $self->check_name_match('mx0.example.com', 'mx1.example.com'); ok( $self->connection->notes('helo_reverse_match'), "domain"); $self->connection->notes('helo_reverse_match', 0); $self->check_name_match('mx0.example.com', 'mx0.example.net'); ok( ! $self->connection->notes('helo_reverse_match'), "domain"); }; qpsmtpd-0.94/t/plugin_tests/ident/000077500000000000000000000000001240247602400172255ustar00rootroot00000000000000qpsmtpd-0.94/t/plugin_tests/ident/geoip000066400000000000000000000072041240247602400202560ustar00rootroot00000000000000#!perl -w use strict; use warnings; use Qpsmtpd::Constants; sub register_tests { my $self = shift; eval 'use Geo::IP'; if ( $@ ) { warn "could not load Geo::IP\n"; return; }; $self->register_test('test_geoip_lookup', 2); $self->register_test('test_geoip_load_db', 2); $self->register_test('test_geoip_init_cc', 2); $self->register_test('test_set_country_code', 3); $self->register_test('test_set_country_name', 3); $self->register_test('test_set_continent', 3); $self->register_test('test_set_distance', 3); }; sub test_geoip_lookup { my $self = shift; $self->qp->connection->remote_ip('24.24.24.24'); cmp_ok( $self->connect_handler(), '==', DECLINED, "exit code"); cmp_ok( $self->connection->notes('geoip_country'), 'eq', 'US', "note"); }; sub test_geoip_load_db { my $self = shift; $self->open_geoip_db(); if ( $self->{_geoip_city} ) { ok( ref $self->{_geoip_city}, "loaded GeoIP city db" ); } else { ok( "no GeoIP city db" ); }; if ( $self->{_geoip} ) { ok( ref $self->{_geoip}, "loaded GeoIP db" ); } else { ok( "no GeoIP db" ); }; }; sub test_geoip_init_cc { my $self = shift; $self->{_my_country_code} = undef; ok( ! $self->{_my_country_code}, "undefined"); my $test_ip = '208.175.177.10'; $self->{_args}{distance} = $test_ip; $self->init_my_country_code( $test_ip ); cmp_ok( $self->{_my_country_code}, 'eq', 'US', "country set and matches"); }; sub test_set_country_code { my $self = shift; $self->qp->connection->remote_ip(''); my $cc = $self->set_country_code(); ok( ! $cc, "undef"); $self->qp->connection->remote_ip('24.24.24.24'); $cc = $self->set_country_code(); cmp_ok( $cc, 'eq', 'US', "$cc"); my $note = $self->connection->notes('geoip_country'); cmp_ok( $note, 'eq', 'US', "note has: $cc"); }; sub test_set_country_name { my $self = shift; $self->{_geoip_record} = undef; $self->qp->connection->remote_ip(''); $self->set_country_code(); my $cn = $self->set_country_name(); ok( ! $cn, "undef") or warn "$cn\n"; $self->qp->connection->remote_ip('24.24.24.24'); $self->set_country_code(); $cn = $self->set_country_name(); cmp_ok( $cn, 'eq', 'United States', "$cn"); my $note = $self->connection->notes('geoip_country_name'); cmp_ok( $note, 'eq', 'United States', "note has: $cn"); }; sub test_set_continent { my $self = shift; $self->{_geoip_record} = undef; $self->qp->connection->remote_ip(''); $self->set_country_code(); my $cn = $self->set_continent(); ok( ! $cn, "undef") or warn "$cn\n"; $self->qp->connection->remote_ip('24.24.24.24'); $self->set_country_code(); $cn = $self->set_continent() || ''; my $note = $self->connection->notes('geoip_continent'); if ( $cn ) { cmp_ok( $cn, 'eq', 'NA', "$cn"); cmp_ok( $note, 'eq', 'NA', "note has: $cn"); } else { ok(1, "no continent data" ); ok(1, "no continent data" ); }; }; sub test_set_distance { my $self = shift; $self->{_geoip_record} = undef; $self->qp->connection->remote_ip(''); $self->set_country_code(); my $cn = $self->set_distance_gc(); ok( ! $cn, "undef") or warn "$cn\n"; $self->qp->connection->remote_ip('24.24.24.24'); $self->set_country_code(); $cn = $self->set_distance_gc(); if ( $cn ) { ok( $cn, "$cn km"); my $note = $self->connection->notes('geoip_distance'); ok( $note, "note has: $cn"); } else { ok( 1, "no distance data"); ok( 1, "no distance data"); } }; qpsmtpd-0.94/t/plugin_tests/ident/p0f000066400000000000000000000043051240247602400176370ustar00rootroot00000000000000#!perl -w use strict; use warnings; use Qpsmtpd::Constants; sub register_tests { my $self = shift; $self->register_test('test_get_v2_query', 1); $self->register_test('test_get_v3_query', 1); $self->register_test('test_store_v2_results', 2); $self->register_test('test_store_v3_results', 2); }; sub test_query_p0f_v2 { #TODO # get path to p0f socket # see if it exists # try to connect to it # if connection succeeds, send it a query # do we a) pick an IP that recently connected? # or b) create a connection to localhost... # or c) is there a p0f test value? # parse and validate the response # using $self->test_v2_response() }; sub test_query_p0f_v3 { #TODO: similar to v2 .... }; sub test_get_v2_query { my $self = shift; my $local_ip = '208.75.177.101'; my $remote = '108.60.149.81'; $self->{_args}{local_ip} = $local_ip; $self->qp->connection->local_ip($local_ip); $self->qp->connection->remote_ip($remote); $self->qp->connection->local_port(25); $self->qp->connection->remote_port(2500); my $r = $self->get_v2_query(); ok( $r, 'r +' ); #use Data::Dumper; warn Data::Dumper::Dumper( $r ); }; sub test_get_v3_query { my $self = shift; my $remote = '108.60.149.81'; $self->qp->connection->remote_ip($remote); my $r = $self->get_v3_query(); ok( $r, 'any +' ); }; sub test_store_v2_results { my $self = shift; my $response = pack("L L C Z20 Z40 c Z30 Z30 C C C s S N", '233811181', '1336687857', '0', 'Windows', 'XP/2000 (RFC1323+, w+, tstamp-)', '11', 'ethernet/modem', '', '0', '0', '1', '-25600', '255', '255' ); my $r = $self->store_v2_results( $response ); ok( $r, "r: +") or return; ok( $r->{genre} =~ /windows/i, "genre +" ); #use Data::Dumper; warn Data::Dumper::Dumper( $r ); }; sub test_store_v3_results { my $self = shift; my $response = pack("L L L L L L L L L s C C A32 A32 A32 A32 A32 A32 A32", 1345340930, 16, 1336676595, 1336680290, 3, 0, 0, 0, 0, 13, 0, 0, 'Windows', '7 or 8', '', '', 'Ethernet or modem', '', ''); my $r = $self->store_v3_results( $response ); ok( $r, "result"); ok( $r->{genre} =~ /windows/i, "genre" ); }; qpsmtpd-0.94/t/plugin_tests/rcpt_ok000066400000000000000000000057141240247602400175150ustar00rootroot00000000000000#!perl -w use strict; use warnings; use Qpsmtpd::Constants; sub register_tests { my $self = shift; $self->register_test('test_get_rcpt_host', 7); $self->register_test('test_is_in_rcpthosts', 3); $self->register_test('test_is_in_morercpthosts', 2); $self->register_test('test_hook_rcpt', 3); } sub test_hook_rcpt { my $self = shift; my $transaction = $self->qp->transaction; my $address = Qpsmtpd::Address->parse(''); my ($r, $mess) = $self->hook_rcpt( $transaction, $address ); cmp_ok( $r, '==', OK, "localhost"); $address = Qpsmtpd::Address->parse(''); ($r, $mess) = $self->hook_rcpt( $transaction, $address ); cmp_ok( $r, '==', DENY, "example.com"); $self->qp->connection->relay_client(1); ($r, $mess) = $self->hook_rcpt( $transaction, $address ); cmp_ok( $r, '==', OK, "example.com"); $self->qp->connection->relay_client(0); }; sub test_is_in_rcpthosts { my $self = shift; my @hosts = $self->qp->config('rcpthosts'); my $host = $hosts[0]; if ( $host ) { ok( $self->is_in_rcpthosts( $host ), "is_in_rcpthosts, $host"); } else { ok(1, "is_in_rcpthosts (skip, no entries)" ); }; ok( $self->is_in_rcpthosts( 'localhost' ), "is_in_rcpthosts +"); ok( ! $self->is_in_rcpthosts( 'example.com' ), "is_in_rcpthosts -"); }; sub test_is_in_morercpthosts { my $self = shift; my $ref = $self->qp->config('morercpthosts', 'map'); my ($domain) = keys %$ref; if ( $domain ) { ok( $self->is_in_morercpthosts( $domain ), "$domain"); } else { ok(1, "is_in_morercpthosts (skip, no entries)" ); }; ok( ! $self->is_in_morercpthosts( 'example.com' ), "missing -"); }; sub test_get_rcpt_host { my $self = shift; my $address = Qpsmtpd::Address->parse(''); cmp_ok( $self->get_rcpt_host( $address ), 'eq', 'example.com', "+" ); $address = Qpsmtpd::Address->parse(''); cmp_ok( $self->get_rcpt_host( $address ), 'eq', 'example.com', "+" ); $address = Qpsmtpd::Address->parse(''); cmp_ok( $self->get_rcpt_host( $address ), 'eq', 'example.com', "+" ); $address = Qpsmtpd::Address->parse(''); my $local_hostname = $self->get_rcpt_host( $address ); if ( $local_hostname eq 'some.host.example.org' ) { cmp_ok( $self->get_rcpt_host( $address ), 'eq', 'some.host.example.org', "special postmaster +" ); } else { ok( 1, "special postmaster + ($local_hostname)" ); } # I think this is a bug. Qpsmtpd::Address fails to parse $address = Qpsmtpd::Address->parse(''); ok( ! $self->get_rcpt_host( $address ), "missing host" ); $address = Qpsmtpd::Address->parse('<>'); ok( ! $self->get_rcpt_host( $address ), "null recipient" ); $address = Qpsmtpd::Address->parse('<@example.com>'); ok( ! $self->get_rcpt_host( $address ), "missing user" ); }; qpsmtpd-0.94/t/plugin_tests/relay000066400000000000000000000040421240247602400171610ustar00rootroot00000000000000#!perl -w use strict; use warnings; use Qpsmtpd::Constants; sub register_tests { my $self = shift; $self->register_test('test_relay_only', 2); $self->register_test('test_is_octet_match', 3); $self->register_test('test_is_in_cidr_block', 4); $self->register_test('test_is_in_norelayclients', 5); } sub test_relay_only { my $self = shift; $self->qp->connection->relay_client(0); my $r = $self->relay_only(); cmp_ok( $r, '==', DENY, "relay_only -"); $self->qp->connection->relay_client(1); $r = $self->relay_only(); cmp_ok( $r, '==', OK, "relay_only +"); $self->qp->connection->relay_client(0); }; sub test_is_octet_match { my $self = shift; $self->populate_relayclients(); $self->qp->connection->remote_ip('192.0.1.1'); ok( $self->is_octet_match(), "match, +"); $self->qp->connection->remote_ip('192.51.1.1'); ok( ! $self->is_octet_match(), "nope, -"); $self->qp->connection->remote_ip('203.0.113.0'); ok( ! $self->is_octet_match(), "nope, -"); }; sub test_is_in_cidr_block { my $self = shift; $self->qp->connection->remote_ip('192.0.1.1'); $self->{_cidr_blocks} = [ '192.0.1.0/24' ]; ok( $self->is_in_cidr_block(), "match, +" ); $self->{_cidr_blocks} = [ '192.0.0.0/24' ]; ok( ! $self->is_in_cidr_block(), "nope, -" ); $self->qp->connection->remote_ip('fdda:b13d:e431:ae06:00a1::'); $self->{_cidr_blocks} = [ 'fdda:b13d:e431:ae06::/64' ]; ok( $self->is_in_cidr_block(), "match, +" ); $self->{_cidr_blocks} = [ 'fdda:b13d:e431:be17::' ]; ok( ! $self->is_in_cidr_block(), "nope, -" ); }; sub test_is_in_norelayclients { my $self = shift; my @matches = qw/ 192.0.99.5 192.0.98.1 192.0.98.255 /; my @false = qw/ 192.0.99.7 192.0.109.7 /; foreach ( @matches ) { $self->qp->connection->remote_ip($_); ok( $self->is_in_norelayclients(), "match, + ($_)"); }; foreach ( @false ) { $self->qp->connection->remote_ip($_); ok( ! $self->is_in_norelayclients(), "match, - ($_)"); }; }; qpsmtpd-0.94/t/plugin_tests/resolvable_fromhost000066400000000000000000000052041240247602400221250ustar00rootroot00000000000000#!perl -w use strict; use warnings; use Data::Dumper; use Net::DNS; use Qpsmtpd::Address; use Qpsmtpd::Constants; my $res = new Net::DNS::Resolver(dnsrch => 0); my $test_email = 'user@example.com'; sub register_tests { my $self = shift; my %args = ( ); $self->register( $self->qp, reject => 0 ); $self->register_test('test_populate_invalid_networks', 2); $self->register_test('test_mx_address_resolves', 2); $self->register_test('test_get_host_records', 2); $self->register_test('test_get_and_validate_mx', 2); $self->register_test('test_check_dns', 2); $self->register_test('test_hook_mail', 4); } sub test_hook_mail { my $self = shift; my $transaction = $self->qp->transaction; my $address = Qpsmtpd::Address->new('remote@example.com'); $transaction->sender($address); my $sender = $transaction->sender; $sender->host('perl.com'); ok( $self->hook_mail( $transaction, $sender ) ); ok( $self->hook_mail( $transaction, $sender ) ); $sender->host(''); $self->{_args}{reject} = 1; $self->{_args}{reject_type} = 'soft'; my ($r) = $self->hook_mail( $transaction, $sender ); ok( $r == DENYSOFT, "($r)"); $self->{_args}{reject_type} = 'hard'; ($r) = $self->hook_mail( $transaction, $sender ); ok( $r == DENY, "($r)"); }; sub test_check_dns { my $self = shift; my $transaction = $self->qp->transaction; ok( ! $self->check_dns( '', $transaction ) ); ok( $self->check_dns( 'perl.com', $transaction ) ); } sub test_get_and_validate_mx { my $self = shift; my $transaction = $self->qp->transaction; ok( scalar $self->get_and_validate_mx( $res, 'perl.com', $transaction ) ); ok( ! scalar $self->get_host_records( $res, 'fake-domain-name-for-test.com', $transaction ) ); }; sub test_get_host_records { my $self = shift; my $transaction = $self->qp->transaction; ok( scalar $self->get_host_records( $res, 'perl.com', $transaction ) ); ok( ! scalar $self->get_host_records( $res, 'fake-domain-name-for-test.com', $transaction ) ); }; sub test_mx_address_resolves { my $self = shift; my $fromhost = 'perl.com'; ok( $self->mx_address_resolves('mail.perl.com', $fromhost) ); ok( ! $self->mx_address_resolves('no-such-mx.perl.com', $fromhost) ); }; sub test_populate_invalid_networks { my $self = shift; my $ip = '10.9.8.7'; ok( $self->ip_is_valid($ip) ); $self->qp->config('invalid_resolvable_fromhost', $ip); $self->populate_invalid_networks(); ok( ! $self->ip_is_valid($ip) ); # clean up afterwards $self->qp->config('invalid_resolvable_fromhost', undef ); $self->{invalid} = (); }; qpsmtpd-0.94/t/plugin_tests/sender_permitted_from000066400000000000000000000012401240247602400224220ustar00rootroot00000000000000#!perl -w use strict; use warnings; use Qpsmtpd::Constants; my $r; sub register_tests { my $self = shift; eval 'use Mail::SPF'; return if $@; $self->register_test('test_is_special_recipient', 5); } sub test_is_special_recipient { my $self = shift; my $transaction = $self->qp->transaction; my $address = Qpsmtpd::Address->new('user@example.com'); ok( ! $self->is_special_recipient( $address ), "not special"); foreach my $user ( qw/ postmaster abuse mailer-daemon root / ) { $address = Qpsmtpd::Address->new("$user\@example.com"); ok( $self->is_special_recipient( $address ), "special: $user"); }; }; qpsmtpd-0.94/t/plugin_tests/spamassassin000066400000000000000000000150411240247602400205530ustar00rootroot00000000000000#!perl -w use strict; use warnings; use Mail::Header; use Qpsmtpd::Address; use Qpsmtpd::Constants; my @sample_headers = ( 'No, score=-5.4 required=4.0 autolearn=ham', 'No, score=-8.2 required=4.0 autolearn=ham', 'No, score=-102.3 required=4.0 autolearn=disabled', 'No, score=-0.1 required=5.0 tests=AWL,BAYES_00,FREEMAIL_FROM,HTML_MESSAGE,RCVD_IN_DNSWL_NONE,RDNS_NONE autolearn=no version=3.3.2', 'No, score=4.4 required=5.0 autolearn=no', 'Yes, score=14.3 required=5.0 autolearn=no', 'Yes, score=18.3 required=5.0 autolearn=spam', 'Yes, score=26.6 required=4.0 autolearn=unavailable', 'No, score=-1.7 required=4.0 autolearn=unavailable version=3.3.2', 'No, hits=-1.0 required=4.0 autolearn=unavailable version=3.3.2', ); sub register_tests { my $self = shift; $self->register_test('test_connect_to_spamd', 4); $self->register_test('test_parse_spam_header', 10); $self->register_test('test_get_spam_results', 20); $self->register_test('test_munge_subject', 4); $self->register_test('test_reject', 2); } sub test_connect_to_spamd { my $self = shift; my $transaction = $self->qp->transaction; $transaction->add_recipient( Qpsmtpd::Address->new( '' ) ); my $username = $self->select_spamd_username( $transaction ); my $message = $self->test_message(); my $length = length $message; # Try a unix socket $self->{_args}{spamd_socket} = '/var/run/spamd/spamd.socket'; my $SPAMD = $self->connect_to_spamd(); if ( $SPAMD ) { ok( $SPAMD, "socket"); $self->print_to_spamd( $SPAMD, $message, $length, $username ); shutdown($SPAMD, 1); # close our side of the socket (tell spamd we're done) my $headers = $self->parse_spamd_response( $SPAMD ); #warn Data::Dumper::Dumper($headers); ok( $headers, "socket response\n"); } else { ok( 1 == 1, "socket connect FAILED"); ok( 1 == 1, "socket response FAILED"); }; # Try a TCP/IP connection $self->{_args}{spamd_socket} = '127.0.0.1:783'; $SPAMD = $self->connect_to_spamd(); if ( $SPAMD ) { ok( $SPAMD, "tcp/ip"); #warn Data::Dumper::Dumper($SPAMD); $self->print_to_spamd( $SPAMD, $message, $length, $username ); shutdown($SPAMD, 1); # close our side of the socket (tell spamd we're done) my $headers = $self->parse_spamd_response( $SPAMD ); #warn Data::Dumper::Dumper($headers); ok( $headers, "tcp/ip response\n"); } else { ok( 1 == 1, "tcp/ip connect FAILED"); ok( 1 == 1, "tcp/ip response FAILED"); }; }; sub test_reject { my $self = shift; my $transaction = $self->qp->transaction; $self->setup_headers(); # message scored a 10, should pass $self->{_args}{reject} = 12; $transaction->notes('spamassassin', { is_spam => 'Yes', score => 10 } ); my $r = $self->reject($transaction); cmp_ok( DECLINED, '==', $r, "r: $r"); # message scored a 15, should fail $self->{_args}{reject} = 12; $transaction->notes('spamassassin', { is_spam => 'Yes', score => 15 } ); ($r) = $self->reject($transaction); cmp_ok( DENY, '==', $r, "r: $r"); }; sub test_munge_subject { my $self = shift; my $transaction = $self->qp->transaction; $self->setup_headers(); my $subject = 'DSPAM smells better than SpamAssassin'; $self->{_args}{munge_subject_threshold} = 5; $transaction->notes('spamassassin', { score => 6 } ); $transaction->header->add('Subject', $subject); $self->munge_subject($transaction); my $r = $transaction->header->get('Subject'); chomp $r; cmp_ok($r, 'eq', "*** SPAM *** $subject", "+"); $transaction->header->delete('Subject'); # cleanup $self->{_args}{munge_subject_threshold} = 5; $transaction->notes('spamassassin', { score => 3 } ); $transaction->header->add('Subject', $subject); $self->munge_subject($transaction); $r = $transaction->header->get('Subject'); chomp $r; cmp_ok($r, 'eq', $subject, "-"); $transaction->header->delete('Subject'); # cleanup $transaction->notes('spamassassin', { score => 3, required => 4 } ); $transaction->header->add('Subject', $subject); $self->munge_subject($transaction); $r = $transaction->header->get('Subject'); chomp $r; cmp_ok($r, 'eq', $subject, "-"); $transaction->header->delete('Subject'); # cleanup $transaction->notes('spamassassin', { score => 5, required => 4 } ); $transaction->header->add('Subject', $subject); $self->munge_subject($transaction); $r = $transaction->header->get('Subject'); chomp $r; cmp_ok($r, 'eq', "$subject", "+"); }; sub test_get_spam_results { my $self = shift; my $transaction = $self->qp->transaction; $self->setup_headers(); foreach my $h ( @sample_headers ) { $transaction->notes('spamassassin', undef); # empty cache $transaction->header->delete('X-Spam-Status'); # delete previous header $transaction->header->add('X-Spam-Status', $h); my $r_ref = $self->get_spam_results($transaction); if ( $h =~ /hits=/ ) { $r_ref->{hits} = delete $r_ref->{score}; # SA v2 compat }; my $r2 = _reassemble_header($r_ref); cmp_ok( $h, 'eq', $r2, $h ); # this time it should be cached $r_ref = $self->get_spam_results($transaction); if ( $h =~ /hits=/ ) { ok( 1 ); next; }; # caching is broken for SA v2 headers $r2 = _reassemble_header($r_ref); cmp_ok( $h, 'eq', $r2, $h ); }; }; sub test_parse_spam_header { my $self = shift; foreach my $h ( @sample_headers ) { my $r_ref = $self->parse_spam_header($h); if ( $h =~ /hits=/ ) { $r_ref->{hits} = delete $r_ref->{score}; # SA v2 compat }; my $r2 = _reassemble_header($r_ref); cmp_ok( $h, 'eq', $r2, $h ); }; }; sub setup_headers { my $self = shift; my $transaction = $self->qp->transaction; my $header = Mail::Header->new(Modify => 0, MailFrom => "COERCE"); $transaction->header( $header ); }; sub test_message { return <<'EO_MESSAGE' To: Fictitious User From: No Such Subject: jose can you see, by the dawns early light? What so proudly we. EO_MESSAGE }; sub _reassemble_header { my $info_ref = shift; my $string = $info_ref->{'is_spam'}; $string .= ","; foreach ( qw/ hits score required tests autolearn version / ) { next if ! defined $info_ref->{$_}; $string .= " $_=$info_ref->{$_}"; }; return $string; }; qpsmtpd-0.94/t/plugin_tests/virus/000077500000000000000000000000001240247602400172725ustar00rootroot00000000000000qpsmtpd-0.94/t/plugin_tests/virus/clamdscan000066400000000000000000000042011240247602400211370ustar00rootroot00000000000000#!perl -w use strict; use warnings; use Qpsmtpd::Constants; sub register_tests { my $self = shift; eval 'use ClamAV::Client'; if ( ! $@ ) { $self->register_test('test_register', 3); $self->register_test('test_get_clamd', 1); }; $self->register_test('test_err_and_return', 2); $self->register_test('test_get_filename', 1); $self->register_test('test_set_permission', 1); $self->register_test('test_is_too_big', 2); $self->register_test('test_is_not_multipart', 2); } sub test_register { my $self = shift; ok( $self->{_args}{deny_viruses} eq 'yes', "deny_viruses"); ok( $self->{_args}{max_size} == 128, "max_size"); ok( $self->{_args}{scan_all} == 0, "scan_all"); }; sub test_err_and_return { my $self = shift; $self->{_args}{defer_on_error} = 1; my ($code, $mess) = $self->err_and_return( "test oops" ); cmp_ok( DENYSOFT, '==', $code, "oops ($mess)"); $self->{_args}{defer_on_error} = 0; ($code, $mess) = $self->err_and_return( "test oops" ); cmp_ok( DECLINED, '==', $code, "oops ($mess)"); } sub test_get_filename { my $self = shift; my $filename = $self->get_filename(); ok( $filename, "get_filename ($filename)" ); } sub test_set_permission { my $self = shift; ok( $self->set_permission(), "set_permission" ); } sub test_get_clamd { my $self = shift; my $clamd = $self->get_clamd(); ok( ref $clamd, "get_clamd: " . ref $clamd ); } sub test_is_too_big { my $self = shift; my $tran = shift || $self->qp->transaction(); $self->{_args}{max_size} = 8; $tran->{_body_size} = (7 * 1024 ); ok( ! $self->is_too_big( $tran ), "is_too_big"); $tran->{_body_size} = (9 * 1024 ); ok( $self->is_too_big( $tran ), "is_too_big"); } sub test_is_not_multipart { my $self = shift; my $tran = shift || $self->qp->transaction(); ok( $self->is_not_multipart(), "not_multipart" ); if ( $tran->header ) { $tran->header->add('Content-Type', 'multipart/alternative; boundary="Jx3Wbb8BMHsO=_?:"'); ok( ! $self->is_not_multipart(), "not_multipart" ); } else { ok( 1 ); } } qpsmtpd-0.94/t/qpsmtpd-address.t000066400000000000000000000055231240247602400167070ustar00rootroot00000000000000#!/usr/bin/perl use strict; $^W = 1; use Test::More qw/no_plan/; BEGIN { use_ok('Qpsmtpd::Address'); } my $as; my $ao; $as = '<>'; $ao = Qpsmtpd::Address->parse($as); ok($ao, "parse $as"); is($ao->format, $as, "format $as"); $as = ''; $ao = Qpsmtpd::Address->parse($as); ok($ao, "parse $as"); is($ao->format, $as, "format $as"); $as = ''; $ao = Qpsmtpd::Address->parse($as); ok($ao, "parse $as"); is($ao->format, $as, "format $as"); is($ao->user, 'foo', 'user'); is($ao->host, 'example.com', 'host'); # the \ before the @ in the local part is not required, but # allowed. For simplicity we add a backslash before all characters # which are not allowed in a dot-string. $as = '<"musa_ibrah@caramail.comandrea.luger"@wifo.ac.at>'; $ao = Qpsmtpd::Address->parse($as); ok($ao, "parse $as"); is($ao->format, '<"musa_ibrah\@caramail.comandrea.luger"@wifo.ac.at>', "format $as"); # email addresses with spaces $as = ''; $ao = Qpsmtpd::Address->parse($as); ok($ao, "parse $as"); is($ao->format, '<"foo\ bar"@example.com>', "format $as"); $as = 'foo@example.com'; $ao = Qpsmtpd::Address->new($as); ok($ao, "new $as"); is($ao->address, $as, "address $as"); $as = ''; $ao = Qpsmtpd::Address->new($as); ok($ao, "new $as"); is($ao->address, 'foo@example.com', "address $as"); $as = ''; $ao = Qpsmtpd::Address->new($as); ok($ao, "new $as"); is($ao->format, $as, "format $as"); $as = 'foo@foo.x.example.com'; ok($ao = Qpsmtpd::Address->parse('<' . $as . '>'), "parse $as"); is($ao && $ao->address, $as, "address $as"); # Not sure why we can change the address like this, but we can so test it ... is($ao && $ao->address('test@example.com'), 'test@example.com', 'address(test@example.com)'); $as = ''; $ao = Qpsmtpd::Address->new($as); ok($ao, "new $as"); is($ao->format, $as, "format $as"); is("$ao", $as, "overloaded stringify $as"); $as = 'foo@foo.x.example.com'; ok($ao = Qpsmtpd::Address->parse("<$as>"), "parse <$as>"); is($ao && $ao->address, $as, "address $as"); ok($ao eq $as, "overloaded 'cmp' operator"); my @unsorted_list = map { Qpsmtpd::Address->new($_) } qw( "musa_ibrah@caramail.comandrea.luger"@wifo.ac.at foo@example.com ask@perl.org foo@foo.x.example.com jpeacock@cpan.org test@example.com ); # NOTE that this is sorted by _host_ not by _domain_ my @sorted_list = map { Qpsmtpd::Address->new($_) } qw( jpeacock@cpan.org foo@example.com test@example.com foo@foo.x.example.com ask@perl.org "musa_ibrah@caramail.comandrea.luger"@wifo.ac.at ); my @test_list = sort @unsorted_list; is_deeply(\@test_list, \@sorted_list, "sort via overloaded 'cmp' operator"); # RT#38746 - non-RFC compliant address should return undef $as = ''; $ao = Qpsmtpd::Address->new($as); is($ao, undef, "illegal $as"); qpsmtpd-0.94/t/rset.t000066400000000000000000000010101240247602400145340ustar00rootroot00000000000000use Test::More tests => 10; use strict; use lib 't'; use_ok('Test::Qpsmtpd'); ok(my ($smtpd, $conn) = Test::Qpsmtpd->new_conn(), "get new connection"); is(($smtpd->command('EHLO localhost'))[0], 250, 'EHLO localhost'); is(($smtpd->command('MAIL FROM:'))[0], 250, 'MAIL FROM:'); is($smtpd->transaction->sender->address, 'ask@perl.org', 'got the right sender'); is(($smtpd->command('RSET'))[0], 250, 'RSET'); is($smtpd->transaction->sender, undef, 'No sender stored after rset'); qpsmtpd-0.94/t/tempstuff.t000066400000000000000000000014261240247602400156070ustar00rootroot00000000000000#!/usr/bin/perl -w use Test::More qw(no_plan); use File::Path; use strict; use lib 't'; use_ok('Test::Qpsmtpd'); BEGIN { # need this to happen before anything else my $cwd = `pwd`; chomp($cwd); open my $spooldir, '>', "./config.sample/spool_dir"; print $spooldir "$cwd/t/tmp"; close $spooldir; } ok(my ($smtpd, $conn) = Test::Qpsmtpd->new_conn(), "get new connection"); my ($spool_dir, $tempfile, $tempdir) = ($smtpd->spool_dir, $smtpd->temp_file(), $smtpd->temp_dir()); ok($spool_dir =~ m!t/tmp/$!, "Located the spool directory"); ok($tempfile =~ /^$spool_dir/, "Temporary filename"); ok($tempdir =~ /^$spool_dir/, "Temporary directory"); ok(-d $tempdir, "And that directory exists"); unlink "./config.sample/spool_dir"; rmtree($spool_dir); qpsmtpd-0.94/xt/000077500000000000000000000000001240247602400135725ustar00rootroot00000000000000qpsmtpd-0.94/xt/01-syntax.t000066400000000000000000000020421240247602400155210ustar00rootroot00000000000000use Config qw/ myconfig /; use Data::Dumper; use English qw/ -no_match_vars /; use File::Find; use Test::More; if (!$ENV{'QPSMTPD_DEVELOPER'}) { plan skip_all => "not a developer, skipping POD tests"; } use lib 'lib'; my $this_perl = $Config{'perlpath'} || $EXECUTABLE_NAME; my @files = find({wanted => \&test_syntax, no_chdir => 1}, 'plugins', 'lib', 't'); sub test_syntax { my $f = $File::Find::name; chomp $f; return if !-f $f; return if $f =~ m/(~|\.(bak|orig|rej))/; my $r; eval { $r = `$this_perl -Ilib -MQpsmtpd::Constants -c $f 2>&1`; }; my $exit_code = sprintf("%d", $CHILD_ERROR >> 8); if ($exit_code == 0) { ok($exit_code == 0, "syntax $f"); return; } if ($r =~ /^Can't locate (.*?) in /) { ok(0 == 0, "skipping $f, I couldn't load w/o $1"); return; } if ($r =~ /^Base class package "Danga::Socket" is empty/) { ok(0 == 0, "skipping $f, Danga::Socket not available."); return; } print "ec: $exit_code, r: $r\n"; } done_testing(); qpsmtpd-0.94/xt/02-pod.t000066400000000000000000000005221240247602400147570ustar00rootroot00000000000000#!perl use Test::More; if (!$ENV{'QPSMTPD_DEVELOPER'}) { plan skip_all => "not a developer, skipping POD tests"; exit; } eval "use Test::Pod 1.14"; if ($@) { plan skip_all => "Test::Pod 1.14 required for testing POD"; exit; } my @poddirs = qw( lib plugins ); all_pod_files_ok(all_pod_files(@poddirs)); done_testing();