#!/usr/bin/perl
#
# etrn.pl
#
# (C) Andres Seco Hernandez, AndresSH@alamin.org, Abril 1998.
# Este script se entrega bajo licencia "GNU General Public License".
# Puedes encontrarla en http://www.gnu.org/copyleft/gpl.html
#
# Envio de ETRN a servidor externo para descarga de mensajes encolados
# para un dominio pendientes de entrega. Esta misma funcionalidad puede
# ser obtenida con FetchMail, que es más potente, pero este script es muy
# sencillo y puede correr tanto en Linux como en NT.
#
# Configurar en el codigo los nombres de dominio y equipos. Buscar las
# cadenas:
#            MiEquipo.MiDominio.com
#            ServidorDelSpoolDeCorreo.SuDominio.com
#            MiDominio.com
#

sub readsmtp {
  $endline="no";
  $ls_received = "";
  $ls_code = "";
  $ls_next = "";
  $counter = 0;
  do {
    $counter += 1;
    read(SMTPSOCKET,$buffer,1);
    if ( $buffer eq "\n" ) {
      $endline = "yes";
    } else {
      $ls_received = $ls_received.$buffer;
      if ( $counter < 4 ) {
        $ls_code = $ls_code.$buffer;
      }
      if ( $counter eq "4" ) {
        $ls_next = $buffer;
      }
    }    
  } until ( $endline eq "yes" );
  return $ls_received, $ls_code, $ls_next;
}

$local = "MiEquipo.MiDominio.com";
$smtp_server = "ServidorDelSpoolDeCorreo.SuDominio.com";
$smtp_port = 25;
$AF_INET = 2;
$SOCK_STREAM = 1;
$sockaddr = 'S n a4 x9';

print "getprotobyname(tcp)=";
($nombre,$alias,$proto) = getprotobyname('tcp');
print "$nombre:$alias:$proto\n";

print "gethostbyname($smtp_server)=";
($nombre,$alias,$tipod,$long,@smtpdirs) = gethostbyname($smtp_server);
($a,$b,$c,$d) = unpack('C4',$smtpdirs[0]);
print "$nombre:$alias:$tipod:$long:$a.$b.$c.$d\n";

print "gethostbyname($local)=";
($nombre,$alias,$tipod,$long,@localdirs) = gethostbyname($local);
($a,$b,$c,$d) = unpack('C4',$localdirs[0]);
print "$nombre:$alias:$tipod:$long:$a.$b.$c.$d\n";

$here = pack($sockaddr,$AF_INET,$smtp_port,$localdirs[0]);
$there = pack($sockaddr,$AF_INET,$smtp_port,$smtpdirs[0]);

select(SMTPSOCKET);
$| = 1;
select(stdout);

socket(SMTPSOCKET,$AF_INET,$SOCK_STREAM,$proto) || die "No puedo abrir $!\n";
print "Socket creado\n";

bind(SMTPSOCKET,$here) || die "No puedo realizar la ligadura\n";
print "Ligadura realizada\n";

$bucle = 0;

do {
  $resultado = connect(SMTPSOCKET,$there);
  if ( $resultado != 1 ) {
    print "No se ha podido conectar. Espera 2 segundos.\n";
    sleep(2);
    $bucle += 1;
    if ( $bucle eq 30 ) {
      $resultado = 1;
      print "30 intentos de conectar sin exito\n";
    }
  }
} while ( $resultado != 1 );
print "Despues de la conexión\n $bucle ";

if ( $bucle eq 30 ) {
  $error = "si";
  print "ERROR por número de intentos de conexión superados\n";
} else {
  $error = "no";
}

if ( $error eq "no" ) {
  $next = " ";
  do {
    # 220 es correcto
    ($received, $code, $next) = readsmtp;
    if ( $code ne "220" ) {
      $error = "yes";
      print "ERROR: $code\n";
    }
    print "Recibido: $received\n";
  } while ( $next ne " " );
}

if ( $error eq "no" ) {
  print "EHLO MiEquipo.MiDominio.Com\n";
  print SMTPSOCKET "EHLO MiEquipo.MiDominio.Com\n";
  $next = " ";
  do {
    # 250 es correcto
    ($received, $code, $next) = readsmtp;
    if ( $code ne "250" ) {
      $error = "yes";
      print "ERROR: $code\n";
    }
    print "Recibido: $received\n";
  } while ( $next ne " " );
}

if ( $error eq "no" ) {
  print "ETRN MiDominio.com\n";
  print SMTPSOCKET "ETRN MiDominio.com\n";
  $next = " ";
  do {
    # 250 es correcto
    ($received, $code, $next) = readsmtp;
    if ( $code ne "250" ) {
      $error = "yes";
      print "ERROR: $code\n";
    }
    print "Recibido: $received\n";
  } while ( $next ne " " );
}

if ( $error eq "no" ) {
  print "QUIT\n";
  print SMTPSOCKET "QUIT\n";
  $next = " ";
  do {
    # 221 es correcto
    ($received, $code, $next) = readsmtp;
    if ( $code ne "221" ) {
      $error = "yes";
      print "ERROR: $code\n";
    }
    print "Recibido: $received\n";
  } while ( $next ne " " );
}

close (SMTPSOCKET);
print "Socket cerrado\n";