-
Hola LuisMi
Te paso el código que he utilizado para monitorizar un servidor smtp.
Este script es una modificación de un script hecho por Michal Ludvig que podeis encontrar en http://www.logix.cz/michal/devel/smtp-cli/
#!/usr/bin/perl my $version = "2.8"; ## Require Perl 5.8 or higher -> we need open(.., .., $variable) construct require 5.008; use strict; use IO::Socket::INET; use MIME::Base64 qw(encode_base64 decode_base64); use Getopt::Long; use Socket qw(:DEFAULT :crlf); my ($user, $pass, $host, $port, $addr_family, $use_login, $use_plain, $use_cram_md5, $ehlo_ok, $auth_ok, $starttls_ok, $ssl, $verbose, $hello_host, $datasrc, $mail_from, $rcpt, @rcpt_to, $from, @to, @cc, @bcc, $missing_modules_ok, $missing_modules_count, $subject, $body_plain, $body_html, $print_only, @attachments, @attachments_inline, $sock, $built_message); $mail_from = 'pandora@correo.es'; $rcpt = 'alertas@correo.es'; $host = 'servidorcorreo'; $port = 'smtp(25)'; $addr_family = AF_UNSPEC; $hello_host = 'servidorcorreo'; $verbose = 0; $use_login = 0; $use_plain = 0; $use_cram_md5 = 0; $starttls_ok = 1; $ssl = undef; $auth_ok = 0; $ehlo_ok = 1; $missing_modules_ok = 1; $missing_modules_count = 0; $print_only = 0; #### Try to load optional modules ## IO::Socket::SSL and Net::SSLeay are optional my $have_ssl = eval { require IO::Socket::SSL; require Net::SSLeay; 1; }; if (not $have_ssl and not $missing_modules_ok) { warn("!!! IO::Socket::SSL and/or Net::SSLeay modules are not foundn"); warn("!!! These modules are required for SSL and STARTTLS supportn"); $missing_modules_count += 2; } ## IO::Socket::INET6 and Socket6 are optional my $socket6 = eval { require IO::Socket::INET6; require Socket6; 1; }; if (not $socket6) { if ($addr_family == AF_INET6) { die("!!! IO::Socket::INET6 and Socket6 modules are not foundnIPv6 support is not availablen"); } if (not $missing_modules_ok) { warn("!!! IO::Socket::INET6 -- optional module not foundn"); warn("!!! Socket6 -- optional module not foundn"); warn("!!! These modules are required for IPv6 supportnn"); $missing_modules_count += 2; } } ## MIME::Lite dependency is optional my $mime_lite = eval { require MIME::Lite; 1; }; if (not $mime_lite and not $missing_modules_ok) { warn("!!! MIME::Lite -- optional module not foundn"); warn("!!! Used for composing messages from --subject, --body, --attachment, etc.nn"); $missing_modules_count++; } ## File::Type dependency is optional my $file_type = eval { require File::Type; File::Type->new(); }; if (not $file_type and not $missing_modules_ok) { warn("!!! File::Type -- optional module not foundn"); warn("!!! Used for guessing MIME types of attachmentsnn"); $missing_modules_count++; } ## Term::ReadKey dependency is optional my $have_term_readkey = eval { require Term::ReadKey; 1; }; if (not $have_term_readkey and not $missing_modules_ok) { warn("!!! Term::ReadKey -- optional module not foundn"); warn("!!! Used for hidden reading SMTP password from the terminalnn"); $missing_modules_count++; } my $have_hmac_md5 = eval { require Digest::HMAC_MD5; 1; }; if (not $have_hmac_md5 and not $missing_modules_ok) { if ($use_cram_md5) { die("!!! CRAM-MD5 authentication is not available because Digest::HMAC_MD5 module is missingn"); } warn("!!! Digest::HMAC_MD5 -- optional module missingn"); warn("!!! Used for CRAM-MD5 authentication methodn"); $missing_modules_count++; } ## Advise about --missing-modules-ok parameter if ($missing_modules_count) { warn("!!! Use --missing-modules-ok if you don't need the above listed modulesn"); warn("!!! and don't want to see this message again.nn"); } ## Accept hostname with port number as host:port if ($host =~ /^(.*):(.*)$/) { $host = $1; $port = $2; } ## Automatically start in SSL mode if port == 465 (SSMTP) if (not defined($ssl)) { $ssl = ($port == 465); } # Build the MIME message if required if (defined($subject) or defined($body_plain) or defined($body_html) or @attachments or @attachments_inline) { if (not $mime_lite) { die("Module MIME::Lite is not available. Unable to build the message, sorry.n". "Use --data and provide a complete email payload including headers instead.n"); } if (defined($datasrc)) { die("Requested building a message and at the same time used --data parameter.n". "That's not possible, sorry.n"); } if (defined($body_plain) and -f $body_plain) { local $/=undef; open(FILE, $body_plain); $body_plain = ; close(FILE); } if (defined($body_html) and -f $body_html) { local $/=undef; open(FILE, $body_html); $body_html = ; close(FILE); } my $message = &build_message(); open(BUILT_MESSAGE, "+>", $built_message); $datasrc = "///built_message"; if ($print_only) { $message->print(); exit(0); } else { $message->print(*BUILT_MESSAGE); } seek(BUILT_MESSAGE, 0, 0); } # Username was given -> enable AUTH if ($user) { $auth_ok = 1; } # If at least one --auth-* option was given, enable AUTH. if ($use_login + $use_plain + $use_cram_md5 > 0) { $auth_ok = 1; } # If --enable-auth was given, enable all AUTH methods. elsif ($auth_ok && ($use_login + $use_plain + $use_cram_md5 == 0)) { $use_login = 1; $use_plain = 1; $use_cram_md5 = 1 if ($have_hmac_md5); } # Extract $mail_from address from $from if (not defined($mail_from) and defined($from)) { $mail_from = &find_email_addr($from) or die ("The --from string does not contain a valid email address: $fromn"); } # Extract @rcpt_to list from @to, @cc and @bcc if (not @rcpt_to) { foreach my $rcpt (@to, @cc, @bcc) { my $rcpt_addr = &find_email_addr($rcpt); if (not defined($rcpt_addr)) { warn("No valid email address found in: $rcptn"); next; } push(@rcpt_to, $rcpt_addr); } } # Exit if user haven't specified username for AUTH. if ($auth_ok && !defined ($user)) { die ("SMTP AUTH support requested without --usern"); } # Ask for password if it wasn't supplied on the command line. if ($auth_ok && defined ($user) && !defined ($pass)) { if ($have_term_readkey) { # Set echo off. Term::ReadKey::ReadMode (2); } else { warn ("Module Term::ReadKey not available - password WILL NOT be hidden!!!n"); } printf ("Enter password for %s@%s : ", $user, $host); $pass = ; if ($have_term_readkey) { # Restore echo. Term::ReadKey::ReadMode (0); printf ("n"); } exit if (! defined ($pass)); chop ($pass); } # Connect to the SMTP server. my %connect_args = ( PeerAddr => $host, PeerPort => $port, Proto => 'tcp', Timeout => 5); $sock = IO::Socket::INET->new(%connect_args) or die ("34n"); my ($code, $text); my (%features); # Wait for the welcome message of the server. ($code, $text) = &get_line ($sock); die ("35n") if ($code != 220); # Hello! ... &send_line ($sock, "helo '$hello_host'n"); ($code, $text) = &get_line ($sock); die ("36n") if ($code != 250); # Mail From... &send_line ($sock, "MAIL FROM : $mail_fromn"); ($code, $text) = &get_line ($sock); die ("37'$code'n") if ($code != 250); # Recipient To... &send_line ($sock, "RCPT TO : $rcptn"); ($code, $text) = &get_line ($sock); die ("38n") if ($code != 250); # Good bye... &send_line ($sock, "QUITn"); ($code, $text) = &get_line ($sock); die ("39n") if ($code != 221); printf ("1n"); exit 0; # Get one line of response from the server. sub get_one_line ($) { my $sock = shift; my ($code, $sep, $text) = ($sock->getline() =~ /(d+)(.)([^r]*)/); my $more; $more = ($sep eq "-"); return ($code, $text, $more); } # Get concatenated lines of response from the server. sub get_line ($) { my $sock = shift; my ($code, $text, $more) = &get_one_line ($sock); while ($more) { my ($code2, $line); ($code2, $line, $more) = &get_one_line ($sock); $text .= " $line"; die ("40n") if ($code ne $code2); } return ($code, $text); } # Send one line back to the server sub send_line ($@) { my $socket = shift; my @args = @_; $args[0] =~ s/n/$CRLF/g; $socket->printf (@args); }
