Newsgroup: it.comp.lang.perl
Titolo: emulare netcat

Salve,
     volevo emulare "nc" con perl, questo è il codice base:
#!/usr/bin/perl
use strict;
use warnings;
use IO::Socket::INET;
use IO::Handle;
STDOUT->autoflush(1);
my $server = IO::Socket::INET->new(LocalPort => '65001', Proto => 'tcp', 
Reuse => 1) || die $!;
my $client;
my $buff;
while ( $server->listen() )
{
   $client = $server->accept();
   $client->autoflush(1);
   recv($client, $buff, 1024, 0);
   print STDOUT $buff;
   syswrite $client, $_ while sysread \*STDIN, $_, 1024;
   close($client);
}
close($server);
__END__;
il fatto è che "sysread \*STDIN, $_, 1024;" è bloccante ovvero non posso 
chidere il socket $client finche non ho terminato di leggere da 
<STDIN>... e se i dati in arrivo da <STDIN> non finissero mai?! c'è un 
modo per ovviare a questo? credete che dovrei forkare in due?
Vorrei fare in modo che appena ricevo una connessione venga killato il 
processo figlio che sta leggendo da <STDIN>
grazie

 grazie
-- 
questo articolo e` stato inviato via web dal servizio gratuito 
http://www.newsland.it/news
 segnala gli abusi ad 
ab...@newsland.it

Roberto C ha scritto:
.....
Ho fatto uno schifo di copia/incolla:
-----------------



sub timeout
{
  exit 1;
}





  alarm $main::timeout;


  $trin = $rin;




__END__;
-----------------
Ecco fatto.
Per cambiarci le e-mail possiamo usare una form di input su uno
spazio WEB se vuoi.
Ciao.
Roberto.


 $main::timeout = 600;
ho provato il tuo codice ma non funziona! e poi è così complicato...io 
avevo in mente una cosa tipo questa:
#!/usr/bin/perl
use strict;
use warnings;
use POSIX qw(:sys_wait_h);
use IO::Socket::INET;
use IO::Handle;
sub REAP {
   1 until (-1 ==waitpid(-1, WNOHANG));
   $SIG{CHLD} = \&REAP;
}
$SIG{CHLD} = \&REAP;
STDOUT->autoflush(1);
my %header;
my $line;
my $client;
my $kid;
my $req;
my $key;
my $sock = IO::Socket::INET->new(LocalPort => '65001',
                           Proto => 'tcp',
                              Reuse => 1,
                                 Listen => SOMAXCONN,
                                    Type => SOCK_STREAM) || die $!;
 
$sock->listen();
while ( $client = $sock->accept() )
{
   next if $kid = fork(); die "fork: $!" unless defined $kid;
   close($sock);
 
   $client->autoflush(1);
 
   chomp($line = <$client>);
 
   while( defined($_ = <$client>) )
   {  
      s/[\r\n]+$//;
      last unless length $_;
      /^ ([\w\-]+) :[\ \t]+ (.+) $/x;
      $key = $1;
      $header{$key} = $2
   }
 
   $req = "$line\n";
 
   foreach (sort keys %header)
   {
      $req .= $_ . ':' . " $header{$_}\n";
   }
 
   $req .= "\n";
   print STDOUT $req;
 
   syswrite $client, $_ while sysread \*STDIN, $_, 1024;
 
   exit; 
 
} continue {
   close($client);
}
__END__;
naturalmente facendo le opportune modifiche...avevo pensato anche a come 
chiudere il scoket... leggendo l'header della response vedo quant'è il 
content-lenght ed esco dalla -while sysread- dopo n bytes letti.

se poi riuscisi a sdoppiare questo codice sarei veramente a buon punto:
#!/usr/bin/perl
use strict;
use warnings;
use IO::Socket::INET;
use IO::Handle;
STDOUT->autoflush(1);
my $key;
my %header;
my $req;
my $line;
while(1)
{
   chomp($line = <STDIN>);
   while( defined($_ = <STDIN>) )
   {  
      s/[\r\n]+$//;
      last unless length $_;
      /^ ([\w\-]+) :[\ \t]+ (.+) $/x;
      $key = uc($1);
      $key =~ tr/-/_/;
      $header{$key} = $2
   }
 
   $req = "$line\n";
 
   foreach (sort keys %header)
   {
      $req .= $_ . ':' . " $header{$_}\n";
   }
 
   $req .= "\n";
 
   {
   my ($buff, $sock);
   $sock = IO::Socket::INET->new(PeerAddr => '127.0.0.1', PeerPort => 
'8000', Proto => 'tcp') || die "$!";
   $sock->autoflush(1);
 
   syswrite $sock, $req;
 
   while ( sysread($sock, $buff, 1024) )
   {
      print STDOUT $buff;
   }
 
   close($sock);
   }
}
Allora, il codice del post precedente è tra browser HOST A e tunnel UDP. 
Inceve il codice quà sopra è tra Apache HOST B e tunnel UDP. dovrei fare 
in modo che appena riceve una nuova connessione chiuda tutto quello che 
stava mndando in STDOUT nel tunnel...così da liberare il tunnel per la 
response della nuova connessione...lo stesso dovrebbe fare il codice nel 
post precedente: ogni volta che il browser accede al server (tra browser 
stesso e tunnel) chiuda tutto quello che sta ricevendo in STDIN...questo 
è importante per lasciare libero il tunnel UDP
grazie

 avevo in mente una cosa tipo questa:
....
Il codice funziona su Linux e dovrebbe funzionare su qualunque sys supporti
syscall POSIX read, write e select. Da me funziona bene. Lo lancio e se
da un' altra macchina mi collego in telnet mi trovo a dialogare con la
console.
In che modo non funziona? E sotto che sistema? Hai preso dello del
secondo post, dove non e' impastato con altra roba? Fammi sapere.
Comunque il problema che hai esposto per forza di cose implica il
multiplexing e select(2) e' necessaria (o la poll(2))
Non ho tempo ora di esaminare l' altro codice. Domani ci do' un' occhiata.
Ciao


 secondo post, dove non e' impastato con altra roba? Fammi sapere.
Mac OS X 10.4.8, Perl v5.8.6 built for darwin-thread-multi-2level
lancio il tuo codice, poi mi collego con "nc" ed il server si 
interrompe...

questa è una piccola idea di quello che dovrebbe fare il mediation 
server tra tunnel UDP e Browser:
## response da Apache Server dall'altra parte del tunnel:
status code + linefeed
header + linefeed
...linea vuota... + linefeed
raw data
##
$client = $sock->accept()
$client->autoflush(1);
chomp($status_line = <STDIN>);
 
HEADER: while( defined($_ = <STDIN>) )
{  
   s/[\r\n]+$//;
   last HEADER unless length $_;
   /^ ([\w\-]+) :[\ \t]+ (.+) $/x;
   $key = $1;
   $header{$key} = $2
}
$size = 0;
## una volta letto l'header della response ricostruiamolo:
$req = "$status_line\n";
 
foreach (sort keys %header)
{
   $req .= $_ . ':' . " $header{$_}\n";
}
 
$req .= "\n";
$content-lenght = $header{"Content-lenght"};
syswrite $client, $req;
RAW_DATA: while( defined( sysread \*STDIN, $buffer, 1024; ) )
{
   $size += do { use bytes; length $buffer };
 
   last RAW_DATA if $size => $content-lenght;
 
   syswrite $client, $buffer;
}
close $client

Larry ha scritto:




Non so' se ho realizzato cio' che ti aspettavi...
Prova ad adattarlo: per capirlo: lancialo, poi da altra macchina o in
localhost collegati con telnet silla porta 65001 (o quella che hai messo)
e scrivi cio' che vuoi. Lo script in STDOUT da me riproduce cio' che
arriva dal telnet. Se a STDIN dello script digiti qualcosa, questo
arriva al client telnet. Se a STDIN digiti Control-D (EOF in Unix)
chiude la connessione, ma questo comportamento lo puoi modificare.
E' commentato. Se in client telnet chiude la connessione, si rimette
in listen per altra connessione. (supporta una connessione alla volta)
Se ti funziona puoi utilizzarne i brandelli per fare cio' che hai in mente.
Come vedi usa select per controllare chi tra STDIN e il socket CLIENT
e' pronto per l' input. In teoria si dovrebbe anche controllare che
siano pronti per l' output prima di scrivervi qualcosa, perche' anche le
write possono essere bloccanti, ma diveniva troppo complesso.
