I need to check if remote UDP port is opened. My part of code is:
sub scanUDP {
my $address = shift;
my $port = shift;
my $udpSocket = new IO::Socket::INET (
PeerAddr => $address,
PeerPort => $port,
Proto => 'udp',
) or return 0;
$udpSocket -> send ('hello', 0);
#........SOME CODE.............
return 1;
}
..SOME CODE.. should check if I received ICMP packets "Host unreached" or "Port unreached" to check if port is opened. But how can I do it?
Generally you can't. UDP does not have a connected state, so it is in no way required to send you any reply to the packet you sent. And that's even when ignoring package loss. You may get a positive reply if you sent a valid request in whatever protocol you're accessing and the remote port is open, but the absence of such a reply can not be used to make any conclusions.
If you really get an ICMP unreachable back you will receive the error with a later send call (unless you peer is localhost, than you might get it with the first one already). But there is no guarantee that you will get an ICMP unreachable back at all, because either ICMP or the UDP itself might be filtered by a firewall.
It looks like it will not report the problem on windows this way, but you can use recv there instead of send (works on UNIX too). The error code is probably something specific to windows, ECONNREFUSED works only on UNIX:
use strict;
use warnings;
use IO::Socket::INET;
my $cl = IO::Socket::INET->new(
PeerAddr => '192.168.122.42:12345', # definitly rejecting
Proto => 'udp',
);
$cl->send('foo') or die "send failed: $!"; # first send will succeed
# wait some time to receive ICMP unreachable
sleep(1);
$cl->blocking(0);
if ( ! $cl->recv( my $buf,0)) {
# will get ECONNREFUSED on UNIX, on Win the code is different
warn "error $!" if ! $!{EAGAIN};
}
This is the code that works for me:
sub scanUDP {
my $address = shift;
my $port = shift;
my $socket = new IO::Socket::INET (
PeerAddr => $address,
PeerPort => $port,
Proto => 'udp',
) or return 0;
$socket -> send('Hello',0);
my $select = new IO::Select();
$select -> add($socket);
my #socket = $select -> can_read(1);
if (#socket == 1) {
$socket -> recv(my $temp, 1, 0) or return 0;
return 1;
}
return 1;
}
Related
I'm trying to create a little server who handles multiple clients connections (at least 10). Below the current code that works perfect using fork. At least it accepts several connections from clients.
With the below code, I have the following behaviour:
Client ask for connection ==> Accepted ==> OK
Client sent packet ==> Received and printed ==> OK
Client sent another packet ==> Not received ==> NOK
Most probably, the while cicle will be activated only for each connection request, so that's the reason because I cannot retrieve other packets.
Could someone help me please to adjust the below code? What I need is establish one (or more) client connection, then client send data continuosly (without disconnection) and server should reply on each packet it receives.
#!/usr/bin/perl -w
use IO::Socket::INET;
$SIG{CHLD} = sub {wait ()};
my $socket = new IO::Socket::INET (
LocalHost => '0.0.0.0',
LocalPort => '5000',
Proto => 'tcp',
Listen => 5,
Reuse => 1);
die "cannot create socket $!n" unless $socket;
while ($new_sock = $socket->accept()) {
$pid = fork();
die "Cannot fork: $!" unless defined($pid);
if ($pid == 0) { # This is the fork child
$new_sock->recv(my $data, 500);
print "$data\n";
}
}
You need to loop around the recv call to read more than one package from the client. Also, as it's currently written, the SIGCHLD signal interrupts accept so when the first child process dies, your server program terminates. You could just add a loop around the accept loop to restart the accept call.
Example:
#!/usr/bin/perl
use strict;
use warnings;
use IO::Socket::INET;
$SIG{CHLD} = sub { wait; };
my $socket = new IO::Socket::INET (
LocalHost => '0.0.0.0',
LocalPort => '5000',
Proto => 'tcp',
Listen => 5,
Reuse => 1);
die "cannot create socket $!n" unless $socket;
sub child {
my $sock = shift;
my $data;
print "$$ connected\n";
# loop for as long as there's something coming in
while($sock->recv($data, 500) || $data) {
print "$$ $data"; # prepend the data with the process id
}
print "$$ disconnected\n";
exit 0;
}
while(1) {
while (my $new_sock = $socket->accept()) {
my $pid = fork();
die "Cannot fork: $!" unless defined($pid);
if ($pid == 0) { # This is the fork child
child($new_sock);
}
}
print "accept interrupted - restarting\n";
}
I have a simple device on my network that responds to udp broadcasts of a certain message. It responds to the sender with location information. I can send the broadcast and see the proper response coming in on Wireshark, but my perl code doesn't show the response. I know this must be simple, but I cannot see it...
#!/usr/bin/perl
use warnings;
use IO::Socket::INET;
print "\n>> Discovery Program <<\n";
#--
#-- find.pl
#--
# Create a sending socket
my $sock = IO::Socket::INET->new(
PeerPort => 55555,
PeerAddr => inet_ntoa(INADDR_BROADCAST),
Proto => 'udp',
LocalPort => 0,
Broadcast => 1)
or die "Can't bind : $#\n";
# Send message
my $msg = "XYZ";
chomp $msg;
$sock->send($msg);
# Receive message
my $text;
$sock->recv($text,128);
print "\nReceived message '", $text,"'\n";
I have a perl script that worked as a “middle men” between a local program and an external interactive website.
The problem is that the external website migrated from plain tcp connection to a websocket connection.
When the server was using tcp, after initial connection, the client (the script) and the server (external website) will go thru a handshake, then the script will send the username and password and server will finally respond with some encryption keys, afterwards the script will go into an infinite loop and waited for data from both connections and then process that data and "print" back to the connections as needed.
I had been able to establish the websocket connection with the server using the Mojo::UserAgent as well as with protocol::websocket, go thru the handshake and the other information exchange (username, password, etc), but I have not been able (or better said: I do not know how) to "throw" the websocket connection into the infinite loop via IO::Select ( The reason I want to use IO::Select is because doing so will require minimal changes to the script, but other suggestions are definitely welcome).
The relevant parts of the script are as follows:
# Creating connection for local program
$lsn=new IO::Socket::INET(
Proto => 'tcp',
LocalPort => 6000,
Listen => 1,
);
unless(defined $lsn){
print"$0: $!\n";
exit 1;
}
print"Waiting for local program connection on port 6000\n";
$server=$lsn->accept;
$lsn->close;
unless(defined $server){
print "$0: Unable to accept incoming connection: $!\n";
exit 1;
}
# At this point, the script is waiting for a connection from
# the local program on port 6000
printf"Connection accepted from %s\n",$server->peerhost;
select $server;
binmode $server;
$stdin=$server;
(select)->autoflush(1);
# Creating connection for external website
$net=new IO::Socket::INET(
Proto => 'tcp',
PeerAddr => $yog,
PeerPort => $yserverport,
);
unless(defined($net)){
print "Can't connect!\n";
exit 1;
}
$net->autoflush(1);
####################################
# Here the script and server will #
# exchange information few times #
####################################
my $sel=new IO::Select($stdin,$net);
$net->autoflush(0);
while (1){
foreach my $i($sel->can_read(0.05)){
if($i==$net){
&dosomething;
$net->flush;
}
else{
&dosomething2;
$net->flush;
}
}
}
The infinite loop examples that I have found, are not suitable in this case because I need to use an infinite loop that can check for incoming data on both connections.
WebSockets require a lot than asimple IO Socket. They require handshakes and data framing. I would review the W3C WebSocket API and then look into using a perl module (Net::WebSocket::Server) to do the heavy lifting. Also, webSockets will only work with the chrome browser using SSL so if are interested in cross compatibility, use Net::WebSocket::Server with IO::Socket::SSL instead and here is a working sample of SSL:
#!/usr/bin/perl
use strict;
use warnings;
use IO::Socket::SSL;
use Net::WebSocket::Server;
my $ssl_server = IO::Socket::SSL->new(
Listen => 5,
LocalPort => 4000,
Proto => 'tcp',
SSL_cert_file => '/var/ssl/cert.crt',
SSL_key_file => '/var/ssl/cert.key',
) or die "failed to listen: $!";
my $port = 6000;
my $origin = 'https://YOURDOMAIN.com';
Net::WebSocket::Server->new(
listen => $ssl_server,
on_connect => sub {
our ($serv, $conn) = #_;
$conn->on(
handshake => sub {
my ($conn, $handshake) = #_;
$conn->disconnect() unless $handshake->req->origin eq $origin;
},
utf8 => sub {
my ($conn, $msg) = #_;
my $MyIP = $conn->ip();
my $MyPORT = $conn->port();
$_->send_utf8($msg) for( $serv->connections() );
},
);
},
)->start;
If you are not concerned with Chrome or SSL here is a working non-SSL example, (It needs use strict and use warnings):
#!/usr/bin/perl
use Net::WebSocket::Server;
my $port = 6000;
Net::WebSocket::Server->new(
listen => $port,
on_connect => sub {
my ($serv, $conn) = #_;
$conn->on(
utf8 => sub {
my ($conn, $msg) = #_;
$_->send_utf8($msg) for( $serv->connections() );
},
);
},
)->start;
Also, if you decide to use the SSL version, make sure to update your client side from ws:// to wss://
I get socket handle to Httpd, the host is"127.0.0.1",the port is 80;
sub getHttpNetSock {
my $client = IO::Socket::INET->new(Proto => "tcp",
PeerAddr => $host,
Blocking => 1,
PeerPort => $port)
or return($client);
$client->autoflush(1); # so output gets there right away
return($client);
}
After this if I am able to connect I try to get info from socket.
$ch = getHttpNetSock($apachePort);
if ($ch) {
$ret = getSockVal($ch, $apachePort);
}
where getSockVal:
sub getSockVal {
my $sock = shift;
print $sock "GET http://127.0.0.1:80/test/servlet/HealthServlet\n";
my $val= <$sock>;
chomp($val);
return($val);
}
HealthServlet could return just "OK" or "TROUBLE", but in one of 100 cases I get absolutely another information. Why it could happen?
Apache and perl scripts are on the VMware virtual machine.
As you just want a GET-Request you need not resort to IO::Socket::INET and handle HTTP, let LWP do that for you.
For easy error checking the preferred way would be with LWP::UserAgent, as described here:
http://search.cpan.org/dist/libwww-perl/lib/LWP/UserAgent.pm
--|proxy|--|mux|--|demux|--|proxy|--
--
--
--
machineA satellite link machineB
172.16.1.224 172.16.1.218
Greetings,
I have setup as above. I'm trying to create 'mux'. Basically, it reads traffic from a proxy and splits it up for transmission over 4 wires. The 'demux' reads off 4 wires and forwards traffic on to the proxy.
I've got a basic client/server setup in Perl. But I don't know how to get traffic from the proxy into 'mux'?
Here is my code:
server.pl -- runs on 172.16.1.218
use IO::Socket;
$| = 1;
$socket = new IO::Socket::INET (
LocalHost => '172.16.1.218',
LocalPort => '5000',
Proto => 'tcp',
Listen => 5,
Reuse => 1
);
die "Coudn't open socket" unless $socket;
print "\nTCPServer Waiting for client on port 5000";
while(1)
{
$client_socket = "";
$client_socket = $socket->accept();
$peer_address = $client_socket->peerhost();
$peer_port = $client_socket->peerport();
#print "\n I got a connection from ( $peer_address , $peer_port ) ";
while (1){
$send_data = <STDIN>;
$client_socket->send($send_data);
$client_socket->recv($recieved_data,10);
print $recieved_data;#."\n";
#$client_socket->autoflush();
}
}
and:
client.pl
use IO::Socket;
$socket = new IO::Socket::INET (
PeerAddr => '172.16.1.224',
PeerPort => 5000,
Proto => 'tcp',
)
or die "Couldn't connect to Server\n";
while (1) {
$socket->recv($recv_data,10);
print $recv_data."\n";
$send_data = <STDIN>;
$socket->send($send_data);
}
I'm just a bit stuck and would appreciate any comments.
Many thanks in advance,
Your server is handling just one connection. You should use an array of connections (#socket).
You have two infinite loops nested. Since the inner one is never going to finish, you are going to attend only the first connection.
This seems a typical chat server, so i recommend you to search Google for "perl chat server". Here you have some source code that can be of help:
http://sourceforge.net/projects/perlchat/