Transferência de Arquivos - Cliente & Servidor - PERL

[Dark_Side]

Hi,
O seguinte código mostra como enviar arquivos utilizando o módulo IO::SOCKET em PERL.

CLIENTE.PL

Code Select Expand

use IO::SOCKET; #Usa IO::SOCKET
use File::Basename; # Módulo para obter o nome e extensão do arquivo.
inicio: #Label
system("cls"); #Limpa a tela

# A linha abaixo é apenas um enfeite

print "################################################\n";
print "##Exemplo de tranferencia de arquivos em PERL.##\n";
print "##             ** By Dark_Side **             ##\n";
print "################################################\n\n";


# Pergunta pelo host do servidor

print "=> Digite o host do servidor:\n";
$host = <STDIN>;
chomp($host);

# Pergunta pelo arquivo a enviar

print "=> Digite o caminho do arquivo a enviar:\n";
$arquivo = <STDIN>;
chomp($arquivo);

# Cria um socket TCP.

my $sock = new IO::Socket::INET(
PeerAddr=>$host,
PeerPort=>2222,
Proto=>"tcp"
);
if($sock==0) # Verifca se houve erro
{

# Imprime o erro, fecha o socket, e vai para o "inicio" novamente.

print "Erro ao se conectar ao host \"".$host."\".\n";
erro(); # Chama pela função responsável por reiniciar.

}
 
if(open(arq,$arquivo) ==0) # Tenta abrir o arquivo para leitura.
{
# Em caso de erro:
print "Erro ao abrir o arquivo \"".$arquivo."\".\n";
erro();
}
$temp = basename($arquivo); # Obtém apenas o nome e a extensão do arquivo.
$tamanho = -s $arquivo; # Obtém o tamanho do arquivo.
$sock->send("Arquivo:".$temp."\n"); # Envia para o servidor o nome e extensão do arquivo.
$sock->send("Tam:".$tamanho." Bytes\n"); # Envia o tamanho
print "Aguardando resposta do servidor...\n";
$resp = <$sock>; # Aguarda resposta do servidor.
chomp($resp);
if($resp eq "OK"){ # Se a resposta for OK
envia(); # Envia o arquivo
}
else{ # Se não:
print "O seu pedido de transferencia foi negado.\n";
erro();
}

sub envia() # Função para o envio.
{
binmode arq; # Configura o arquivo como binário.
$chunk=32768; # Ajusta chunk(quantidade de dados a enviar por vez)
$x=1;
while($x>0){ # Enquanto todo o arquivo não for enviado
$x = read(arq,$buffer,$chunk); # Armazena em $x, a quantidade de bytes lidos do arquivo.
$total+=$x; # Incrementa o total lido.
system("cls"); # Limpa a tela
print "Enviando arquivo: ".int($total/$tamanho*100)."%"; # Imprime status.
if($sock->send($buffer)==0 && $total < $tamanho){ # Envia os dados e verifica se houve sucesso:

# Caso não:
print "\nOcorreu um erro ao enviar o arquivo.\n";
erro();
}
}
close(arq); #Fecha o arquivo

#Executa funções finais:

print "\nArquivo enviado!\n";
close($sock);
system("pause");
goto inicio;

}

sub erro(){
close($sock); # Fecha o socket.
system("pause"); # Pausa o programa
goto inicio; # Retorna ao início
}
SERVIDOR.PL

Code Select Expand

use IO::SOCKET; # Usa IO::SOCKET
use Socket; # Usa Socket para as funções getpeername,sockaddr_in e inet_ntoa.

inicio: # Label
system("cls"); #Limpa a tela

# Enfeites

print "################################################\n";
print "##Exemplo de tranferencia de arquivos em PERL.##\n";
print "##             ** By Dark_Side **             ##\n";
print "################################################\n\n";

# Cria um socket TCP e aguarda conexões na porta 2222

my $sock = new IO::Socket::INET(
LocalPort=>'2222',
Proto=>"tcp",
Listen=>1,
);
if($sock==0) # Verifca se houve erro
{
# Imprime o erro, fecha o socket, e vai para o "inicio" novamente.
print "Erro ao inicialziar o socket.";
# Fecha o socket e encerra.
close($sock);
exit 1;

}
print "Aguardando conexoes...\n";
$sock = $sock->accept(); # Aceita novas conexões

$buffer = <$sock>; # Obtém os primeiros dados enviados
if($buffer eq "") # Se não houverem bytes
{
# Reinicia
close($sock);
goto inicio;
}
$buffer =~ m/(:)(.*)/; # Caso hajam bytes, obtém o nome do arquivo.
$arquivo =  $2;

# Recebe novos dados

$buffer = <$sock>;
$buffer =~ m/(:)(.*[0-9])/; # Obtém o tamanho do arquivo que está sendo recebido.
$tamanho =  $2;

# Obtém o IP do cliente
$ip=getpeername($sock);
($porta,$ip)=sockaddr_in($ip);
$ip = inet_ntoa($ip);

# Pede confirmação para aceitar o arquivo
print "Aceitar o arquivo: ".$arquivo." (".$tamanho." Bytes) de ".$ip." (S/N) ?";

aceitar: # Label
$conf = <STDIN>; # Obtém opção
chomp($conf);
if($conf eq "s" || $conf eq "S"){ # Verifica por S ou s
receber(); # Recebe o arquivo
}
elsif($conf eq "n" || $conf eq "N") # Verifica por N ou n
{
$sock->send("NO\n"); # Nega pedido
erro(); # Chama pela função responsável por reiniciar.
}
else # Nenhuma das opções acima
{
print "Opcao invalida.\n Aceitar o arquivo (S/N)?";
goto aceitar; # Retorna à pergunta
}

sub receber() # Função para receber o arquivo
{
if(-e $arquivo){ # Verifica se o arquivo existe
print "O arquivo \"".$arquivo."\" ja existe. Digite um novo nome de arquivo:\n"; # Pede um novo nome
$arquivo = <STDIN>; # Obtém o nome
chomp($arquivo);
receber(); # Volta à função para verificar se o novo arquivo digitado, também não existe.
}
else # Caso não exista
{
abrir($arquivo); # Chama por função para abrir o arquivo.
}
$sock->send("OK\n"); # Envia confirmação para receber o arquivo.
while($buffer = <$sock>)  # Enquanto dados estiverem sendo recebidos.
{
print arq $buffer; # Escreve-os no arquivo.

# Mostra status
system("cls");
$total+=length($buffer);
print "Recebendo o arquivo: ".int($total/$tamanho*100)."%";

}

if($total < $tamanho) # Caso não esteja mais recebendos dados, e o total recebido não for igual ao tamanho do arquivo:
{
print "\nOcorreu um erro ao receber o arquivo\n";
erro();
}
else # Caso o arquivo todo seja recebido
{
print "\nArquivo recebido!\n";
close($sock);
close(arq);
system("pause");
goto inicio;
}
}
sub abrir() # Função responsável pela abertura do arquivo
{
$file = @_[0]; # Obtém parâmetro
if(open(arq,">".$file) == 0) # Tenta abrir o arquivo
{
# Em caso de erro:
print "Erro ao abrir o arquivo\n";
erro();
}
binmode arq; # Configura o arquivo para binário.
}

sub erro()
{
close($sock); # Fecha o socket.
system("pause"); # Pausa o programa
goto inicio; # Retorna ao início
}Bye.

[rodweb]

ótimo kra, mto bom...parabêns!

[Kratos]

Pô D_S ... ta show !!

Bem explicado ... vlw