Mail-CheckUser-1.21/000075500000000000000000000000001147255004400141715ustar00rootroot00000000000000Mail-CheckUser-1.21/Changes000064400000000000000000000200361147255004400154650ustar00rootroot00000000000000Revision history for Perl module Mail::CheckUser 1.21 Thu Sep 18 12:00:00 2003 - Fix cufilter to handle bounce messages better. - Avoid cufilter redundant checking. - Handle special wildcard gTLD bogus domains. (See http://www.imperialviolet.org/dnsfix.html) - Patches by Rob Brown 1.20 Mon Sep 01 12:00:00 2003 - Run the forward lookups of MX records through the Net::DNS resolver object to detect slow lookups within the timeout restricted. The normal gethostbyname did not honor the timeout. - Taint cleaner. - Add procmail filter example. 1.19 Sat Mar 08 12:00:00 2003 - Correct syntax for Net::Ping::ping and nack. - Avoids a problem when the MX entry does not resolve. - Prevent this crash: "Usage> nack($failed_ack_host)" - Bug reported by peter@hiplists.com (Peter Beltemacchi) 1.18 Tue Dec 10 20:00:00 2002 - Latest version broke MAIL/RCPT check. Stupid, stupid, stupid me - it actually caused failure of one test in test suite but I misinterpreted it and though that mailboxes at hotmail.com cannot be verified by Mail::CheckUser anymore. Note to myself - never release anything in hurry. Reported by Kevin Cassidy and fixed independently by Rob Brown. - Added $Treat_Full_As_Fail config variable and new check code CU_MAILBOX_FULL to report full boxes (Rob Brown). 1.17 Sat Nov 30 23:02:20 2002 - Be polite with SMTP servers - try to issue QUIT command before disconnecting. Suggested by Tom Allison. - Workaround Perl bug (#18784) which causes userpart regexp matching failures with correct userparts in Perl 5.8.0. Patch by Rodger Bagnall. - Remove notice that MAIL/RCPT check works with mailboxes on hotmail.com from documentation. It seems it is not true anymore. 1.16 Wed Nov 18 09:30:00 2002 - Add $Mail::CheckUser::Net_DNS_Resolver feature to allow customizeable Net::DNS::Resolver object. - Utilize udp_timeout feature in Net::DNS to avoid excessive dns delays (Rob Brown). - Do not allow "special" characters in username. - Break RFC by allowing domains with "--" 1.15 Fri Nov 8 00:02:23 2002 - Minor documentaion and code fixes. 1.14 Sat Oct 19 23:59:00 2002 - A little more robust for when some mail servers are down. - Uses Net::Ping to determine remote reachability. - Added setting $Mail::CheckUser::Skip_SYN to retain the old 1.13 functionality. - Patches by bbb@cpan.org (Rob Brown) 1.13 Sat Mar 9 23:59:00 2002 - I had to bump version because of corrupted CPAN upload. 1.12 Sat Mar 9 23:50:33 2002 - Fix die if all SMTP servers for mail domain are found as unreachable during SMTP checks. Thanks to Michal Weinfurtner for bug report. - Added additional status code CU_SMTP_UNREACHABLE which is set if all SMTP servers for mail domain are found as unreachable during SMTP checks. 1.11 Thu Mar 7 19:13:29 2002 - Fix example in POD documentation. 1.10 Wed Mar 6 01:25:28 2002 - Added subroutine 'last_check'. Based on patch from Cloyce D. Spradling. - Use Test.pm for test suite. - Do not treat email address as invalid if SMTP server replies with error on MAIL FROM command. - If email is undefined check_email dies instead of omitting warning. - A lot of documentation fixes: grammar and spelling clean-up, rewritten section 'IMPORTANT WARNING'. Thanks to Cloyce D. Spradling for patch. - Changed my email address from m_ilya@agava.com to ilya@martynov.org in module documentation. 1.02 Fri Jul 6 14:51:06 2001 - Fixed minor bug in sample code snippet in pod documentaion. Thanks to David Olszynski for correction. 1.01 Tue Jul 3 15:40:40 2001 - Fixed bug which allowed to pass email addresses with two or more '@' chars as correct. 1.00 Wed Jun 27 19:03:20 2001 - Added more tests for email address syntax check. - Fixed spelling (with ispell) it this file :). - Replaced 'validness' with 'validity' in docs. I'm sorry - English isn't my native language. Thanks to Dudley Cadet for this correction. - This is 'offical' stable release. Now I'm already working on new rewritten version of this module which will have some new features: OO API, access to DNS resolver object (so it will be possible to set DNS servers for hostname resolving) and many others useful things. 0.92 Fri Mar 9 15:11:34 2001 - Minor fix: don't get records of type 'IN' in hostname checks via DNS. - Value $Mail::CheckUser::Helo_Domain option variable wasn't respected if SMTP server is verified with combination of MAIL and RCPT commands. - Added disabling warnings that comes from Net::SMTP in timeout conditions. - Incompatible change: Removed old VRFY check. Probably nobody even notice it. - No longer putting rfcs into distro. - Some minor pod doc fixes. 0.91 Fri Jan 12 19:06:29 2001 - Added section IMPORTANT WARNINGS to pod documentation. I'm really tired to answer same questions :) Hope this will help. - Added $Mail::CheckUser::Helo_Domain parameter. This allows to specify domain name used in HELO query. It can help if SMTP servers doesn't like default domain used in HELO query. - Added LICENSE section to README and similar info to CheckUser.pm. - Changed resolver behavior: now all domain names are checked in root zone. It means thats email addresses like someone@foo.bar will not be accepted as valid anymore just because your local computer resolves domain foo.bar.mydomain.com and have 'search mydomain.com' in his /etc/resolv.conf. 0.90 Thu Nov 16 16:31:10 2000 - Removed some tests because some my test mailboxes have became invalid. - Some minor pod doc fixes. - Marking this release as 0.90 since I believe it has reached stable state now. 0.17 Mon Sep 25 21:06:06 2000 - Added workaround against annoying warning under Perl 5.6 in Net::DNS module which is used by this module. 0.16 Mon Sep 11 22:44:11 2000 - Add another check: now module can verify user on SMTP servers using combination of MAIL and RCPT commands. This check can detect validity of mailboxes on more SMTP servers then VRFY check. By default module now uses this new check. Old VRFY is still supported but can be possibly removed in future because it seems there is no need in it if we have MAIL/RCPT check (thanks for idea to Marc Jauvin). 0.15 Tue Aug 29 15:40:28 2000 - Added some notes about third email address validity check into README and pod documentation. 0.14 Sat Aug 26 21:10:08 2000 - Added more tests for emails address syntax. - Fix for bug with verifying user on SMTP servers that support multiple domains (thanks to Karen R Sabog). 0.13 Mon Aug 14 19:20:16 2000 - Added into distro rfc 821. - Changes in regexp which handles emails syntax (it doesn't allow space in username anymore). - Added more tests for emails address syntax. 0.12 Wed Jul 19 20:33:29 2000 - Fixed bug in SMTP return codes handling (thanks to Rolf Beutner). 0.11 Fri Jul 14 03:16:45 2000 - Added global variable $Mail::CheckUser::Treat_Timeout_As_Fail. - Updated documentation. 0.10 Sun Jul 9 04:50:59 2000 - Added missed README file to distribution. 0.09 Sun Jul 9 02:51:36 2000 - Documentation fixes. - Makefile.PL have better compatibility with CPAN. - First release on CPAN. 0.08 Sat Jul 8 20:46:49 2000 - Added more verbose debug logging. - Added requirement for IO::Handle 1.21: earlier version has problems with timeouts handling. 0.07 Wed Apr 5 17:32:41 2000 - Documentation fixes: there was mentioned check_mail instead check_email. 0.06 Tue Nov 16 03:51:03 1999 - Fixed bug with handling DNS request timeouts. 0.05 Mon Nov 15 19:29:15 1999 - Script test.pl was split into four tests scripts and they were moved to 't' directory. 0.04 Sat Nov 13 16:03:01 1999 - Documentation for Mail::CheckUser expanded a bit. - Some syntax fixes in Mail::CheckUser documentation. 0.03 Fri Nov 12 22:02:43 1999 - Documentation fixes for Mail::CheckUser. 0.02 Fri Nov 12 21:56:59 1999 - Added global variable $Mail::CheckUser::Skip_SMTP_Checks which enables/disables connection to mail server to check if user exists on it. 0.01 Tue Nov 2 04:34:00 1999 - First working version. Mail-CheckUser-1.21/CheckUser.pm000064400000000000000000000570051147255004400164120ustar00rootroot00000000000000# Copyright (c) 1999-2003 by Ilya Martynov. All rights # reserved. # # This program is free software; you can redistribute it and/or modify # it under the same terms as Perl itself. package Mail::CheckUser; use strict; use vars qw(@ISA @EXPORT_OK %EXPORT_TAGS $VERSION); require Exporter; @ISA = qw(Exporter); @EXPORT_OK = qw(check_email last_check check_hostname check_username); $EXPORT_TAGS{constants} = [qw(CU_OK CU_BAD_SYNTAX CU_UNKNOWN_DOMAIN CU_DNS_TIMEOUT CU_UNKNOWN_USER CU_SMTP_TIMEOUT CU_SMTP_UNREACHABLE CU_MAILBOX_FULL)]; push @EXPORT_OK, @{$EXPORT_TAGS{constants}}; $VERSION = '1.21'; use Carp; use Net::DNS; use Net::SMTP; use IO::Handle; use vars qw($Skip_Network_Checks $Skip_SMTP_Checks $Skip_SYN $Net_DNS_Resolver $NXDOMAIN $Timeout $Treat_Timeout_As_Fail $Debug $Treat_Full_As_Fail $Sender_Addr $Helo_Domain $Last_Check); # if it is true Mail::CheckUser doesn't make network checks $Skip_Network_Checks = 0; # if it is true Mail::CheckUser doesn't try to connect to mail # server to check if user is valid $Skip_SMTP_Checks = 0; # timeout in seconds for network checks $Timeout = 60; # if it is true the Net::Ping SYN/ACK check will be skipped $Skip_SYN = 0; # if it is true Mail::CheckUser treats timeouted checks as # failed checks $Treat_Timeout_As_Fail = 0; # if it is true Mail::CheckUser treats mailbox full message # as failed checks $Treat_Full_As_Fail = 0; # sender addr used in MAIL/RCPT check $Sender_Addr = 'check@user.com'; # sender domain used in HELO SMTP command - if undef lets # Net::SMTP use its default value $Helo_Domain = undef; # Default Net::DNS::Resolver override object $Net_DNS_Resolver = undef; # if true then enable debug mode $Debug = 0; # Wildcard gTLD always denote bogus domains # (http://www.imperialviolet.org/dnsfix.html) ## gTLD Wildcard IPs $NXDOMAIN = { # com/net "64.94.110.11" => 1, # A # ac "194.205.62.122" => 1, # A # cc "206.253.214.102" => 1, # A "snubby.enic.cc" => 1, # MX "206.191.159.103" => 1, # MX # cx "219.88.106.80" => 1, # A "mail.nonregistered.nic.cx" => 1, # MX # mp "202.128.12.163" => 1, # A # museum "195.7.77.20" => 1, # A # nu "64.55.105.9" => 1, # A "212.181.91.6" => 1, # A # ph "203.119.4.6" => 1, # A # pw "216.98.141.250" => 1, # A "65.125.231.178" => 1, # A "wfb.dnsvr.com" => 1, # CNAME # sh "194.205.62.62" => 1, # A # td "146.101.245.154" => 1, # A "www.nic.td" => 1, # CNAME # tk "195.20.32.83" => 1, # A "195.20.32.86" => 1, # A "nukumatau.taloha.com" => 1, # MX "195.20.32.99" => 1, # MX # tm "194.205.62.42" => 1, # A # tw "203.73.24.11" => 1, # A # ws "216.35.187.246" => 1, # A "mail.worldsite.ws" => 1, # MX "216.35.187.251" => 1, # MX }; # check_email EMAIL sub check_email( $ ); # last_check sub last_check( ); # check_hostname_syntax HOSTNAME sub check_hostname_syntax( $ ); # check_username_syntax USERNAME sub check_username_syntax( $ ); # check_network HOSTNAME, USERNAME sub check_network( $$ ); # check_user_on_host MSERVER, USERNAME, HOSTNAME, TIMEOUT sub check_user_on_host( $$$$ ); # _calc_timeout FULL_TIMEOUT START_TIME sub _calc_timeout( $$ ); # _pm_log LOG_STR sub _pm_log( $ ); # _result RESULT, REASON sub _result( $$ ); # check result codes use constant CU_OK => 0; use constant CU_BAD_SYNTAX => 1; use constant CU_UNKNOWN_DOMAIN => 2; use constant CU_DNS_TIMEOUT => 3; use constant CU_UNKNOWN_USER => 4; use constant CU_SMTP_TIMEOUT => 5; use constant CU_SMTP_UNREACHABLE => 6; use constant CU_MAILBOX_FULL => 7; sub check_email($) { my($email) = @_; unless(defined $email) { croak __PACKAGE__ . "::check_email: \$email is undefined"; } _pm_log '=' x 40; _pm_log "check_email: checking \"$email\""; # split email address on username and hostname my($username, $hostname) = $email =~ /^(.*)@(.*)$/; # return false if it impossible unless(defined $hostname) { return _result(CU_BAD_SYNTAX, 'bad address format: missing @'); } my $ok = 1; $ok &&= check_hostname_syntax $hostname; $ok &&= check_username_syntax $username; if($Skip_Network_Checks) { _pm_log "check_email: skipping network checks"; } elsif ($ok) { $ok &&= check_network $hostname, $username; } return $ok; } sub last_check() { return $Mail::CheckUser::Last_Check; } # build hostname regexp # NOTE: it doesn't strictly follow RFC822 # because of what registrars now allow. my $DOMAIN_RE = qr/(?:[\da-zA-Z]+ -+)* [\da-zA-Z]+/x; my $HOSTNAME_RE = qr/^ (?:$DOMAIN_RE \.)+ [a-zA-Z]+ $/xo; sub check_hostname_syntax($) { my($hostname) = @_; _pm_log "check_hostname_syntax: checking \"$hostname\""; # check if hostname syntax is correct if($hostname =~ $HOSTNAME_RE) { return _result(CU_OK, 'correct hostname syntax'); } else { return _result(CU_BAD_SYNTAX, 'bad hostname syntax'); } } # build username regexp # NOTE: it doesn't strictly follow RFC821 my $STRING_RE = ('[' . quotemeta(join '', grep(!/[<>()\[\]\\\.,;:\@"]/, # ["], UnBug Emacs map chr, 33 .. 126)) . ']'); my $USERNAME_RE = qr/^ (?:$STRING_RE+ \.)* $STRING_RE+ $/xo; sub check_username_syntax($) { my($username) = @_; _pm_log "check_username_syntax: checking \"$username\""; # check if username syntax is correct if($username =~ $USERNAME_RE) { return _result(CU_OK, 'correct username syntax'); } else { return _result(CU_BAD_SYNTAX, 'bad username syntax'); } } sub check_network($$) { my($hostname, $username) = @_; _pm_log "check_network: checking \"$username\" on \"$hostname\""; # list of mail servers for hostname my @mservers = (); my $timeout = $Timeout; my $start_time = time; my $resolver = $Mail::CheckUser::Net_DNS_Resolver || new Net::DNS::Resolver; my $tout = _calc_timeout($timeout, $start_time); return _result(CU_DNS_TIMEOUT, 'DNS timeout') if $tout == 0; $resolver->udp_timeout($tout); my @mx = mx($resolver, "$hostname."); $tout = _calc_timeout($timeout, $start_time); return _result(CU_DNS_TIMEOUT, 'DNS timeout') if $tout == 0; # check result of query if(@mx) { # if MX record exists, # then it's already sorted by preference @mservers = map {$_->exchange} @mx; } else { # if there is no MX record try hostname as mail server my $tout = _calc_timeout($timeout, $start_time); return _result(CU_DNS_TIMEOUT, 'DNS timeout') if $tout == 0; $resolver->udp_timeout($tout); my $res = $resolver->search("$hostname.", 'A'); # check if timeout has happen $tout = _calc_timeout($timeout, $start_time); return _result(CU_DNS_TIMEOUT, 'DNS timeout') if $tout == 0; # check result of query if($res) { @mservers = ($hostname); my $ip; foreach my $rr ($res->answer) { if ($rr->type eq "A") { $ip = $rr->address; last; } elsif ($rr->type eq "CNAME") { $ip = $rr->cname; } else { # Should never happen! $ip = ""; } } _pm_log "check_network: \"$ip\" Wildcard gTLD check"; return _result(CU_UNKNOWN_DOMAIN, 'Wildcard gTLD') if $NXDOMAIN->{lc $ip}; } else { return _result(CU_UNKNOWN_DOMAIN, 'DNS failure: ' . $resolver->errorstring); } } foreach my $mserver (@mservers) { _pm_log "check_network: \"$mserver\" Wildcard gTLD check"; return _result(CU_UNKNOWN_DOMAIN, 'Wildcard gTLD') if $NXDOMAIN->{lc $mserver}; } if($Skip_SMTP_Checks) { return _result(CU_OK, 'skipping SMTP checks'); } else { if ($Skip_SYN) { # Skip SYN/ACK check. # Just check user on each mail server one at a time. foreach my $mserver (@mservers) { my $tout = _calc_timeout($timeout, $start_time); if ($mserver !~ /^\d+\.\d+\.\d+\.\d+$/) { # Resolve it to an IP return _result(CU_DNS_TIMEOUT, 'DNS timeout') if $tout == 0; $resolver->udp_timeout($tout); if (my $ans = $resolver->query($mserver)) { foreach my $rr_a ($ans->answer) { if ($rr_a->type eq "A") { $mserver = $rr_a->address; last; } } } $tout = _calc_timeout($timeout, $start_time); } return _result(CU_SMTP_TIMEOUT, 'SMTP timeout') if $tout == 0; my $res = check_user_on_host $mserver, $username, $hostname, $tout; return 1 if $res == 1; return 0 if $res == 0; } } else { # Determine which mail servers are on my $resolve = {}; my $tout = _calc_timeout($timeout, $start_time); foreach my $mserver (@mservers) { # All mservers need to be resolved to IPs before the SYN check if ($mserver =~ /^\d+\.\d+\.\d+\.\d+$/) { $resolve->{$mserver} = 1; } else { _pm_log "check_network: \"$mserver\" resolving"; return _result(CU_DNS_TIMEOUT, 'DNS timeout') if $tout == 0; $resolver->udp_timeout($tout); if (my $ans = $resolver->query($mserver)) { foreach my $rr_a ($ans->answer) { if ($rr_a->type eq "A") { $mserver = $rr_a->address; $resolve->{$mserver} = 1; _pm_log "check_network: resolved to IP \"$mserver\""; last; } } } else { _pm_log "check_network: \"$mserver\" host not found!"; } $tout = _calc_timeout($timeout, $start_time); } } require Net::Ping; import Net::Ping 2.24; # Use only three-fourths of the full timeout for lookups # in order to leave time to actually speak to the server. my $ping = Net::Ping->new("syn", _calc_timeout($timeout, $start_time) * 3 / 4 + 1); $ping->{port_num} = getservbyname("smtp", "tcp"); $ping->tcp_service_check(1); foreach my $mserver (@mservers) { _pm_log "check_network: \"$mserver\" sending SYN..."; # untaint before passing to Net::Ping my ($tainted) = $mserver =~ /(\d+\.\d+\.\d+\.\d+)/; if ($tainted and $tainted eq $mserver and $resolve->{$tainted} and $ping->ping($tainted)) { _pm_log "check_network: \"$tainted\" SYN packet sent."; } else { _pm_log "check_network: \"$mserver\" host not found!"; } } foreach my $mserver (@mservers) { my $tout = _calc_timeout($timeout, $start_time); return _result(CU_SMTP_TIMEOUT, 'SMTP timeout') if $tout == 0; _pm_log "check_network: \"$mserver\" waiting for ACK"; if ($resolve->{$mserver}) { # untaint before passing to Net::Ping my($mserver) = $mserver =~ /(\d+\.\d+\.\d+\.\d+)/; if ($ping->ack($mserver)) { _pm_log "check_network: \"$mserver\" ACK received."; # check user on this mail server my $res = check_user_on_host $mserver, $username, $hostname, $tout; return 1 if $res == 1; return 0 if $res == 0; } else { _pm_log "check_network: \"$mserver\" no ACK received: [". ($ping->nack($mserver) || "no SYN sent")."]"; } } else { _pm_log "check_network: skipping check_user_on_host \"$mserver\" since it did not resolve"; } } } return _result(CU_SMTP_UNREACHABLE, 'Cannot connect SMTP servers: ' . join(', ', @mservers)); } # it should be impossible to reach this statement die "Internal error"; } sub check_user_on_host($$$$) { my($mserver, $username, $hostname, $timeout) = @_; _pm_log "check_user_on_host: checking user \"$username\" on \"$mserver\""; my $start_time = time; # disable warnings because Net::SMTP can generate some on timeout # conditions local $^W = 0; # try to connect to mail server my $tout = _calc_timeout($timeout, $start_time); return _result(CU_SMTP_TIMEOUT, 'SMTP timeout') if $tout == 0; my @hello_params = defined $Helo_Domain ? (Hello => $Helo_Domain) : (); my $smtp = Net::SMTP->new($mserver, Timeout => $tout, @hello_params); unless(defined $smtp) { _pm_log "check_user_on_host: unable to connect to \"$mserver\""; return -1; } # try to check if user is valid with MAIL/RCPT commands $tout = _calc_timeout($timeout, $start_time); return _result(CU_SMTP_TIMEOUT, 'SMTP timeout') if $tout == 0; $smtp->timeout($tout); # send MAIL FROM command unless($smtp->mail($Sender_Addr)) { # something wrong? # check for timeout return _result(CU_SMTP_TIMEOUT, 'SMTP timeout') if $tout == 0; _pm_log "check_user_on_host: can't say MAIL - " . $smtp->message; return -1; } # send RCPT TO command if($smtp->to("$username\@$hostname")) { # give server opportunity to exist gracefully by telling it QUIT my $tout = _calc_timeout($timeout, $start_time); if($tout) { $smtp->timeout($tout); $smtp->quit; } return _result(CU_OK, 'SMTP server accepts username'); } else { # check if verify returned error because of timeout my $tout = _calc_timeout($timeout, $start_time); return _result(CU_SMTP_TIMEOUT, 'SMTP timeout') if $tout == 0; my $code = $smtp->code; # give server opportunity to exist gracefully by telling it QUIT $smtp->timeout($tout); $smtp->quit; if($code == 550 or $code == 551 or $code == 553) { return _result(CU_UNKNOWN_USER, 'no such user'); } elsif($code == 552) { return _result(CU_MAILBOX_FULL, 'mailbox full'); } else { _pm_log "check_user_on_host: unknown error in response"; return _result(CU_OK, 'unknown error in response'); } } # it should be impossible to reach this statement die "Internal error"; } sub _calc_timeout($$) { my($full_timeout, $start_time) = @_; my $now_time = time; my $passed_time = $now_time - $start_time; _pm_log "_calc_timeout: start - $start_time, now - $now_time"; _pm_log "_calc_timeout: timeout - $full_timeout, passed - $passed_time"; my $timeout = $full_timeout - $passed_time; if($timeout < 0) { return 0; } else { return $timeout; } } sub _pm_log($) { my($log_str) = @_; if($Debug) { print STDERR "$log_str\n"; } } sub _result($$) { my($code, $reason) = @_; my $ok = 0; $ok = 1 if $code == CU_OK; $ok = 1 if $code == CU_SMTP_UNREACHABLE; $ok = 1 if $code == CU_MAILBOX_FULL and not $Treat_Full_As_Fail; $ok = 1 if $code == CU_DNS_TIMEOUT and not $Treat_Timeout_As_Fail; $ok = 1 if $code == CU_SMTP_TIMEOUT and not $Treat_Timeout_As_Fail; $Last_Check = { ok => $ok, code => $code, reason => $reason }; my($sub) = (caller(1))[3] =~ /^.*::(.*)$/; _pm_log "$sub: check result is " . ($ok ? 'ok' : 'not ok') . ": [$code] $reason"; return $ok; } 1; __END__ =head1 NAME Mail::CheckUser - check email addresses for validity =head1 SYNOPSIS use Mail::CheckUser qw(check_email); my $ok = check_email($email_addr); use Mail::CheckUser qw(:constants check_email last_check) my $ok = check_email($email_addr); print "DNS timeout\n" if last_check()->{code} == CU_DNS_TIMEOUT; use Mail::CheckUser; my $res = Mail::CheckUser::check_email($email_addr); =head1 DESCRIPTION This Perl module provides routines for checking validity of email address. It makes several checks: =over 4 =item 1 It checks the syntax of an email address. =item 2 It checks if there any MX records or A records for the domain part of the email address. =item 3 It tries to connect to an email server directly via SMTP to check if mailbox is valid. Old versions of this module performed this check via the VRFY command. Now the module uses another check; it uses a combination of MAIL and RCPT commands which simulates sending an email. It can detect bad mailboxes in many cases. =back If is possible to turn off some or all networking checks (items 2 and 3). See L<"GLOBAL VARIABLES">. This module was designed with CGIs (or any other dynamic Web content programmed with Perl) in mind. Usually it is required to quickly check e-mail addresses in forms. If the check can't be finished in reasonable time, the e-mail address should be treated as valid. This is the default policy. By default if a timeout happens the result of the check is treated as positive. This behavior can be overridden - see L<"GLOBAL VARIABLES">. =head1 IMPORTANT WARNING In many cases there is no way to detect the validity of email addresses with network checks. For example, non-monolithic mail servers (such as Postfix and qmail) often report that a user exists even if it is not so. This is because in cases where the work of the server is split among many components, the SMTP server may not know how to check for the existence of a particular user. Systems like these will reject mail to unknown users, but they do so after the SMTP conversation. In cases like these, the only absolutely sure way to determine whether or not a user exists is to actually send a mail and wait to see if a bounce messages comes back. Obviously, this is not a workable strategy for this module. Does it mean that the network checks in this module are useless? No. For one thing, just the DNS checks go a long way towards weeding out mistyped domain parts. Also, there are still many SMTP servers that will reject a bad address during the SMTP conversation. Because of this, it's still a useful part of checking for a valid email address. And this module was designed such that if there is exists possibility (however small) that the email address is valid, it will be treated as valid by this module. Another warning is about C<$Mail::CheckUser::Treat_Timeout_As_Fail> global variable. Use it carefully - if it is set to true then some valid email addresses can be treated as bad simply because an SMTP or DNS server responds slowly. Another warning is about C<$Mail::CheckUser::Treat_Full_As_Fail> global variable. Use it carefully - if it is set to true then some valid email addresses can be treated as bad simply because their mailbox happens to be temporarily full. =head1 EXAMPLE This simple script checks if email address C is valid. use Mail::CheckUser qw(check_email last_check); my $email = 'blabla@foo.bar'; if(check_email($email)) { print "E-mail address <$email> is OK\n"; } else { print "E-mail address <$email> isn't valid: ", last_check()->{reason}, "\n"; } =head1 SUBROUTINES =over 4 =item $ok = check_email($email) Validates email address C<$email>. Return true if email address is valid and false otherwise. =item $res = last_check() Returns detailed result of last check made with C as hash reference: { ok => OK, code => CODE, reason => REASON } =over 4 =item OK True if last checked email address is valid. False otherwise. =item CODE A number which describes result of last check. See L<"CONSTANTS">. =item REASON A string which describes result of last check. =back =back =head1 CONSTANTS Constants used by C to describe result of last check can be exported with use Mail::CheckUser qw(:constants) List of all defined constants: =over 4 =item CU_OK Check is successful. =item CU_BAD_SYNTAX Bad syntax of email address. =item CU_UNKNOWN_DOMAIN Mail domain mentioned in email address is unknown. =item CU_DNS_TIMEOUT Timeout has happen during DNS checks. =item CU_UNKNOWN_USER User is unknown on SMTP server. =item CU_SMTP_TIMEOUT Timeout has happen during SMTP checks. =item CU_SMTP_UNREACHABLE All SMTP servers for mail domain were found unreachable during SMTP checks. =item CU_MAILBOX_FULL Mailbox is temporarily full but probably a valid username. =back =head1 GLOBAL VARIABLES It is possible to configure C using the global variables listed below. =over 4 =item $Mail::CheckUser::Skip_Network_Checks If true then do only syntax checks. By default it is false. =item $Mail::CheckUser::Skip_SMTP_Checks If it is true then do not try to connect to mail server to check if a user exists. If this is true, and C<$Mail::CheckUser::Skip_Network_Checks> is false, only syntax and DNS checks are performed. By default it is false. =item $Mail::CheckUser::Skip_SYN By default L is used to determine remote reachability of SMTP servers before doing SMTP checks. Setting this to true skips this check. By default it is false. =item $Mail::CheckUser::Sender_Addr MAIL/RCPT check needs an email address to use as the 'From' address when performing its checks. The default value is C. =item $Mail::CheckUser::Helo_Domain Sender domain used in HELO SMTP command. If undef L is allowed to use its default value. By default it is undef. =item Mail::CheckUser::Timeout Timeout in seconds for network checks. By default it is C<60>. =item $Mail::CheckUser::Treat_Timeout_As_Fail If it is true C treats checks that time out as failed. By default it is false. =item $Mail::CheckUser::Treat_Full_As_Fail If it is true C treats error "552 mailbox full" as an invalid email and sets CU_MAILBOX_FULL. By default it is false. =item $Mail::CheckUser::Net_DNS_Resolver Override with customized Net::DNS::Resolver object. This is used to lookup MX and A records for the email domain when network checks are enabled. If undef, Net::DNS::Resolver->new will be used. The default value is undef. =item $Mail::CheckUser::Debug If it is true then enable debug output on C. By default it is false. =back =head1 AUTHORS Ilya Martynov B Rob Brown B Module maintained at Source Forge ( http://sourceforge.net/projects/mail-checkuser/ ). =head1 COPYRIGHT Copyright (c) 1999-2003 by Ilya Martynov. All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. $Id: CheckUser.pm,v 1.46 2003/09/18 23:51:36 hookbot Exp $ =head1 SEE ALSO perl(1). =cut Mail-CheckUser-1.21/MANIFEST000064400000000000000000000002541147255004400153230ustar00rootroot00000000000000Changes CheckUser.pm MANIFEST Makefile.PL README TODO procmail/cufilter procmail/.procmailrc t/check.pl t/dns.t t/smtp.t t/smtp-taint.t t/syntax.t t/timeout.t t/wildcard.t Mail-CheckUser-1.21/Makefile.PL000064400000000000000000000004561147255004400161500ustar00rootroot00000000000000use ExtUtils::MakeMaker; WriteMakefile NAME => 'Mail::CheckUser', VERSION_FROM => 'CheckUser.pm', # finds $VERSION PREREQ_PM => { 'Net::SMTP' => 2.13, 'Net::Ping' => 2.24, 'Net::DNS' => 0.31, 'IO::Handle' => 1.21, }, EXE_FILES => ['procmail/cufilter'], ; Mail-CheckUser-1.21/README000064400000000000000000000035141147255004400150540ustar00rootroot00000000000000SHORT DESCRIPTION This Perl module provides routines for checking validity of email address. It makes several checks: 1) it checks the syntax of an email address; 2) it checks if there any MX records or A records for the domain part of the email address; 3) it tries to connect to an email server directly via SMTP to check if mailbox is valid. Old versions of this module performed this check via the VRFY command. Now the module uses another check; it uses a combination of MAIL and RCPT commands which simulates sending an email. It can detect bad mailboxes in many cases. This module was designed with CGIs (or any other dynamic Web content programmed with Perl) in mind. Usually it is required to quickly check e-mail addresses in forms. If the check can't be finished in reasonable time, the e-mail address should be treated as valid. For details see pod documentation in Mail::CheckUser REQUIREMENTS This module requires next Perl modules: 1) Net::SMTP (libnet package) 2) Net::DNS (Net-DNS package) 3) IO::Handle (IO package) 4) Net::Ping (Net-Ping package) Perl distributions before 5.6 contain version of IO::Handle which has bugs in timeouts handling. Download latest version from CPAN if you haven't done it before. INSTALLATION perl Makefile.PL make make test make install Tests may run very slow especially if networking is down. LICENSE Mail::CheckUser is provided "as is" and without any express or implied warranties, including, without limitation, the implied warranties of merchantibility and fitness for a particular purpose. Mail::CheckUser is released under the same terms as Perl itself. For more information see the "README" or "Artistic" files provided with the Perl distribution. BUGS If you have encountered any problems with this module fill free to contact author (Ilya Martynov ). Mail-CheckUser-1.21/TODO000064400000000000000000000006021147255004400146570ustar00rootroot000000000000001) Check what happens if SMTP server doesn't like our HELO query 2) Do not allow mail server's on private networks like 192.168.*.* 3) OO interface 4) More correct syntax checking (better comformance to RFC 822) 5) Allow users to specify on 'perl Makefile.PL' test mailboxes that will be tested on 'make test' (?) 6) Allow specify DNS servers with which dns checks should be done. Mail-CheckUser-1.21/procmail/000075500000000000000000000000001147255004400157775ustar00rootroot00000000000000Mail-CheckUser-1.21/procmail/.procmailrc000064400000000000000000000000761147255004400201360ustar00rootroot00000000000000# Filter mail through Mail::CheckUser :0f | /usr/bin/cufilter Mail-CheckUser-1.21/procmail/cufilter000075500000000000000000000061151147255004400175450ustar00rootroot00000000000000#!/usr/bin/perl =pod =head1 NAME cufilter - Filter emails through Mail::CheckUser =head1 SYNOPSIS Add the following lines to your ~/.procmailrc: # Filter mail through Mail::CheckUser :0f | /usr/bin/cufilter =head1 DESCRIPTION When email messages are filtered through this program using the procmail settings as outlined in the SYNOPSYS, the email address in the "From:" header is passed through Mail::CheckUser to ensure validity. If there is a problem with the email address, the "Subject:" header is modified to show which email address failed along with the failure reason. No messages are lost, but it provides an easy way for the mail client to organize, sort, or filter based on the subject tweaks. =head1 EXAMPLES Lets say a spammer sends a message with the following headers: From: god@heaven.org To: you@host.com Subject: Happy Pill Then the new headers might change to the following: From: god@heaven.org To: you@host.com Subject: [CU!god@heaven.org!DNS failure: SERVFAIL] Happy Pill This makes it easy to filter for mail clients. =head1 INSTALL This file can be installed into /usr/bin/cufilter and is intended to be utilized through the procmail functionality by adding the following lines to your ~/.procmailrc configuration. # Filter mail through Mail::CheckUser :0f | /usr/bin/cufilter =head1 AUTHORS Rob Brown bbb@cpan.org =head1 COPYRIGHT Copyright (c) 2003 Rob Brown bbb@cpan.org. All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. $Id: cufilter,v 1.3 2003/09/18 15:36:26 hookbot Exp $ =head1 SEE ALSO Mail::CheckUser(3), procmail(1). =cut use strict; use Mail::CheckUser qw(check_email last_check); use vars qw($VERSION); $Mail::CheckUser::Timeout = 300; $Mail::CheckUser::Treat_Timeout_As_Fail = 1; $Mail::CheckUser::Treat_Full_As_Fail = 1; $VERSION = "0.03"; my $HEAD = ""; my %checks = (); while () { if (/^[\r\n]+$/) { $HEAD .= "Subject: (no subject)\r\n" unless $HEAD =~ /^Subject:/im; if (keys %checks) { foreach my $check (keys %checks) { if ($checks{$check}->[0]) { # Bad email $HEAD =~ s/^(Subject:)/$1 [CU!$check!$checks{$check}->[1]]/im; } } } else { $HEAD =~ s/^(Subject:)/$1 [CU!no sender address found!]/im; } print $HEAD; print "X-CU-Filter: $Mail::CheckUser::VERSION/$VERSION - Checked ".(scalar keys %checks)." addresses\r\n"; print "\r\n"; while () { print; } exit; } $HEAD .= $_; if (/^\S*(return-path|from|sender)\S*[: ]+(.+)/i) { my $email = $2; $email = $1 if $email =~ /\<(\S*)\>/; 1 while $email =~ s/\([^()]\)//; 1 while $email =~ s/"[^\"]"//; $email =~ s/(@\S+)\s.*/$1/; $email =~ s/.*\s(\S+@)/$1/; if ($email =~ /@/) { $email =~ y/A-Z/a-z/; $checks{$email} ||= do { check_email($email); my $l = last_check; [$l->{code}, $l->{reason}]; }; } } elsif (/^[\w\-]+:.*/ || /^[ \t]/) { # Looks like a valid header } else { $HEAD =~ s/(.*)$/X-Invalid-Header: $1/; } } Mail-CheckUser-1.21/t/000075500000000000000000000000001147255004400144345ustar00rootroot00000000000000Mail-CheckUser-1.21/t/check.pl000064400000000000000000000007451147255004400160540ustar00rootroot00000000000000use strict; use Test; use Mail::CheckUser qw(check_email); sub start($) { my($test_num) = @_; plan tests => $test_num; } sub run_test($$) { my($email, $fail) = @_; print "# $email\n"; my $ok = check_email($email); $ok = !$ok if $fail; ok($ok); } sub run_timeout_test($$) { my($email, $timeout) = @_; $Mail::CheckUser::Timeout = $timeout; my $start_time = time; check_email($email); ok(time - $start_time < $timeout + 5) } 1; Mail-CheckUser-1.21/t/dns.t000075500000000000000000000007271147255004400154160ustar00rootroot00000000000000use Mail::CheckUser qw(check_email); require 't/check.pl'; # network test (SMTP check disabled) $Mail::CheckUser::Skip_Network_Checks = 0; $Mail::CheckUser::Skip_SMTP_Checks = 1; $Mail::CheckUser::Timeout = 120; @ok_emails = qw(m_ilya@agava.com m_ilya@hotmail.com); @bad_emails = qw(unknown@for.bar); start(scalar(@ok_emails) + scalar(@bad_emails)); foreach my $email (@ok_emails) { run_test($email, 0); } foreach my $email (@bad_emails) { run_test($email, 1); } Mail-CheckUser-1.21/t/smtp-taint.t000075500000000000000000000000321147255004400167170ustar00rootroot00000000000000#!perl -T do 't/smtp.t'; Mail-CheckUser-1.21/t/smtp.t000075500000000000000000000007771147255004400156220ustar00rootroot00000000000000use Mail::CheckUser qw(check_email); require 't/check.pl'; # network test (SMTP check enabled) $Mail::CheckUser::Skip_Network_Checks = 0; $Mail::CheckUser::Skip_SMTP_Checks = 0; $Mail::CheckUser::Timeout = 120; @ok_emails = qw(m_ilya@agava.com brokenmx@yhoo.com); @bad_emails = qw(unknown@for.bar freghreucew@hotmail.com); start(scalar(@ok_emails) + scalar(@bad_emails)); foreach my $email (@ok_emails) { run_test($email, 0); } foreach my $email (@bad_emails) { run_test($email, 1); } Mail-CheckUser-1.21/t/syntax.t000075500000000000000000000023321147255004400161520ustar00rootroot00000000000000use Test; use Mail::CheckUser qw(:constants check_email last_check); require 't/check.pl'; # syntax test $Mail::CheckUser::Skip_Network_Checks = 1; @ok_emails = qw(foo@aaa.bbb foo.bar@aaa.bbb foo@aaa.bbb.ccc foo.bar@aaa.bbb.ccc foo@aaa.aaa -gizmo-@mail.ru info@a--z.com a1a@b1.c b{x@a.a c~23@a.a); @bad_emails = qw(bar@aaa .bar@aaa.bbb bar.@aaa.bbb bar@aaa.bbb. bar@.aaa.bbb <>[]@aaa.bbb brothren@hiron.bebrothren@hiron.bel.krid.crimea.ua a@a_a.a fred@aol foo@bar.w3c); push @bad_emails, qw(akorobkova@yahoo/com ced); push @bad_emails, 'ralph fred@henry.com'; push @bad_emails, 'user@bad_domain.com'; push @ok_emails, q{jared's_brother@domain.com}; push @bad_emails, 'qqqqqqqqq wwwwwwww@test.com'; push @bad_emails, 'Ваш e-mail OlegNick@nursat.kz'; push @bad_emails, 'РусскийТекст@nursat.kz'; start(scalar(@ok_emails) + scalar(@bad_emails) + 8); foreach my $email (@ok_emails) { run_test($email, 0); } foreach my $email (@bad_emails) { run_test($email, 1); } run_test('test@aaa.com', 0); ok(last_check()->{code} == CU_OK); ok(last_check()->{ok}); ok(defined last_check()->{reason}); run_test('testaaa.com', 1); ok(last_check()->{code} == CU_BAD_SYNTAX); ok(not last_check()->{ok}); ok(defined last_check()->{reason}); Mail-CheckUser-1.21/t/timeout.t000075500000000000000000000004751147255004400163200ustar00rootroot00000000000000use Mail::CheckUser qw(check_email); require 't/check.pl'; # timeout test $Mail::CheckUser::Skip_Network_Checks = 0; $Mail::CheckUser::Timeout = 1; $email = 'm_ilya@agava.com'; @timeouts = (1, 5, 10); start(scalar(@timeouts)); foreach my $timeout (@timeouts) { run_timeout_test($email, $timeout); } Mail-CheckUser-1.21/t/wildcard.t000075500000000000000000000016421147255004400164200ustar00rootroot00000000000000use Mail::CheckUser qw(check_email); require 't/check.pl'; # network test (SMTP check disabled) $Mail::CheckUser::Skip_Network_Checks = 0; $Mail::CheckUser::Skip_SMTP_Checks = 1; $Mail::CheckUser::Timeout = 120; @ok_emails = qw(m_ilya@hotmail.com); @bad_emails = qw| bogus@pqpqpqp-wildcard-qpqpqpqpqpq.bogustld bogus@pqpqpqp-wildcard-qpqpqpqpqpq.com bogus@pqpqpqp-wildcard-qpqpqpqpqpq.net bogus@pqpqpqp-wildcard-qpqpqpqpqpq.nu bogus@pqpqpqp-wildcard-qpqpqpqpqpq.tk bogus@pqpqpqp-wildcard-qpqpqpqpqpq.cc bogus@pqpqpqp-wildcard-qpqpqpqpqpq.mp bogus@pqpqpqp-wildcard-qpqpqpqpqpq.ws bogus@pqpqpqp-wildcard-qpqpqpqpqpq.sh bogus@pqpqpqp-wildcard-qpqpqpqpqpq.pw bogus@pqpqpqp-wildcard-qpqpqpqpqpq.ph bogus@pqpqpqp-wildcard-qpqpqpqpqpq.ba |; start(scalar(@ok_emails) + scalar(@bad_emails)); foreach my $email (@ok_emails) { run_test($email, 0); } foreach my $email (@bad_emails) { run_test($email, 1); }