[ADV Socket] cTcp - Guida in italiano

[LordSaga640]

Ho visto che sull'NG qualcuno chiede come gestire più socket insieme solo che si trova male con IO::Select.
Provo a rendere pubblica una mia libreria.
Non l'ho ancora testata affondo.
La libreria è multipiattaforma.
E' compresa anche una guida:



package IO::Socket::cTcp;
use IO::Socket;
use IO::Select;
use Compress::Zlib;
use Carp;
use Time::HiRes;
use Digest::CRC qw(crc32);

use strict;

=head1 NAME

IO::Socket::cTcp - Utilità per la gestione delle connessioni

=head1 SYNOPSIS

use IO::Socket::cTcp;

=head1 REQUIRE LIBRARY
use IO::Socket;
use IO::Select;
use Compress::Zlib;
use Carp;
use Time::HiRes;
use Digest::CRC;

=head1 DESCRIPTION

C<IO::Socket::cTcp> si trova ad un livello superiore rispetto a L<IO::Select>.
Può trovarsi utile nel caso si volessero usare connessioni multiple
con un controllo dei buffer e sulla banda in uscita.

=head1 CONSTRUCTOR

=over 4

=item new ( [ARGS] )

Crea un nuovo oggetto C<IO::Socket::cTcp> .
Gli argomenti sono opzionali.
Es: new (BandLimit=>1500); #Banda limite in upload impostato a 1500 byte al secondo (connessione generica)

=cut
sub new {
my ($class, %argv)=@_;
my $this={};
$this->{config}={};
$this->{config}->{BandLimit}=$argv{BandLimit} || "0";
$this->{IOS}={};
$this->{IOS}->{'read'}=IO::Select->new();
$this->{IOS}->{'write'}=IO::Select->new();
$this->{TimeOut}={};
$this->{TimeOut}->{Correct}=Cycle->new(0.1);
$this->{TimeOut}->{TryConn}=Cycle->new(0.3);
$this->{tosend}={};
$this->{tosend}->{Dedicata}={};
$this->{tosend}->{Comune}={};
$this->{TryConnTmp}={};
$this->{Socket}={};
return bless($this,$class);
}
=back

=head2 METHODS

=over 4

=item AddSock(socket,[Type,[BandLimit]])

Socket è l'oggetto socket che si intende gestire con la libreria cTcp.
"Type" specifica il tipo dello socket.
I tipi di dati possono essere "server,compdata,data";
|->data: Oggetto socket standard con un altro client
|->server: L'oggetto socket specificato viene gestito come server
e avviserà quando qualcuno tenta di connettersi su di esso.
|->compdata: Se specificato questo tipo anche l'altro client deve fare uso della medesima libreria cTcp.
Specificando questo tipo il pacchetto che si tenta di inviare viene compresso con zlib.
Oltre che l'invio di stringhe standard si possono inviare anche hash.
La sicurezza del protocollo non è garantita, è ancora alle prime ver.
bandlimite è la banda che si intende dedicare a questo socket.
Se non è specificato bandlimit, la banda generica usata nel costruttore viene
suddivisa tra gli socket che non hanno specificato bandlimit.
Se bandlimit è negativo è come assegnare a bandlimit un valore infinito.

=cut
sub AddSock {
my ($this, $sock, $type, $bandlimit)=@_;
return undef unless $sock;
return undef if exists %{$this->{Socket}}->{fileno $sock};
$type=$type || 'data';
$bandlimit=0 unless defined $bandlimit;
return undef if $type!~ /^server$|^compdata$|^data$/;
$this->{IOS}->{'read'}->add($sock);
my $socknum=fileno $sock;
$this->{Socket}->{"$socknum"}={};
$this->{Socket}->{"$socknum"}->{Type}=$type;
$this->{Socket}->{"$socknum"}->{BandLimit}=$bandlimit;
$this->{Socket}->{"$socknum"}->{RecvBuff}=[];
$this->{Socket}->{"$socknum"}->{Sock}=$sock;
print "lo socket aggiunto è ".$this->{Socket}->{"$socknum"}->{Type}."<->".fileno($sock)."-".$this->{Socket}->{"$socknum"}->{Sock}."\n";
return 1;
}
=item Select([timeout])

Il metodo Select deve essere chiamato costantemente.
Resta in ascolto di tutti gli socket impostati sull'oggetto cTcp per un tempo massimo impostato su "timeout".
Se timeout è undef il tempo di attesa è infinito fino a quando non accade
qualcosa in uno degli socket da tenere sotto controllo.
Il metodo Select torna un riferimento ad un hash. Ogni elemento dell'hash ha un riferimento ad un array do oggetti socket.
Le chiavi dell'hash che è ritornato dal metodo possono essere:
exception-La funzione Select di Io::Select ha tornato un exception, vedere Io::Select

ConnessioneFallita-Se avete tentato di creare una nuova connessione con il metodo TryConnect()
questo è uno dei valori che vi ritorna per le connessioni che dopo il timeout non sono ancora connesse.

ConnessioneRiuscita-Torna se avete tentato una connessione con TryConnect().
Contiene la lista degli socket correttamente connessi.

ConnectionRequest-Se state monitorando oggetti socket di tipo "server" questo valore vi può ritornare.
Contiene la lista di socket server sui quali c'è una richiesta di connessione.
Per ottenere lo socket in attesa di una connessione su quella porta basta prendere
lo socket server ritornato ed eseguire un $serverobj->accept();

CanRead-Sono disponibili dei dati in lettura su quello socket.
possiamo eseguire un $cTcpObj->recv($socket);
Nel caso la connessione sia un comdata la funzione recv può ritornare un riferimento ad un hash.

Disconnessi-Gli socket di tipo compdata e data disconnessi.

EmptyOutBuff-Quando i buffer in uscita sono stati correttamente inviati vengono inseriti in questa chiave.
Può essere utile nel caso si spediscano pacchetti molti grandi
e appena l'avete finito di inviare volete riempire nuovamente il buffer.
E' sempre una lista di socket.


=cut
sub Select {
my ($this, $timeout)=@_;
my $start=Time::HiRes::time();
my ($alfa, $beta,$gamma);
$this->{Return};

my ($timeout2,$timeout3)=($timeout,0);
LTIME: {
do {
(!defined($timeout)) ? ($timeout3=undef) : (($timeout2>0.20 || $timeout2<0) ? ($timeout3=0.20) : ($timeout3=$timeout2));
#print "Ciao $timeout2 $timeout3\n";
$this->_RefilBuff();
if (($alfa, $beta,$gamma)=IO::Select::select($this->{IOS}->{'read'},$this->{IOS}->{'write'},$this->{IOS}->{'read'},$timeout3)) {
$this->_reader($alfa) if @$alfa>0;
$this->_writer($beta) if @$beta>0;
$this->{Return}->{'exception'}=$gamma if scalar(@$gamma)>0;
}
$this->TryConnTimeout if $this->{TimeOut}->{TryConn}->check;
last LTIME if keys(%{$this->{Return}});
$timeout2=$timeout-(Time::HiRes::time()-$start) if defined($timeout);
last LTIME if $timeout2<0.001;
} while (!defined($timeout) || $timeout2>0);
}
$this->_RefilBuff();
my $return=$this->{Return};
$this->{Return}={};
(keys(%$return)) ? (return $return) : (return undef);
}
sub TryConnTimeout {
my $this=shift;
my ($sock);
foreach $sock ($this->{IOS}->{'write'}->handles) {
if ($this->{TryConnTmp}->{$sock}<Time::HiRes::time()) {
delete %{$this->{TryConnTmp}}->{$sock};
_addItem($this->{Return}, 'ConnessioneFallita', $sock);
$this->{IOS}->{'write'}->remove($sock);
}
}

}
sub _writer {
my ($this, $writer) =@_;
my ($buf,$fno);
foreach $buf (@$writer) {
_addItem($this->{Return}, 'ConnessioneRiuscita', $buf);
$this->{IOS}->{'write'}->remove($buf);
delete %{$this->{TryConnTmp}}->{$buf};
}
}
=item TryConnect(Ip or Host, porta,[timeout])

Tenta di effettura una connessione con l'ip e porta specificata.
I risultati sono ritornati dalla funzione Select.
Il metodo torna l'oggetto socket Non-Bloccante di quella connessione.

=cut
sub TryConnect {
my ($this,$ip, $port, $timeout)=@_;
$timeout=10 unless defined $timeout;
my $SockTest = IO::Socket::INET->new(Proto => 'tcp');
my $ict_set="1";
ioctl ($SockTest,2147772030, $ict_set);
return undef unless $ip=inet_aton $ip;
$SockTest->connect($port, $ip);
$this->{IOS}->{'write'}->add($SockTest);
$this->{TryConnTmp}->{$SockTest}=Time::HiRes::time()+$timeout;
#print "mi connetto a $ip , $port, $timeout , $SockTest\n";
return $SockTest;
}
sub _reader {
my ($this, $reader)=@_;
my $buf;
foreach $buf (@$reader) {
($this->{Socket}->{fileno $buf}->{Type} eq 'server') ?
_addItem($this->{Return}, 'ConnectionRequest', $buf) :
$this->_recv($this->{Socket}->{fileno $buf},$buf,$this->{Return});
}
}
sub _addItem {
my ($ref, $name, $ogg)=@_;
$ref->{$name}=[] unless exists %$ref->{$name};
push(@{$ref->{$name}}, $ogg);
}
sub _addItems {
my ($this, $name, @items)=@_;
print "$name aggiunge ",scalar(@items),"\n";
return undef if scalar(@items)>0;
$this->{Return}->{$name}=[] unless exists %{$this->{Return}}->{$name};
push(@{$this->{Return}->{$name}}, @items);
}
sub _recv {
my ($this,$objsock, $sock, $return)=@_;
my $temp;
recv($sock,$temp,9000,0);
if ($temp) {
_addItem($return, 'CanRead', $sock) if (_bufferizza($objsock,$temp));
} else {
_addItem($return, 'Disconnessi', $sock);
$this->Remove($sock);
}
}
sub _bufferizza {
my ($objsock, $temp)=@_;
$objsock->{TmpRecvBuff}.=$temp;
print "RICEVO ".$objsock->{Type}." $temp\n";
return 1 if ($objsock->{Type} eq 'data');
unless ($objsock->{Header}) {
return undef if (length($objsock->{TmpRecvBuff}) <11);
my %header;
@header{'proto','dim','compression','hash','crc'}= unpack("CICCI",substr($objsock->{TmpRecvBuff},0,11,""));
print "deve arrivare ".$header{'dim'}." byte\n";
return undef if $header{'tipo'}==155;
$objsock->{Header}=1;
$objsock->{DataHeader}=\%header;
}
print "final dim e current ".$objsock->{DataHeader}->{dim}."<->".length($objsock->{TmpRecvBuff})."\n";
return undef if length($objsock->{TmpRecvBuff}) < $objsock->{DataHeader}->{dim};
print "primo passo ci siamo".$objsock->{DataHeader}->{proto}."\n";
$objsock->{Header}=0;
my $data=substr($objsock->{TmpRecvBuff},0,$objsock->{DataHeader}->{dim},"");
return undef if $objsock->{DataHeader}->{proto} != 154;
return undef if crc32($data) != $objsock->{DataHeader}->{crc};
$data=uncompress($data) if $objsock->{DataHeader}->{'compression'};
return undef unless $data;
$data=BinDump::MainDeDump($data) if $objsock->{DataHeader}->{'hash'};
return undef unless $data;
push (@{$objsock->{RecvBuff}}, $data);
print "pacchetto speciale finito di ricevere\n";
my $spnum=_bufferizza($objsock) if length($objsock->{TmpRecvBuff});
return 1+$spnum;
}
=item send(socket,Datas,[Compressed])
socket è lo socket al quale si intendono inviare i dati.
Datas è una stringa o un riferimento ad un HASH (hashref).
Attenzione! Può essere solo un hashref solo nel caso che il tipo dello socket specificato sia 'compdata'.
Compressed è un valore boleano, ha significato solo se il tipo è 'compdata'.
Se è TRUE forza la NON compressione. Di standard viene spedito compresso un pacchetto compdata.

=cut

Segue nel messaggio dopo.
Non potevo inserire l'intero modulo in un solo messaggio.
Quando lo salvate , inserite il codice in un solo file.

[LordSaga640]

sub send {
my ($this,$sock,$data,$compr)=@_;
($compr,$sock)=(!$compr,fileno $sock);

if ($this->{Socket}->{$sock}->{Type} eq 'data') {
return undef if ref($data) eq "HASH";
$this->{Socket}->{$sock}->{ToSendBuff}.=$data;
} elsif ($this->{Socket}->{$sock}->{Type} eq 'compdata') {
my $hashato=0;
if (ref($data) eq "HASH") {
return undef unless $data=BinDump::MainDump($data);
$hashato=1;
}
($compr && length($data)>400) ? ($compr =1) : ($compr=0);
$data=compress($data) if $compr;
$this->{Socket}->{$sock}->{ToSendBuff}.="\x9a".pack("ICCI", length($data),$compr,$hashato,crc32($data)).$data;
} else {
croak "cTcp: Unknow type protocol '".$this->{Socket}->{$sock}->{Type}."'";
}
my $dim=length $this->{Socket}->{$sock}->{ToSendBuff};
return undef unless $dim;

if ($this->{Socket}->{$sock}->{BandLimit}) {
unless (exists $this->{tosend}->{Dedicata}->{$sock}) {
$this->{tosend}->{Dedicata}->{$sock}=$this->{Socket}->{$sock}->{BandLimit};
$this->{tosendnum}++;
}
} else {
unless (exists $this->{tosend}->{Comune}->{$sock}) {
$this->{tosend}->{Comune}->{$sock}=1;
$this->{tosendnum}++;
}
}
$this->_RefilBuff();
return $dim;
}
=item recv(socket)
socket sul quale leggere dati.
Torna qualcosa solo se lo socket contiene veramente dei dati, altrimenti torna undef.
Se l'oggetto socket è compdata il valore tornato può essere un riferimento ad un HASH!
Se l'oggetto socket è compdata il pacchetto è disponibile in lettura solo se è stato ricevuto interamente.


=cut
sub recv {
my ($this, $sock,$lung)=@_;

$sock=fileno $sock;
return undef unless exists $this->{Socket}->{$sock};
if ($this->{Socket}->{$sock}->{Type} eq 'data') {
return substr($this->{Socket}->{$sock}->{TmpRecvBuff},0,$lung || length($this->{Socket}->{$sock}->{TmpRecvBuff}),"");
} elsif ($this->{Socket}->{$sock}->{Type} eq 'compdata') {
return shift(@{$this->{Socket}->{$sock}->{RecvBuff}});
}
return undef;
}
=item Remove(socket)
l'oggetto socket specificato non viene più tenuto sotto osservazione.
Eventuali buffer di dati in uscita ed in entrata vengono immediatamente cancellati.

=cut
sub Remove {
my ($this,$sock)=@_;
print "cancellazione $sock\n";
my $socknum=fileno $sock;
delete (%{$this->{Socket}}->{"$socknum"});
$this->{IOS}->{'read'}->remove($sock);
--$this->{tosendnum} if (delete %{$this->{tosend}->{Comune}}->{fileno $sock});
--$this->{tosendnum} if (delete %{$this->{tosend}->{Dedicata}}->{fileno $sock});
}
sub DESTROY {
my $sock=shift;
print "L'oggettone viene distrutto\n";
}
# $this->{Socket}->{fileno $sock}->{BandLimit} Limite di banda per singolo socket
# $this->{tosend}->{$sock} GLi sock con dati nel buffer=>Banda dedicata
# $this->{config}->{BandLimit} Limite di banda generale per tutti gli host
# $this->{Socket}->{$sock}->{ToSendBuff} Dati dello socket da spedire
sub _RefilBuff {
my ($this)=@_;
#1print "ci provo a chiamarlo ".$this->{TimeOut}->{Correct}."\n";
return undef unless $this->{TimeOut}->{Correct}->check();
return undef unless $this->{tosendnum};
my $dedicata=$this->{tosend}->{Dedicata};
my $comune=$this->{tosend}->{Comune};
my $TempoPassato=Time::HiRes::time()-$this->{LastSend};
$this->{LastSend}=Time::HiRes::time();
$TempoPassato=2 if $TempoPassato>2 || $TempoPassato<=0;
my $numero_comuni=scalar(keys(%$comune));
my $socknum;
if ($numero_comuni) {
my $banda_comune_per_host=$this->{config}->{BandLimit}/$numero_comuni*$TempoPassato;
my $resto=0;
foreach $socknum (keys(%$comune)) {
#print "sock num dei comuni $socknum totali $numero_comuni, banda per host $banda_comune_per_host ->".$this->{Socket}->{"$socknum"}->{Sock}."\n";
$resto=_addtobuff($this->{Socket}->{"$socknum"}->{Sock},$banda_comune_per_host+$resto,\$this->{Socket}->{"$socknum"}->{ToSendBuff});
unless (length $this->{Socket}->{$socknum}->{ToSendBuff}) {
#print "un buffer finito di inviare\n";
delete $comune->{$socknum};
$this->{tosendnum}-- if $this->{tosendnum}>0;
_addItem($this->{Return},'EmptyOutBuff',$this->{Socket}->{"$socknum"}->{Sock});
}
}
}
my $numero_dedicati=scalar(keys(%$dedicata));
my ($band);
if ($numero_dedicati) {
while (($socknum,$band)=each(%$dedicata)) {
$band=$band*$TempoPassato if $band>0;
#print "sock num dei dedicati $socknum totali $numero_dedicati, banda $band\n";
_addtobuff($this->{Socket}->{$socknum}->{Sock},$band,\$this->{Socket}->{$socknum}->{ToSendBuff});
unless (length $this->{Socket}->{$socknum}->{ToSendBuff}) {
#print "un buffer finito di inviare\n";
delete $dedicata->{$socknum};
$this->{tosendnum}-- if $this->{tosendnum}>0;
_addItem($this->{Return},'EmptyOutBuff',$this->{Socket}->{"$socknum"}->{Sock});
}
}
}
}
# rimpie il buffer di uno socket e ritorna il numero di byte che non ha spedito.
# Il terzo valore dei parametri (i dati) deve essere passato come reference ad uno scalare.
sub _addtobuff {
my ($sock, $bandlimit, $dati)=@_;
my ($pacchetto);
$bandlimit=int($bandlimit)+1;
#print "refillo $sock\n";
while (_canwrite($sock)) {
($bandlimit>1400) ? ($pacchetto=1400) : (($bandlimit<0) ? ($pacchetto=1400) : ($pacchetto=$bandlimit));
$bandlimit-=$pacchetto;
last unless $pacchetto=substr $$dati,0,$pacchetto,"";
print "spedisco a $sock -> $pacchetto\n";
send $sock,$pacchetto,0;
last if $bandlimit<1;
}
($bandlimit>0) ? (return $bandlimit) : (return 0);
}
sub _canwrite {
my $sock=shift;
my $rin;
vec($rin,fileno($sock),1) = 1;
return select(undef,$rin,undef,0);
}
=head1 SEE ALSO
Portscanner tramite la funzione TryConnect:

require "ctcp.pm";
$ctcp=cTcp->new();
my $port=1;
while (1) {
if ($ref=$ctcp->Select(0.9)) {
foreach $buf (keys(%$ref)) {
print "$buf this socket:\n";
foreach $socket (@{$ref->{$buf}}) {
print "\t$socket:",$socket->peerhost,"-",$socket->peerport,"\n";
# se lo socket non è connesso peerhost e peerport non tornato alcun valore.
}
}
} else {
print "nothing now\n";
}
$ctcp->TryConnect("127.0.0.1",$port,3);
$port++;
$ctcp->TryConnect("127.0.0.1",$port,3);
$port++;
}

=head1 AUTHOR
DanieleG detto anche LordSaga640 °_° e Itami.

=head1 SEE ALSO

L<IO::Socket>, L <IO::Select>
=cut
1;

{
package Cycle; # Fornisce alcune funzione per l'esecuzione di sub a tempi determinati.
use strict;
use Time::HiRes;
# Ad esempio se vogliamo eseguire una funzione solo 3 secondo dopo l'ultima volta che è stata eseguita
# allora si userà questa funzione.

# Le funzioni che fanno uso di questa libreria non contano molto
# sul tempo ma la sfruttao solo per limitare il carico della CPU.
sub new {
my ($package, $cycle)=@_;
my $timer=bless({},$package);
$timer->{last}=Time::HiRes::time();
$timer->{every}=$cycle;
return $timer;
}
sub check {
my $timer=shift;
return undef if Time::HiRes::time()-$timer->{'last'}<$timer->{every};
$timer->{'last'}=Time::HiRes::time();
return 1;
}
}

{
package BinDump;
# Questo package è una mia piccola invenzione.
# Permette di fare il dump di variabili preregistrate o non.
# BinDump 0.01a by Daniele Guiducci
use strict;

# E' la lista delle variabili che si intende registrare.
# Deve essere uguale per tutti i CLIENT che usano questo package.
# Il nome della variabile viene trasformata in numero secondo l'ordine di inserimento.
# Cambiando questo ordine le comunicazione possono essere un po' (TANTO) confuse.
my @RegisterVar= qw();
my %TagName;
{
my ($buf, $cont)=('',0);
foreach $buf (@RegisterVar) {$TagName{$buf}="\x00".pack("C",$cont++);}
}

# $refvar=Riferimento da una variabile (solo HASH)
# $onlyregister= Se Vero fa il dump dei soli valori registrati per gli HASH.
# $subref = Se vero fa il dump dei riferimenti dell'hash (immaginate le sottodirectory).
# Ritorna il pacchetto binario dumpato.
sub MainDump {
my ($refvar,$onlyregister, $subref)=@_;
return undef if ref($refvar) ne "HASH";
return "\x01".HashDump($refvar,$onlyregister, $subref);
}
# Fa L'operazione inmversa di MainDump.
# Come parametro accetta un pacchetto binario.
# Restituisce un puntatore a qualcosa.
sub MainDeDump {
my $pacchetto=shift;
return HashDeDump(\$pacchetto) if substr($pacchetto,0,1,"") eq "\x01";
return undef;
}
# Fa l'operazione inversa di HashDump. Prende la struttura binaria a la scompatta in un HASH.
# Ritorna l'indirizzo dell'hash depaccato.
sub HashDeDump {
my $pacchetto=shift;
my $hash={};
my ($key, $value);
# Controllo il numero delle variabili dell'HASH.
my $num=unpack("I", substr($$pacchetto,0,4,""));
while (length($$pacchetto)>2) {
($key,$value)=(undef,undef);
$key=GetKeyName($pacchetto);
$value=GetValue($pacchetto);
$hash->{$key}=$value if $key && $value
}
return $hash;
}
# data la struttura binaria analizza i primi byte e ne prende il valore
sub GetValue {
my $ref=shift;
my $type=unpack("C",substr($$ref,0,1,""));
if ($type==6) {
my $lung=unpack("I", substr($$ref,0,4,""));
return substr($$ref,0,$lung,"") if $lung;
return "";
}
return unpack("C",substr($$ref,0,1,"")) if $type==1;
return unpack("S",substr($$ref,0,1,"")) if $type==2;
return unpack("I",substr($$ref,0,1,"")) if $type==3;
return substr($$ref,0,16,"") if $type==5;
return HashDeDump($ref) if $type==4;
return undef;
}
# Dato l'indirizzo di uno scalare, tiglie i primi byte e prende il nome della variabile che segue.
# Se il tipo è \x00 allora è una variabile registrata.
# Se è 0x01 allora segue il nome della variabile in formato <Length 1byte><Name>
sub GetKeyName {
my $ref=shift;
my $type= substr($$ref,0,1,"");
my $name;
if ($type eq "\x00") {
my $var=unpack("C", substr($$ref,0,1,""));
return $RegisterVar[$var] if (defined($RegisterVar[$var]));
return undef;
}
if ($type eq "\x01") {
my $lung=unpack("C", substr($$ref,0,1,""));
return substr($$ref,0,$lung,"") if $lung;
}
return undef;
}
# L'HASH viene encodato un un pacchetto binario molto piccolo.
sub HashDump {
my ($refvar,$onlyregister, $subref)=@_;
my ($KeyName,$KeyValue)=('','');
my $Ncoppie=0;
my $struttura="";
WDUMP: while ( my ($key, $value) = each %$refvar ) {
KNAME:
{
$KeyName=$TagName{$key},last KNAME if exists $TagName{$key};
$KeyName="\x01".pack("C/a*",$key),last KNAME unless $onlyregister;
next WDUMP;
}
# 1=Unsigned Char | 2=Unsigned Short | 3=Unsigned Integer | 4=HASH
# 5=HASH 16 BYTE | 6=Stringa
KVALUE:
{
if (ref($value)) { # Se è un riferimento a qualcosa prova a fare il dumping
next WDUMP unless $subref;
$KeyValue="\x04".HashDump($value,$onlyregister,1),last KVALUE if ref($value) eq "HASH";
next WDUMP;
}
if ($value!~ m/\D/ && $value<4294967296) { # Se contiene solo cifre decimali prova a fare il dumping
$KeyValue="\x01".pack("C", $value),last KVALUE if $value<255;
$KeyValue="\x02".pack("S", $value),last KVALUE if $value<65536;
$KeyValue="\x03".pack("I", $value),last KVALUE;
}
$KeyValue="\x05".$value,last KVALUE if length($value)==16;
# Se non è stato individuato un tipo approriato viene encodato come stringa.
# Va bene per qualsiasi tipo di valore.
$KeyValue="\x06".pack ("I/a*", $value);
}
$Ncoppie++;
$struttura.=$KeyName.$KeyValue;
}
return pack("I", $Ncoppie).$struttura;

}
}
1;

[shishii]

Complimenti...

mi pare una buona idea. :)

[LordSaga640]

Originariamente inviato da shishii
Complimenti...

mi pare una buona idea. :)
Esageri dai ^_^

CMQ voglio dire, che mi ero scordato, che la banda in upload può essere limitata.
Che i pacchetti inviati sono compressi con ZLIB se chi lo riceve usa la stessa libreria.

Che i pacchetti inviati possono non essere solo stringhe di testo.
Un po' di tempo fa creai una libreria che convertiva un HASH di PERL in una stringa binaria. Se questo HASH conteneva nei valori altri HASH veniva fatto anche il dump di tutti gli altri HASH.
Ho deciso quindi di aggiungere questa possibilità nella libreria.

Se inviamo un HASH di 500KB, l'altro client che riceve verrà avverito della possibilità di leggere da quello socket solo quando il pacchetto sarà arrivato in modo completo dall'altra parte.
Verrà estratto il tutto e ritornerà un riferimento ad un HASH.
In questo modo le comunicazioni saranno più facili.
Sfortuatamente non è a prova di Lamer e non garantisco la sua stabilità nel caso i dati da analizzare risultino formattati male (magari appositamente) per far crashare il tutto.


Per le altre cose leggete la guida allegata.
Nel caso il codice fosse mal formattato, usato il pulsante quata per averlo in maniera integrale.

L'esempio che è allegato al codice mostra come creare un portscanner molto rapido su qualsiasi indirizzo Ip. Il bello è che possiamo fare un port scanner mentre inviamo un file di 1GB e ne stiamo ricevendo uno da 2GB.

Fate conto di inviare su uno socket un pacchetto di 1MB °_°.
Durante la chiamata selecrt avvengono molte operazioni.
Non appena tutto il buffer viene svuotato voi verrete avvisati che quello socket non contiene più dati da spedire.
Se volete potete ignorare il messaggio, al contrario potete riempire nuovamente il buffer.
Limitando di quanto volete la banda in upload.

Basta, mi sto dilungando troppo.

Bye Bye.

X shishii
Se keyforum avesse da subito usato questa libreria sarebbe stato un vero spasso, senza il minimo bisogno di creare altri processi.
Avrebbe potuto gestire contemporaneamente (e facilmente) gli socket del webserver e gli socket del core.
Peccato. :(