On 2009-12-08 13:40:24 +0200, MihaiR wrote:
> Salut,
>
> Imi puteti recomanda o scula de genul:
> - deschide un port TCP si asculta, o singura conexiune, nu
> mai multe simultan (doar pentru niste teste);
> - imi ofera posibilitatea de a vedea ce trimite celalalt
> capat (hex, ascii) si de a rapunde de la tastatura.
>
> In speta, e vorba de a testa un echipament care se
> conecteaza pe un port pe care il pot configura. Acest
> echipament trimite citiva octeti (e un protocol ascii
> simplu) si asteapta de la mine (server) un raspuns de genul
> ACK sau ceva.
> Exista ceva gata facut pentru asa ceva sau trebuie sa ma
> gindesc sa imi fac propria aplicatie.
>
> Intreb pentru ca, parca, nu as vrea sa reinventez roata.
Nu stiu daca problema e chiar atat de complexa incat sa reinventam roti,
uite
inline mai jos niste cod pentru treaba asta de care zici, ca nu-i chiar asa de
complicat. Eu eram mai mult curios de AnyEvent - ca n-am mai folosit - si ti-am
adaptat din doace codul de mai jos. Pare sa functioneze, desi nu acopera cateva
stari elementare, da' ti-l mai modifici tu dupa plac. :)
----------------------------------------------------------------------------------
#! /usr/bin/perl
use strict;
use warnings;
use AnyEvent;
use AnyEvent::Socket;
use AnyEvent::Handle;
=begin lamuriri
pasul 1. instaleaza AnyEvent, daca nu-i
ex: sudo cpan AnyEvent
sau apt-get install libanyevent-perl
sau etc
apoi,
schimba portu si adresa mai jos dupa nevoi
dupa pornire,
legi clientul tcp la el
te conectezi pe socket cu un: socat readline /tmp/testsocket
pe socketu unix ii poti da 's' (send) sau 'q' (quit)
ex: s: ok -- va trimite "ok\015\012" clientului tcp
(v ca daca ai readline la socat ai history & goodies)
pt teste tcp poti face cu un netcat ( ex: nc 0 34832 )
caveats: simplist, incomplet, netestat, etc
(io n-am mai folosit anyevent asta, da' pare misto)
=cut
use constant {
IP => '127.0.0.1', # 0 for all
PORT => '34832',
UNIX_SOCKET => '/tmp/testsocket',
};
my $cv = AnyEvent->condvar;
my ( $sock, $tcp ); # handles
AnyEvent::Socket::tcp_server IP, PORT, sub {
my ( $handle, $host, $port ) = @_;
print "> new tcp connection: $host:$port\n";
$tcp = AnyEvent::Handle->new(
fh => $handle,
on_eof => sub { print "(tcp $host:$port) client eof\n" },
on_error => sub { print "(tcp $host:$port) client err $!\n" },
on_read => sub {
chomp( my $data = delete $tcp->{rbuf} );
print "tcp in: [$data]\n";
$sock && $sock->push_write("tcp in: [$data]\015\012");
},
);
# $tcp->push_write( "server ready\015\012" );
};
AnyEvent::Socket::tcp_server "unix/", UNIX_SOCKET, sub {
my ( $fh ) = @_;
print "< new socket connection\n";
$sock = AnyEvent::Handle->new(
fh => $fh,
on_eof => sub { print "(socket) client eof\n" },
on_error => sub { print "(socket) client err $!\n" },
on_read => sub {
if ( !$tcp ) {
print "no tcp client\n";
$sock->push_write( "no tcp client\015\012" );
return;
}
local $_ = delete $sock->{rbuf};
chomp;
if ( /^s:?\s+([\w\d]+)/i ) {
$tcp->push_write("$1\015\012");
print "tcp out: [$1]\n";
}
elsif ( /^q/i ) {
print "exit\n";
$tcp->push_shutdown;
$sock->push_shutdown;
exit 0;
}
else {
warn "unknown socket cmd: $_\n";
$sock->push_write("unknown cmd: $_\015\012");
}
return;
},
);
$sock->push_write( "commands: [s: <data-to-send-on-tcp>] [q: quit]\015\012"
);
};
printf "listening on tcp %s:%s and unix %s\n", IP, PORT, UNIX_SOCKET;
$cv->wait;
----------------------------------------------------------------------------------
--
perl -MLWP::Simple -e'print$_[rand(split(q.%%\n.,
get(q{http://cpan.org/misc/japh})))]'
_______________________________________________
RLUG mailing list
[email protected]
http://lists.lug.ro/mailman/listinfo/rlug
