19 Jan
2011
19 Jan
'11
11:07 a.m.
"Perfesto" :-)
Bien está lo que bien acaba.
El 12 de enero de 2011 15:26, Rafa Toucedo <debian.vigo(a)gmail.com> escribió:
Bueno, pues ya se ha solucionado el tema, gracias a
todos por vuestra ayuda
y en especial al Sr Ciges y Sr Couto por su ayuda presencial, os pego el
código final (y funcional).
--------------------------------------
#!/usr/bin/perl
use Net::FTP;
#use Term::ReadKey;
use Getopt::Long;
$t0=@ARGV[0];
$t1=@ARGV[1];
# Posición de las opciones de la línea de comando.
GetOptions("force" => \$force);
# Anulamos el CTRL+C
$SIG{INT} = "IGNORE";
# Localizaciín de los ficheros de LOG.
$FichierErreur = "/home/pilote/psaftp/log/err.txt";
$FichierLog = "/home/pilote/psaftp/log/log.txt";
$FichierLock = "/home/pilote/psaftp/log/lock.dat";
# Localización de ficheros de envío.
$fic1=$t1;
$Fichier="/home/pilote/psaftp/envoi/$fic1";
$Idf=$t0."!";
$Libelle="Enviando archivo : $fic1 $Idf ";
($f1,$f2) = split(/\.zip\Z/, $fic1);
# Usuario y contraseña para la conexión FTP.
$userID="***********";
$userPass="************";
# Dirección del FTP
$Host="************************";
# $Port="4102"; dejamos el puerto estandar (21).
# ******************************************************
# * Procedimiento de gestión de errores *
# ******************************************************
sub success {
open(SUCCESS,"$FichierErreur") || die "imposible abrir $success";
while (<SUCCESS>) {
s/\n//;
if ( $_ =~ /.*(REQUEST:).*/) {
&request("$_");
}
}
close(SUCCESS);
}
sub request{
($a,$b) = $_[0] =~ /.*\s\d{3}\s(.*)\sCommand.*(REQUEST:\s.*\.).*/;
print LOGFILE scalar(localtime) . " : $a\t$b\n";
}
sub erreur {
$nberreur=0;
open(ERREUR,"$FichierErreur") || die "imposible abrir $erreur";
while (<ERREUR>) {
s/\n//;
if ( $_ =~ /.*(\(TRC=).*/) {
$nberreur = $nberreur + 1;
&trc("$_");
}
}
if($nberreur>0) {
print "¡error! mira el fichero de LOG para mas detalles.\n";
close(ERREUR);
return -1;
} else {
close(ERREUR);
return 0;
}
}
sub trc {
($c) = $_[0] =~ /.*(\s\d{3}.*)/;
print LOGFILE scalar(localtime) . " : " . ($c) ."\n";
}
sub GestionErreur {
&success;
$rep = &erreur;
return $rep;
}
# ***********************************
# * PROCEDIMIENTO DE FIN DE PROGRAMA*
# ***********************************
sub End_Prog {
print "\n\nPulsa enter para salir del programa";
$fin = <STDIN>;
chop($fin);
}
# ***************************************************************
# * PROCEDIMIENTO DE CONEXION Y AUTENTICACION DEL SERVIDOR *
# ***************************************************************
# * Los parámetros son : *
# * $_[0] : nombre del servidor remoto *
# * $_[1] : userID de la conexión *
# * $_[2] : contraseña asociada al *
# ***************************************************************
sub Authentification {
open(STDERR, '>', "$FichierErreur");
$ftp = Net::FTP->new($_[0], Port => 21, Debug => 3, Passive => 0);
if ($ftp == undef) {
print "Incapaz de conectarse al host remoto\n";
print "El mensaje de error es : $@\n";
print LOGFILE scalar(localtime) . " : Incapaz de establecer
conexion con la máquina remota\n";
print LOGFILE "El mensaje de error es :" . $@ . "\n";
return -1;
}
print "Estas conectado a la maquina remota\n";
print LOGFILE scalar(localtime) . " : Conexion estsablecida con la
maquina remota\n";
$rep = $ftp->login($_[1], $_[2]);
close(STDERR);
if ($rep == undef) {
GestionErreur;
print "Conexion rechazada : ¡ comprueba tu usuario y contrasen~a
!\n";
print LOGFILE scalar(localtime) . " : Conexion rechazada : ¡
comprueba tu usuario y contrasen~a !\n";
return -1;
}
print "UserID y contrasen~a aceptados por la maquina remota\n";
print LOGFILE scalar(localtime) . " : UserID y contrasen~a aceptados
por la maquina remota\n";
return 0;
}
# ************************************************************
# * PROCEDIMIENTO DE ENVIO DE FICHEROS *
# ************************************************************
# * Los parámetros son *
# * $_[0] : nombre del fichero a transferir. *
# * $_[1] : <IDF>! : IDF a utilizar para el envio *
# * $_[2] : redacción del log de transferencia *
# ************************************************************
sub Envoi {
open(STDERR, "> $FichierErreur");
if( -r $_[0] ) { #######* el -e
comprueba existencia, el -r existencia y apertura*
#el archivo existe y es legible
open(FILE, $_[0]) or die "Error al abrir el archivo $_[0].\n";
close FILE;
} else {
#el archivo no existe o no es legible
print "El archivo $_[0] no existe o no es legible !\ncrea uno antes
de lanzar esta aplicacion...\n";
return -1;
}
print "\nLanzando archivo : ".scalar(localtime)."\nEspera...\n";
print LOGFILE scalar(localtime) . " : Lanzando archivo : $_[2].\n";
if ($f1 ne $fic1) { $ftp->binary(); }
$ftp->put($_[0], $_[1]);
close(STDERR);
$nberr = &GestionErreur;
if ( $! eq '' && $nberr == 0) {
print "Archivo enviado a la maquina remota\n";
print "Archivo transferido correctamente a
".scalar(localtime)."\n";
print LOGFILE scalar(localtime) . " : " . $_[2] . ". Transferencia
correcta\n";
return 0;
} else {
# La gestión de errores se produce al llamar al método "GestionErreur"
print LOGFILE scalar(localtime) . " : $_[2] : Archivo no enviado a
la maquina remota\n";
return -1;
}
}
# **************************************************
# * Principal *
# **************************************************
# Comprobar si ya está funcionando
if ($force) {
unlink($FichierLock);
open(LOCK, "> $FichierLock");
close(LOCK);
} else {
# ver si ya está en marcha
open(LOCK, "$FichierLock");
if($! eq "") {
close(LOCK);
print "La aplicacion ya se esta ejecutando!\nadios!\n";
End_Prog;
exit 0;
} else {
close(LOCK);
open(LOCK, "> $FichierLock");
close(LOCK);
}
}
# ouvre le fichier de log
open(LOGFILE, "+>> $FichierLog");
print LOGFILE
"************************************************************************************************\n";
# phase d"authentification
$rep = Authentification($Host, $userID, $userPass);
# transfert
if ($rep == 0) {
&Envoi($Fichier,$Idf,$Libelle);
}
close(LOGFILE);
unlink($FichierErreur);
unlink($FichierLock);
$ftp->quit();
print "Adios...\n";
#End_Prog;
_______________________________________________
GALPon mailing list
GALPon(a)listas.galpon.org
https://listas.galpon.org/cgi-bin/mailman/listinfo/galpon