#!/usr/local/bin/perl

# a continuation of http://cr.yp.to/surveys/smtpsoftware6.txt

use strict;
use IO::Select;
use Getopt::Long;
use IO::Socket::INET;

my %opts;
GetOptions(\%opts,
           'debug!',
           'timeout=s',
           'file=s') || die "GetOptions error: $!\n";

my(%scanned,$socket,$nosocket,$nobanner,%banner,%helo,$nohelo,%ehlo,$noehlo,%from,$nofrom,,%help,$nohelp,%vrfy,$novrfy,%quit,$noquit,%identity);
$opts{timeout} = 3 unless($opts{timeout});
die "must specify --file\n" unless($opts{file});

my $n=0;
open(F, "$opts{file}") || die "cannot open $opts{file}: $!\n";
while(<F>){
	$n++;
	warn "[$n $opts{file}]\n" if($opts{debug});
	chomp(my $ip = $_);
	warn "$ip\n" if($opts{debug});

	if(my $sock = IO::Socket::INET->new(Proto=>'tcp',
	                                 PeerAddr=> $ip,
	                                 PeerPort=> 25,
	                                 Timeout => 3
	                                )){
		$socket++;
		my $select = IO::Select->new;
		$select->add($sock);

		my @banner = getlines($select,$opts{timeout});
		if(@banner){
			if($opts{debug} == 1){
				print "BANNER: ";
				for(@banner){ print " $_"; }
				print "\n";
			}
			if($banner[-1] =~ /^(\d{3})\s/){
				$banner{$1}++;
			}else{
				$banner{bad}++;
			}
		}else{
			warn "$ip misbehaving while retrieving banner\n" if($opts{debug});
			$nobanner++;
		}

		# need HELO to see some sendmail servers
		print $sock "HELO localhost.localdomain.\r\n";
		my @helo = getlines($select,$opts{timeout});
		if(@helo){
			if($opts{debug}){
				print "HELO: ";
				print for(@helo);
				print "\n";
			}
			if($helo[-1] =~ /^(\d{3})\s/){
				$helo{$1}++;
			}else{
				$helo{bad}++;
			}
		}else{
			warn "$ip misbehaving while retrieving helo\n" if($opts{debug});
			$nohelo++;
		}

		# need EHLO to see some sendmail servers
		print $sock "EHLO localhost.localdomain.\r\n";
		my @ehlo = getlines($select,$opts{timeout});
		if(@ehlo){
			if($opts{debug}){
				print "EHLO: ";
				print for(@ehlo);
				print "\n";
			}
			if($ehlo[-1] =~ /^(\d{3})\s/){
				$ehlo{$1}++;
			}else{
				$ehlo{bad}++;
			}
		}else{
			warn "$ip misbehaving while retrieving ehlo\n" if($opts{debug});
			$noehlo++;
		}

		print $sock "MAIL FROM:<>\r\n";
		my @from = getlines($select,$opts{timeout});
		if(@from){
			if($opts{debug}){
				print "FROM: ";
				print for(@from);
				print "\n";
			}
			if($from[-1] =~ /^(\d{3})\s/){
				$from{$1}++;
			}else{
				$from{bad}++;
			}
		}else{
			warn "$ip misbehaving while retrieving from\n" if($opts{debug});
			$nofrom++;
		}

		print $sock "HELP\r\n";
		my @help = getlines($select,$opts{timeout});
		if(@help){
			if($opts{debug}){
				print "HELP: ";
				print for(@help);
				print "\n";
			}
			if($help[-1] =~ /^(\d{3})\s/){
				$help{$1}++;
			}else{
				$help{bad}++;
			}
		}else{
			warn "$ip misbehaving while retrieving help\n" if($opts{debug});
			$nohelp++;
		}

		print $sock "VRFY user\@example.com\r\n";
		my @vrfy = getlines($select,$opts{timeout});
		if(@vrfy){
			if($opts{debug}){
				print "VRFY: ";
				print for(@vrfy);
				print "\n";
			}
			if($vrfy[-1] =~ /^(\d{3})\s/){
				$vrfy{$1}++;
			}else{
				$vrfy{bad}++;
			}
		}else{
			warn "$ip misbehaving while retrieving vrfy\n" if($opts{debug});
			$novrfy++;
		}

		print $sock "QUIT\r\n";
		my @quit = getlines($select,$opts{timeout});
		if(@quit){
			if($opts{debug}){
				print "QUIT: ";
				print for(@quit);
				print "\n";
			}
			if($quit[-1] =~ /^(\d{3})\s/){
				$quit{$1}++;
			}else{
				$quit{bad}++;
			}
		}else{
			warn "$ip misbehaving while retrieving quit\n" if($opts{debug});
			$noquit++;
		}
		my @conversation = (@banner,@helo,@ehlo,@vrfy,@from,@help,@quit);
		my $string;
		foreach(@conversation){
			$string .= $_;
		}
		my $identity = identify($string);
		print "identified $identity\n" if($opts{debug});
		$identity{$identity}++;
	}else{
		warn "$ip: couldnt connect\n" if($opts{debug});
		$nosocket++;
	}
}
close F;

open(LOG, ">$opts{file}.log") || die "cannot write to log: $!\n";
print LOG "socket = $socket\n",
          "nosocket = $nosocket\n",
          "nobanner = $nobanner\n",
          "nohelo = $nohelo\n",
          "noehlo = $noehlo\n",
          "nohelp = $nohelp\n",
          "novrfy = $novrfy\n",
          "noquit = $noquit\n";
while(my($key,$value) = each %banner){
	print LOG "banner $key = $value\n";
}
while(my($key,$value) = each %helo){
	print LOG "helo $key = $value\n";
}
while(my($key,$value) = each %ehlo){
	print LOG "ehlo $key = $value\n";
}
while(my($key,$value) = each %from){
	print LOG "from $key = $value\n";
}
while(my($key,$value) = each %help){
	print LOG "help $key = $value\n";
}
while(my($key,$value) = each %vrfy){
	print LOG "vrfy $key = $value\n";
}
while(my($key,$value) = each %quit){
	print LOG "quit $key = $value\n";
}
while(my($key,$value) = each %identity){
	print LOG "identity $key = $value\n";
}

close LOG;

sub getlines {
	my $select = shift || die "getlines syntax error 1";
	my $timeout = shift || die "getlines syntax error 2";
	my @lines;
	eval {
		$SIG{ALRM} = sub { die "timed out on getlines.\n"; };
		my $alarm = ($timeout * 3);
		alarm($alarm); # just to keep sane
		if(my ($pending) = $select->can_read($opts{timeout})){
			while(<$pending>){
				chomp; chop;
				$_ .= "\n";
				push @lines, $_;
				if(/^\d+\s/){
					last;
				}
			}
		}
		alarm(0);
	};
	alarm(0);
	return(@lines);
}

sub identify {
	my ($conversation) = @_;
	
	s//$conversation/;

	$/ = undef;
	my $type = 'unknown';
	if(/ ESMTP CPMTA-\d_\d_\d_\d.*\n252 send some mail, i.ll try my best\n221/s) { $type='cpqmail' } # critical path
	if(/ ESMTP CPMTA-\d_\d_\d_\d.*\n250.+\sHi\.\n.+530 Authentication required/s) { $type='cpqmail' } # critical path
	elsif(/rblsmtpd.local/) { $type='rblsmtpd' }
	elsif(/214[\s-]qmail home page: http:.+pobox.com.+djb\/qmail.html/) { $type='qmail' }
	elsif(/214[\s-]netqmail home page: http:..qmail.org\/netqmail/) { $type = 'netqmail' }
	elsif(/502 5.5.1 Sorry, we do not support this operation/) { $type='merak' }
	elsif(/E?SMTP Merak \d\./i) { $type='merak' }
	elsif(/250 MessageWall: OK/) { $type = 'messagewall' }
	elsif(/220 .+ sina_smtpd \(/) { $type = 'sina' }
	elsif(/220 .+FTGate /) { $type = 'ftgate' }
	elsif(/214- This is an NT Server running Gordano Ltd/) { $type='ntmail' }
	elsif(/MERCUR SMTP-Server .v.* for Windows NT ready at/s) { $type='mercur' }
	elsif(/ Mail Server 5.7 .* support\@spiderisland.com/s) { $type='tfbbs' }
	elsif(/ -- Server ESMTP .iPlanet Messaging Server /) { $type='sims' }
	elsif(/ Stalker Software.*cgp-support\@stalker.com/s) { $type='stalker' }
	elsif(/ CheckPoint FireWall-1 secure E?SMTP server/) { $type='checkpoint' }
	elsif(/Microsoft Exchange Internet Mail Service /) { $type='microsoft' }
	elsif(/ Mercury 1.[0-9]* ESMTP server ready./) { $type='mercury' }
	elsif(/You are talking to an i-MailDS server/) { $type='imailds' }
	elsif(/ ESMTP Exchange POP3 .4.0.1108. ready/) { $type='microsoft' }
	elsif(/ running LetterRip Server ready\n500 /s) { $type='letterrip' }
	elsif(/ MAILsweeper ESMTP Receiver Version /) { $type='raptor' }
	elsif(/ ESMTP service ready .1. MDaemon v/) { $type='mdaemon' }
	elsif(/NT Server running Internet Shopper/) { $type='ntmail' }
	elsif(/  MailSite ESMTP Receiver Version/) { $type='mailsite' }
	elsif(/ SMTP Server .JAMES SMTP Server/) { $type='james' }
	elsif(/ MailSite SMTP Receiver Version/) { $type='mailsite' }
	elsif(/ VOPmail ESMTP Receiver Version/) { $type='vopmail' }
	elsif(/ Wellcome to HINES mailgateway/) { $type='unknown (HINES)' }
	elsif(/ FirstClass ESMTP Mail Server /) { $type='firstclass' }
	elsif(/ Microsoft ESMTP MAIL Service/) { $type='microsoft' }
	elsif(/ NT-ESMTP Server .*IMail \d/) { $type='imail' }
	elsif(/\(IMail \d/) { $type='imail' }
	elsif(/ Microsoft SMTP MAIL ready /) { $type='microsoft' }
	elsif(/ GroupWise Internet Agent/) { $type='groupwise' }
	elsif(/ 220 Please login at http/) { $type='unknown (Please login)' }
	elsif(/ESMTP Service .Worldmail/) { $type='worldmail' }
	elsif(/ Server ESMTP .PMDF V5.*/) { $type='pmdf' }
	elsif(/ .Lotus Domino Release/) { $type='lotusdomino' }
	elsif(/ SMTP.smap Ready./) { $type='smap' }
	elsif(/ SMTP.smap P2 Ready./) { $type='smap' }
	elsif(/ ESMTP - WinRoute Pro/) { $type='winroute' }
	elsif(/ DSMTP ESMTP .*Server/) { $type='dmail' }
	elsif(/ ArGoSoft Mail Server/) { $type='argosoft' }
	elsif(/214-.*This is [Ss]endmail/) { $type='sendmail' }
	elsif(/ ESMTP Postfix\n250-/s) { $type='postfix' }
	elsif(/ Novonyx SMTP ready/) { $type='netscape' } # novell variant
	elsif(/220.+E?SMTP.+\(Netscape Messaging Server/){ $type='netscape' }
	elsif(/ SMTP Server SLmail/) { $type='slmail' }
	elsif(/ SMTP AnalogX Proxy/) { $type='analogx' }
	elsif(/ VPOP3 SMTP Server/) { $type='vpop3' }
	elsif(/ IMS SMTP Receiver/) { $type='ims' }
	elsif(/ .Mail-Max Version/) { $type='mailmax' }
	elsif(/ ESMTP MailMax \d/) { $type='mailmax' }
	elsif(/ MetaInfo Sendmail/) { $type='sendmailwindows' }
	elsif(/ Metainfo Sendmail/) { $type='sendmailwindows' }
	elsif(/ Sendmail for NT/) { $type='sendmailwindows' }
	elsif(/ UCX V.* OpenVMS/) { $type='ucx' }
	elsif(/ ESMTP MDaemon \d/) { $type='mdaemon' }
	elsif(/ MailShield SMTP/) { $type='mailshield' }
	elsif(/ E?SMTP Sendmail/) { $type='sendmail' }
	elsif(/220 Sendmail E?SMTP \d/) { $type='sendmail' }
	elsif(/ .Post.Office v/) { $type='postoffice' }
	elsif(/ ESMTP Postfix/) { $type='postfix' }
	elsif(/ ESMTP Exim/) { $type='exim' }
	elsif(/ ESMTP \(Exim \d/) { $type='exim' }
	elsif(/ SMTP NAVGW/) { $type='norton' }
	elsif(/\(iMate Mail Server/) { $type='imate' }
	elsif(/ SPA.* ESMTP /) { $type='spa' }
	elsif(/ Kerio MailServer \d/) { $type='kerio' }
	elsif(/220 .+InterScan /) { $type='interscan' }
	elsif(/ NetIQ MailMarshal/) { $type='mailmarshal' }
	elsif(/220.+mailfront/){ $type='mailfront' }
	elsif(/220.+ Eudora /){ $type='eudora' }
	elsif(/220 .+WebShield SMTP/) { $type='webshield' }
	elsif(/220.+ \(Intermail /) { $type='intermail' }
	elsif(/220.+ MailEnable Service/) { $type='mailenable' }
	elsif(/220.+Welcome to RaidenMAILD /){ $type='raidenmaild' }
	elsif(/220.+\(PowerMTA /){ $type='powermta' }
	elsif(/214-.+running the OS.400 operating/){ $type='os400' }
	elsif(/220.+XMail \d/){ $type='xmail' }

	elsif(/ Hello.* here.s what we support.*250 .+ ... Sender Okay\n250-The following SMTP commands are recognized.*startup and give your hostname.*verify deliverability of address.*set debugging level.*The normal sequence of events in sending a message/s) { $type='smail' }
	elsif(/ SMTP service ready\n214-Commands:\n214-	DATA	RCPT	MAIL	QUIT	RSET\n214 	HELO	VRFY	EXPN	HELP	NOOP\n250 Requested mail action okay, completed\n250 Requested mail action okay, completed\n250 Requested mail action okay, completed\n250 Requested mail action okay, completed\n221 SMTP server closing transmission channel/s) { $type='norton' }
	elsif(/ 214-Commands:\n{1,2}214-	DATA	RCPT	MAIL	QUIT	RSET\n214 	HELO	VRFY	EXPN	HELP	NOOP\n250 Requested mail action okay, completed\n220 SMTP service ready\n250 Requested mail action okay, completed/s) { $type='norton' } # serious norton bug
	elsif(/250-PIPELINING\n250-SIZE [0-9]*\n250-ETRN\n250 8BITMIME*\n250.* Ok\n502 Error: command not implemented.*\n221 Bye/s) { $type='postfix' }
	elsif(/SMTP, Pleased to be speaking with you.500 EHLO command is not recognized at this site.* How do are you doing today,/) { $type='unknown (How do are you)' }
	elsif(/220.+SMTP Ready.?\n250.+pleased to meet you.*250 <>... Sender Ok\n214/s) { $type='sendmail' }
	elsif(/250.+Hello.+pleased to meet you\n.+250 <>... Sender ok\n502 Sendmail/s){ $type='sendmail' }
	elsif(/250.+Hello.+pleased to meet you\n.+502 Command.+\n250 <>...Sender ok\n214-Com/s){ $type='sendmail' }
	elsif(/ pleased to meet you.* Duplicate HELO.EHLO\n.+\n250 2.1.0 <>... Sender ok/s) { $type='sendmail' }
	elsif(/ pleased to meet you.* Duplicate HELO.EHLO\n250 2.1.0 <>... Sender ok/s) { $type='sendmail' }
	elsif(/ pleased to meet you.* Duplicate HELO.EHLO\n250 <>... Sender ok/s) { $type='sendmail' }
	elsif(/ pleased to meet you\n250-ENHANCED.+\n.+\(or try finger\)\n250 2.1.0 <>... Sender ok\n/s) { $type='sendmail' }
	elsif(/ pleased to meet you\n250-ENHANCED.+\n.+\n250 2.1.0 <>... Sender ok\n.+214-.+sendmail-bugs/s) { $type='sendmail' }
	elsif(/forging of mail requires recognizable SMTP/) { $type='obtuse' }
	elsif(/ 220-Sendmail 8.6.12.8.6.12 ready/) { $type='sendmail' }
	elsif(/ ..DOCTYPE HTML PUBLIC/) { $type='misconfigured HTTP server' }
	elsif(/\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*/) { $type='unknown (*****)' }
	else{
		open(L, ">>/tmp/conversations");
		print L "---\n",
		        $conversation , "\n\n";
		close L;
	}
	$/="\n";
	return($type);

}