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
Related
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 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;
}
I am Perl beginner and I am fighting with websockets at the moments. After a lot of reading, trying and copy-pasting I got this code to work:
use strict;
use warnings;
use utf8;
use Data::Dumper;
use IO::Async::Loop;
use IO::Async::Timer::Periodic;
use Net::Async::WebSocket::Client;
use Protocol::WebSocket::URL;
my ($url, $msg, $last_update);
$url = 'ws://127.0.0.1/stream';
$msg = 'get_lists';
my $uri = Protocol::WebSocket::URL->new->parse($url);
my $loop = IO::Async::Loop->new;
my $client = Net::Async::WebSocket::Client->new(
on_frame => sub {
my ($self, $frame) = #_;
chomp($frame);
$last_update = time(); # use this in timer below
# do something else
}
);
$loop->add($client);
$client->connect(
host => $uri->host,
service => $uri->port,
url => $url,
on_connected => sub {
warn "Connection established";
if ($msg) {
$client->send_frame("$msg\n");
}
},
on_connect_error=> sub { die "CONNECT: ".Dumper \#_; },
on_resolve_error=> sub { die "RESOLVE: ".Dumper \#_; },
on_fail => sub { die "FAIL: ".Dumper \#_; },
on_read_eof => sub {
$loop->remove($client);
# reconnect?
}
);
# is the connection to socket is still open?
# check every 30 seconds if $last_update was not updated
my $timer = IO::Async::Timer::Periodic->new(
interval=> 30,
on_tick => sub {
if (!$last_update || time()-30 > $last_update) {
warn "Connection probably dead. No new data for 20 seconds.";
## check connection
## and reconnect if needed
}
},
);
$timer->start;
$loop->add($timer);
$loop->loop_forever;
I need one more thing here and I am not sure how to solve this:
I found some info like https://stackoverflow.com/a/12091867/1645170 but I do not understand how to put SO_KEEPALIVE in my code. I should probably make my own IO::Socket connection and somehow pass it to Async::Net::WebSocket but I was not able to do it. Actually I don't really have an idea how shoud I do this. Obviously beginner's problems.
I tried the second approach with a timer which should check every 30 seconds whether the connection is open (if no new data came through socket). Again, same problem but from the other side: not sure how to check with the above code whether the connection is open.
I could make a basic IO::Socket connection but I would like to do somehow with the above code because I like how Net::Async::WebSocket does it with events (on_read-eof, on_frame etc).
How to check if it is still works?
Create a "heartbeat". Send a "ping" at every x second from a client and wait until a "pong" gets back. Die if timeout reached.
On the server you could add your own socket (from one of the examples).
If hope it will help you.
my $serversock = IO::Socket::INET->new(
LocalHost => "127.0.0.1",
Listen => 1,
) or die "Cannot allocate listening socket - $#";
$serversock->setsockopt(SOL_SOCKET, SO_KEEPALIVE, 1);
my #serverframes;
my $acceptedclient;
my $server = Net::Async::WebSocket::Server->new(
handle => $serversock,
--|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/
here is the request URL http://localhost:9009/?comd&user=kkc&mail=kkc#kkc.com
what are the modification need to do in the server perl script.
server-Perl-script
use IO::Socket;
use Net::hostent; # for OO version of gethostbyaddr
$PORT = 9009; # pick something not in use
$server = IO::Socket::INET->new( Proto => 'tcp',
LocalPort => $PORT,
Listen => SOMAXCONN,
Reuse => 1);
die "can't setup server" unless $server;
print "[Server $0 accepting clients]\n";
while ($client = $server->accept())
{
$client->autoflush(1);
print $client "Welcome to $0; type help for command list.\n";
$hostinfo = gethostbyaddr($client->peeraddr);
printf "[Connect from %s]\n", $hostinfo ? $hostinfo->name : $client->peerhost;
print $client "Command? ";
while ( <$client>) {
next unless /\S/; # blank line
if (/comd/i ) { print $client `dir`; }
} continue {
print $client "Command? ";
}
close $client;
print "client closed";
}
I assume that your script is not for production, but for homework or testing sometime. There are multiple very efficient web server solutions in/with Perl like Apache with CGIs or mod_perl, HTTP::Server::Simple and PSGI/Plack.
You'll also typically use a framework like Dancer, Mojo or Catalyst which does most of the boring standard stuff for you:
use Dancer;
get '/' => sub {
return 'Hi there, you just visited host '.request->host.
' at port '.request->port.' asking for '.request->uri;
};
Back to your question: Your script is a interactive server while HTTP has a strict request and response structure:
Client connects to server
Client sends a request
Server sends a response
You need to remove the interactive part and just wait for the client to start the conversation:
use IO::Socket;
use Net::hostent; # for OO version of gethostbyaddr
$PORT = 9009; # pick something not in use
$server = IO::Socket::INET->new( Proto => 'tcp',
LocalPort => $PORT,
Listen => SOMAXCONN,
Reuse => 1);
die "can't setup server" unless $server;
print "[Server $0 accepting clients]\n";
while ($client = $server->accept())
{
$hostinfo = gethostbyaddr($client->peeraddr);
# Read request up to a empty line
my $request;
while ( <$client>) {
last unless /\S/;
$request .= $_;
}
# Do something with the request
# Send response
print $client "Status: 200 OK\r\nContent-type: text/plain\r\n\r\n".$request;
close $client;
print "client closed";
}
The server reads the full request from the client and returns a minimized HTTP header plus the original request.