File Coverage

lib/What/MTA.pm

Criterion	Covered	Total	%
statement	32	101	31.6
branch	4	26	15.3
condition	6	14	42.8
subroutine	7	14	50.0
pod	4	4	100.0
total	53	159	33.3

#$ Id: $;
package What::MTA;
use strict;
use vars qw($VERSION @ISA);
use Socket 1.3;
use Carp;
use IO::Socket;
use Net::Cmd;

$VERSION = "1.00";

@ISA = qw(Net::Cmd IO::Socket::INET);

=head1 NAME

What::MTA - Find out about running MTA

=head1 SYNOPSIS

  $what = What->new(
             Host => my.domain.org,
             Port => 25,
          );

  $what->mta;
  $what->mta_version;
  $what->mta_banner;

=head1 DESCRIPTION

What::MTA is a part of C package. It provides basic information
about running MTA: name, version and banner that MTA prints out upon
connection to it. It is not meant to be used directly, but via its
interface, class C. MTA's supported are: Exim, Postfix (version
only on localhost), Sendmail, Courier (name only), XMail, MaswMail.

The What::MTA class is a subclass of Net::Cmd and IO::Socket::INET.

=head1 CONSTRUCTOR

=over

=item new ( OPTIONS )

This is the constructor for a new What object.

C are passed in a hash like fashion, using key and value pairs.
Possible options are:

=back

=over 4

B - is the name, or address, of the remote host to which a
connection to a running service is required to. It may be a single
scalar, as defined for the C option in L.
C is optional, default value is C.

B and B - These parameters are passed directly
to IO::Socket to allow binding the socket to a local port.

B - Maximum time, in seconds, to wait for a response from the
server (default: 120)

B - Port to which to connect to (default: 25)

B - Enable debugging information

=back

Example:

    $what = What->new(
                       Host    => 'my.mail.domain'
		       Timeout => 30,
                       Debug   => 1,
		     );

    $what = What->new(
		       Host => '10.10.10.1',
                       Port => 25,
		     );

=cut

sub new {
    my $self = shift;
    my $type = ref($self) || $self;
    my %arg = @_;

    my $PeerAddr = $arg{Host} || 'localhost';
    my $PeerPort = $arg{Port} || 'smtp(25)';
    my $Timeout = defined $arg{Timeout} ? $arg{Timeout} : 120;
    my $LocalAddr = $arg{LocalAddr} || undef;
    my $LocalPort = $arg{LocalPort} || undef;

    my $obj = $type->SUPER::new(PeerAddr => $PeerAddr,
				PeerPort => $PeerPort,
				LocalAddr => $LocalAddr,
				LocalPort => $LocalPort,
				Proto    => 'tcp',
				Timeout  => $Timeout,
				);

    if (not defined($obj)) {
       my $msg = "Couldn't create What::MTA object with\n" .
	   "PeerAddr=$PeerAddr,\nPeerPort=$PeerPort,\n" .
	   "Proto=tcp,\nTimeout=$Timeout";
       $msg .= "LocalAddr=$LocalAddr,\n" if defined $LocalAddr;
       $msg .= "LocalPort=$LocalPort,\n" if defined $LocalPort;
       croak $msg;
    }

    $obj->autoflush(1);
    $obj->debug(exists $arg{Debug} ? $arg{Debug} : undef);

    unless ($obj->response() == CMD_OK) {
	$obj->close();
	return undef;
    }

    (${*$obj}{'mta_banner'})  = $arg{Banner} || $obj->message;
    (${*$obj}{'mta_banner'})  =~ s/\n$//;

    $obj->_extract_name_version();

    $obj;
}

sub _EHLO { shift->command("EHLO", @_)->response()  == CMD_OK }
sub _HELO { shift->command("HELO", @_)->response()  == CMD_OK }
sub _HELP { shift->command("HELP", @_)->response()  == CMD_OK }

=head1 METHODS

=over

=item mta()

Returns the name of the MTA running.

=back

=cut

sub mta {
    my $self = shift;
    return ${*$self}{'mta_name'};
};

=over

=item mta_version()

Returns the version of the MTA running.

=back

=cut

sub mta_version {
    my $self = shift;
    return ${*$self}{'mta_version'};
};

=over

=item mta_banner()

Returns the banner message which the server replied with when the
initial connection was made.

=back

=head1 EXAMPLES OF MTA BANNERS

=over 4

=item Exim

  localhost ESMTP Exim 4.60 Mon, 20 Feb 2006 22:38:53 +0000

=item Postfix

  localhost ESMTP Postfix (Debian/GNU)

=item Sendmail

  galeb.somedomain.org ESMTP Sendmail 8.13.5/8.13.5/Debian-3; Mon, 20
  Feb 2006 22:41:04 GMT; (No UCE/UBE) logging access from:
  localhost(OK)-localhost [127.0.0.1]

=item XMail

  <1140475332.2874633136@mast> [XMail 1.22 ESMTP Server] service ready;
  Mon, 20 Feb 2006 22:42:12 -0000

=item MasqMail

  mast MasqMail 0.2.21 ESMTP

=back

=cut

sub mta_banner {
    my $self = shift;
    return ${*$self}{'mta_banner'};
};

=head1 DIAGNOSTICS

=over

=item Can not connect to the serice host/port specified

  Couldn't create What::MTA object with
  PeerAddr=localhost,
  PeerPort=26,
  Proto=tcp,
  Timeout=120 at lib/What.pm line 68

=back

=head1 DEPENDENCIES

Class::Std depends on the following modules:

=over

=item *

L

=item *

L

=item *

L

=back



=cut

sub _extract_name_version {
    my $self = shift;

    if ( (${*$self}{'mta_banner'}) =~ m/Exim/ ) {
        ### Exim ###

	(${*$self}{'mta_version'}) =
	    (${*$self}{'mta_banner'}) =~ m/^.+ESMTP Exim (\d+\.\d+) .+/;

	(${*$self}{'mta_name'}) = "Exim";

    } elsif ( (${*$self}{'mta_banner'}) =~ m/Postfix/ ) {
	### Postfix ###

	my $v;
	eval {
	    $v = `postconf mail_version`;
	};
	if (defined($@)) {
	    (${*$self}{'mta_version'}) = "unknown";
	} else {
	    (${*$self}{'mta_version'}) = $v =~ m/.+ = (.+)/;
	}
	(${*$self}{'mta_name'}) = "Postfix";

    } elsif ( (${*$self}{'mta_banner'}) =~ m/Sendmail/ ) {
	### Sendmail ###

	(${*$self}{'mta_version'}) =
	    (${*$self}{'mta_banner'}) =~ m/^.+Sendmail (\d+\.\d+?.\d+)\/.+/;

	(${*$self}{'mta_name'}) =  "Sendmail";

    } elsif ( (${*$self}{'mta_banner'}) =~ m/XMail/ ) {
	### XMail ###

	(${*$self}{'mta_version'}) =
	    (${*$self}{'mta_banner'}) =~ m/^.+XMail (.+) ESMTP.+/;

	(${*$self}{'mta_name'}) =  "XMail";

    } elsif ( (${*$self}{'mta_banner'}) =~ m/MasqMail/ ) {
	### MasqMail ###

	(${*$self}{'mta_version'}) =
	    (${*$self}{'mta_banner'}) =~ m/^.+MasqMail (.+) ESMTP?.+/;

	(${*$self}{'mta_name'}) =  "MasqMail";

    } elsif ( (${*$self}{'mta_banner'}) =~ m/\w ESMTP$/ ) {
	### Courier? ###

	(${*$self}{'mta_version'}) = "see syslog";
	(${*$self}{'mta_name'}) =  "Courier";

    } else {
	### unkown ###

	(${*$self}{'mta_version'}) = "unknown";
	(${*$self}{'mta_name'}) =  "unknown";

    };
};


1;

=head1 BUGS

Please report any bugs or feature requests to
C, or through the web interface at
L.

=head1 ACKNOWLEDGEMENTS

Lot of code taken from Net::Cmd, without which this class probably
wouldn't have been written.

=head1 AUTHOR

Toni Prug

=head1 COPYRIGHT

Copyright (c) 2006. Toni Prug. All rights reserved.

This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2 of the License, or (at
your option) any later version.

This program is distributed in the hope that it will be useful, but
WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
General Public License for more details.

You should have received a copy of the GNU General Public License
along with this program; if not, write to the Free Software
Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307
USA

See L

=cut