The purpose of the application is to listen for a specific UDP multicast and then to forward the data to any TCP clients connected to the server. The code works fine, but I have a problem with the sockets not closing after the TCP clients disconnects. A socketsniffer utility shows the the sockets remain open and all the UDP data continues to be forwarded to the clients. The problem I believe is with the "if ($write->connected())" block as it always return true, even if the TCP client is no longer connected. I use standard Windows Telnet to connect to the server and to see the data. When I close telnet, the TCP socket is suppose to close on the server.
Any reason why connected() show the connections as active even if they are not? Also, what alternative should I use then?
Code:
#!/usr/bin/perl
use IO::Socket::Multicast;
use IO::Socket;
use IO::Select;
my $tcp_port = "4550";
my $tcp_socket = IO::Socket::INET->new(
Listen => SOMAXCONN,
LocalAddr => '0.0.0.0',
LocalPort => $tcp_port,
Proto => 'tcp',
ReuseAddr => 1,
);
use Socket qw(IPPROTO_TCP TCP_NODELAY);
setsockopt( $tcp_socket, IPPROTO_TCP, TCP_NODELAY, 1);
use constant GROUP => '239.2.0.81';
use constant PORT => '6550';
my $udp_socket= IO::Socket::Multicast->new(Proto=>'udp',LocalPort=>PORT);
$udp_socket->mcast_add(GROUP) || die "Couldn't set group: $!\n";
my $read_select = IO::Select->new();
my $write_select = IO::Select->new();
$read_select->add($tcp_socket);
$read_select->add($udp_socket);
## Loop forever, reading data from the UDP socket and writing it to the
## TCP socket(s).
while (1) {
## No timeout specified (see docs for IO::Select). This will block until a TCP
## client connects or we have data.
my #read = $read_select->can_read();
foreach my $read (#read) {
if ($read == $tcp_socket) {
## Handle connect from TCP client. Note that UDP connections are
## stateless (no accept necessary)...
my $new_tcp = $read->accept();
$write_select->add($new_tcp);
}
elsif ($read == $udp_socket) {
## Handle data received from UDP socket...
my $recv_buffer;
$udp_socket->recv($recv_buffer, 1024, undef);
## Write the data read from UDP out to the TCP client(s). Again, no
## timeout. This will block until a TCP socket is writable.
my #write = $write_select->can_write();
foreach my $write (#write) {
## Make sure the socket is still connected before writing.
if ($write->connected()) {
$write->send($recv_buffer);
}
else {
$write_select->remove($write);
close $write;
}
}
}
}
}
I don't know anything about perl, or perl sockets for that matter, but I can't think of a socket API that provides a way to know if a socket is connected. In fact, I'm pretty sure TCP doesn't actually have a way of knowing immediately like this. This suggests to me that connected() is not telling you what you think it is telling you. (I have no idea, but I'll bet it is telling you whether you've called connect/accept or not)
Usually sockets tell you they've become disconnected by reading or writing zero bytes - you might want to check the return value of write to see if it ever returns zero
Thanks for the feedback. I have found a solution that seems to work well for me(Thanks Stewart). It was as simple as checking the return value:
$resultsend = $write->send($recv_buffer);
if (!$resultsend) {
$write_select->remove($write);
close $write;
}
TCP sockets are closed now after a client disconnects.
The IO::Socket connected method just tells you whether the socket is in a connected state, i.e., whether you called "connect" on it after you created it. As Stewart said, there is no general way to tell if the other end of a TCP socket dropped off, and whether you are "still connected".
Off the top of my head, try:
ReuseAddr => 0
I'm more than certain the IO::Socket's magic is what's causing your issues.
Related
This question already has answers here:
How to detect when socket connection is lost?
(2 answers)
Closed 1 year ago.
I'm trying - and failing - to get a perl server to detect and get rid of connection with a client who broke the connection. Everywhere I looked, the suggested method is to use the socket's ->connected() method, but in my case it fails.
This is the server absolutely minimized:
#!/usr/bin/perl
use IO::Socket;
STDOUT->autoflush(1);
my $server = new IO::Socket::INET (
Listen => 7,
Reuse => 1,
LocalAddr => '192.168.0.29',
LocalPort => '11501',
Proto => 'tcp',
);
die "Could not create socket: $!\n" unless $server;
print "Waiting for clients\n";
while ($client = $server->accept()) {
print "Client connected\n";
do {
$client->recv($received,1024);
print $received;
select(undef, undef, undef, 0.1); # wait 0.1s before next read, not to spam the console if recv returns immediately
print ".";
} while( $client->connected() );
print "Client disconnected\n";
}
I connect to the server with Netcat, and everything works fine, the server receiving anything I send, but when I press ctrl-C to interrupt Netcat, 'recv' is no longer waiting, but $client->connected() still returns a true-like value, the main loop never returns to waiting to the next client.
(note - the above example has been absolutely minimized to show the problem, but in the complete program the socket is set to non-blocking, so I believe I can't trivially depend on recv returning an empty string. Unless I'm wrong?)
connected can't be used to reliably learn whether the peer has initiated a shutdown. It's mentioned almost word for word in the documentation:
Note that this method considers a half-open TCP socket to be "in a connected state". [...] Thus, in general, it cannot be used to reliably learn whether the peer has initiated a graceful shutdown because in most cases (see below) the local TCP state machine remains in CLOSE-WAIT until the local application calls "shutdown" in IO::Socket or close. Only at that point does this function return undef.
(Emphasis mine.)
If the other end disconnected, recv will return 0. So just check the value returned by recv.
while (1) {
my $rv = $client->recv(my $received, 64*1024);
die($!) if !defined($rv); # Error occurred when not defined.
last if $received eq ""; # EOF reached when zero.
print($received);
}
Additional bug fix: The above now calls recv before print.
Additional bug fix: Removed the useless sleep. recv will block if there's nothing received.
Performance fix: No reason to ask for just 1024 bytes. If there's any data available, it will be returned. So you might as well ask for more to cut down on the number of calls to recv and print.
Note that even with this solution, an ungraceful disconnection (power outage, network drop, etc) will go undetected. One could use a timeout or a heartbeat mechanism to solve that.
(Running on VS2017, Win7 x64)
I am confused about the point of SO_REUSEADDR and SO_EXCLUSIVEADDRUSE. And yes, I've read the MSDN documentation, but I'm obviously not getting it.
I have the following simple code in two separate processes. As expected, because I enable SO_REUSEADDR on both sockets, the second process's bind succeeds. If I don't enable this on any one of these sockets, the second bind will not succeed.
#define PORT 5150
SOCKET sockListen;
if ((sockListen = WSASocket(AF_INET, SOCK_STREAM, 0, NULL, 0, WSA_FLAG_OVERLAPPED)) == INVALID_SOCKET)
{
printf("WSASocket() failed with error %d\n", WSAGetLastError());
return 1;
}
int optval = 1;
if (setsockopt(sockListen, SOL_SOCKET, `SO_REUSEADDR`, (char*)&optval, sizeof(optval)) == -1)
return -1;
SOCKADDR_IN InternetAddr;
InternetAddr.sin_family = AF_INET;
InternetAddr.sin_addr.s_addr = inet_addr("10.15.20.97");
InternetAddr.sin_port = htons(PORT);
if (::bind(sockListen, (PSOCKADDR)&InternetAddr, sizeof(InternetAddr)) == SOCKET_ERROR)
{
printf("bind() failed with error %d\n", WSAGetLastError());
return 1;
}
So doesn't having to enable SO_REUSEADDR for both sockets make SO_EXCLUSIVEADDRUSE unnecessary - if I don't want anyone to foricibly bind to my port, I just don't enable SO_REUSEADDR in that process?
The only difference I can see is that if I enable SO_EXCLUSIVEADDRUSE in the first process, then attempt a bind in the second process, that second bind will fail with
a) WSAEADDRINUSE if I don't enable SO_REUSEADDR in that second process
b) WSAEACCES if I do enable SO_REUSEADDR in that second process
So I tried enabling both SO_EXCLUSIVEADDRUSE and SO_REUSEADDR in the first process but found that whichever one I attempted second failed with WSAEINVAL.
Note also that I have read this past question but what that says isn't what I'm seeing: it states
A socket with SO_REUSEADDR can always bind to exactly the same source
address and port as an already bound socket, even if the other socket
did not have this option set when it was bound
Now if that were the case then I can definitely see the need for SO_EXCLUSIVEADDRUSE.
I'm pretty sure I'm doing something wrong but I cannot see it; can someone clarify please?
As stated in the docs, SO_EXCLUSIVEADDRUSE became available on Windows NT4 SP4; before that there was only SO_REUSEADDR. So both being present has (also) historical reasons.
I think of SO_REUSEADDR as the intention to share an address (which is only really useful for UDP multicast. For unicast or TCP it really doesn´t do much since the bahaviour is non-deterministic for both sockets).
SO_EXCLUSIVEADDRUSE is a security measure to avoid my (server) application´s traffic being hijacked / rendered useless by a later binding to the same IP/port.
As I see it, you need SO_REUSEADDR for UDP multicats, and you need SO_EXCLUSIVEADDRUSE as a security measure for server applications.
for the life of me, i can't seem to figure out how to get a standard TCP socket connection to reconnect after a disconnect, particularly in the context of an IO::Async::Loop
some basics:
#!/usr/bin/perl
use strict;
use warnings;
use Socket;
use IO::Async::Loop;
use IO::Async::Stream;
use IO::Socket;
use Time::HiRes qw(usleep);
# standard event loop
my $loop = IO::Async::Loop->new;
# notification service socket connection; we only write outgoing
my $NOTIFY = IO::Socket::INET->new(
PeerHost => $a_local_network_host,
PeerPort => $comm_port,
Proto => 'tcp',
Type => SOCK_STREAM,
ReuseAddr => 1,
Blocking => 0
) or warn("Can't connect to NOTIFY: $!\n");
setsockopt($NOTIFY, SOL_SOCKET, SO_KEEPALIVE, 1);
# main interface element via IO::Async
my $notifystream = IO::Async::Stream->new(
handle => $NOTIFY,
on_read => sub {
my ( $self, $buffref, $eof ) = #_;
# here's where we need to handle $eof if the remote goes away
if($eof) {
# i have tried several things here
usleep(200000); # give the remote service some milliseconds to start back up
# process fails if remote is not back up, so i know the timeout is 'good enough' for this test
# attempt to reconnect. have also tried recreating from scratch
$NOTIFY->connect("$a_local_network_host:$comm_port");
# this doesn't seem to have any effect
$self->configure(handle=>$NOTIFY);
}
}
);
$loop->add( $notifystream );
# kickstart the event loop
$loop->run;
### -- Meanwhile, elsewhere in the code -- ###
$notifystream->write("data for notification service\n");
in reality, there are many more things going on in the loop. i also have more sophisticated ways to test for socket closed or broken, further error handlers on the $notifystream, and a better timeout/backoff for reconnecting to the remote service, however this should show the main crux of what i'm doing.
when the remote server goes away for any reason, i'd like to attempt to reconnect to it without disrupting the rest of the system. in most cases the remote sends eof cleanly because it's intentionally rebooting (not my choice, just something i have to deal with), but i'd also like to handle other communication errors as well.
in practice, the above code acts as though it works, however the remote service no longer receives further write calls to the $notifystream. no errors are generated, the $notifystream happily takes further writes, but they are not delivered to the remote.
i have a feeling i'm doing this wrong. i'm not looking to rewrite the rest of the application's event loop, so please no 'just use AnyEvent'-type responses -- really hoping to gain a better understanding of how to reconnect/reuse/recreate the variables in use here (IO::Socket::INET and IO::Async::Stream) to compensate when a remote server is temporarily unavailable.
Any suggestions or references towards this goal are welcome. Thanks!
-=-=-=-=-
to summarize errors i have (and have not) received:
if i leave no usleep, the reconnect (or recreation) of the base socket will fail due to the remote service being unavailable.
if i attempt to recreate the socket from scratch and then 'configure' the stream, i get 'can't call method sysread on undefined' which leads me to believe the socket is not recreated correctly.
at no time do the stream's built in 'on_read_error' or 'on_write_error' handlers fire, regardless of how much i write to the socket with the current code, although if i destroy the socket entirely these will generate an error.
the socket simply seems to still be active after i know it has closed, and a reconnect does not seem to change anything. no errors are generated, but the socket is not being written to.
is there different syntax for reconnecting to an IO::Socket::INET socket? so far calls to ->connect() or rebuilding from scratch seem to be the only options for a closed connection, and neither seem to work.
You simply cannot connect an existing socket multiple times. You can only close the socket and create a new socket. This has nothing to do with IO::Socket::INET, IO::Async::Stream or even Perl but this is how the sockets API works.
In detail: The local socket actually never got disconnected, i.e. it is still configured to send data from a specific local IP address and port and to a specific address and port. Only, that the sending will no longer worked because the underlying TCP connection is broken or closed (i.e. FIN exchanged). Since there is no API to unbind and unconnect a socket the only way is to close it and create a new one which is unbound and unconnected until connect is called. This new socket then might or might not get the same file descriptor as the previous one.
I have a question about how I should be using IO::Socket; I have a script that should run constantly, monitoring an Asterisk server for certain events. When these events happen, the script sends data from the event off to another server via a TCP socket. I've found that occasionally, the socket will close. My question is whether I should be using a single socket, and keep it open forever (and figure out why + prevent it from closing), or should I open and close a new socket for each bit of data sent out?
My experience with this sort of thing is very minimal, and I've read all the documentation without finding the answer I'm looking for. Below is a sample of what I've got so far:
#!/usr/bin/perl
use Asterisk::AMI;
use IO::Socket;
use strict;
use warnings;
my $sock = new IO::Socket::INET (
PeerAddr => '127.0.0.1',
PeerPort => '1234',
Proto => 'tcp',
);
sub newchannel {
my ($ami, $event) = #_;
if ($event->{'Context'} eq "from-trunk") {
my $unique_id = $event->{'Uniqueid'};
my $this_call = $call{$unique_id};
$this_call->{caller_name} = $event->{'CallerIDName'};
$this_call->{caller_number} = $event->{'CallerIDNum'};
$this_call->{dnis} = $event->{'Exten'};
$call{$unique_id} = $this_call;
};
}
sub ringcheck {
my ($ami, $event) = #_;
if ($event->{SubEvent} eq 'Begin') {
my $unique_id = $event->{UniqueID};
if (exists $call{$unique_id}) {
my $this_call = $call{$unique_id};
$this_call->{system_extension} = $event->{Dialstring};
$this_call->{dest_uniqueid} = $event->{DestUniqueID};
printf $sock "R|%s|%s|%s||%s\n",
$this_call->{caller_name},
$this_call->{caller_number},
$this_call->{system_extension},
$this_call->{dnis};
$this_call->{status} = "ringing";
}
}
There's a bit more to it than that, but this shows where I feel I should be starting/stopping a new socket (within the ringcheck sub).
Let me know if you need me to clarify or add anything.
Thanks!
Whether it is better establish a new connection for each message or to keep the connection open depends on a few factors:
Is the overhead associated with establishing connections significant? This depends on factors such as the frequency with which messages need to be sent, and the quality of the network connection.
If the remote end is 'localhost', as in your sample script above, then this is not likely to be an issue, and in fact in that case I would recommend using a Unix domain socket instead anyway.
Is the remote end sending anything back? Much harder to manage sporadic connections if either side may have asynchronous messages to send. Does not sound like it is the case for you though.
Are there any significant resources which you would be holding up by keeping the connection open?
Note that I don't consider random connection dropouts are a good reason to argue for making a new connection each time. If possible, better to diagnose that problem in any case. Otherwise, you might get unreliable performance no matter what approach you take.
In my experience a very common reason for seemingly random dropouts in long held TCP connections is intermediate tracking firewalls. Such firewalls will drop a connection if they don't see any activity on it for a period of time, to conserve their own resources. One way to combat this, which I use in some of my tools, is to set the socket option SO_KEEPALIVE on the socket, like this:
use Socket;
...
setsockopt($sock, SOL_SOCKET, SO_KEEPALIVE, 1);
This has a couple of benefits - it results in the Kernel sending keepalive messages on your connection at regular intervals, even if all is quiet, which by itself is enough to keep some firewalls happy. Also, if your connection does drop, your program can find out straight away instead of next time you want to write to it (although you may not notice it unless you are regularly checking for errors on your sockets).
Perhaps your best approach might be to set the SO_KEEPALIVE, and keep your socket open, but also check for errors whenever you try to write to it, and if you have an error, close and re-open the connection.
This question may also be of use to you.
How can you get a raw socket in Perl, and then what's the best way to built a packet for use with it?
The same way you do in C... by setting the socket type when creating the socket.
In the example on CPAN use SOCK_RAW rather than SOCK_DGRAM (UDP) or SOCK_STREAM (TCP).
NOTE: creating raw sockets typically requires administrative privileges (i.e. root on UNIX). Windows OS's may have disabled ability to create raw sockets, you'll just have to test it and see.
Perhaps searching CPAN might help? IO::Socket comes to mind.
At first I was thinking that most previous answers were not responsive to the question.
After further thought, I think the author is probably not asking the right question.
If you're writing an application, you don't usually think of "building packets". you just open sockets, format up the data payload, and it's the protocol stack that builds packets with your data. OK, if you're using datagrams, you do need to define, generate and parse your payloads. But you typically let the kernel encapsulate it at the network level (e.g. add IP header) or link layer (e.g. add Ethernet framing). You usually don't use pcap. Sometimes just pack and unpack and maybe vec is enough.
If you're writing an unusual packet processor such as an active hostile attack tool, a man-in-the-middle process, or a traffic shaping device, then would be more likely to be "building packets" and using pcap. Maybe Net::Packet is for you also.
As austirg and others said, Socket will do this just fine:
use Socket;
socket my $socket, PF_INET, SOCK_RAW, 0 or die "Couldn't create raw socket: $!";
send $socket, $message, $flags, $to or die "Couldn't send packet: $!";
my $from = recv $socket, $message, $length, $flags or die "Couldn't receive from socket: $!";
Looks like Net::RawIP was what I was looking for:
use Net::RawIP;
$a = new Net::RawIP;
$a->set({ip => {saddr => 'my.target.lan',daddr => 'my.target.lan'},
tcp => {source => 139,dest => 139,psh => 1, syn => 1}});
$a->send;
$a->ethnew("eth0");
$a->ethset(source => 'my.target.lan',dest =>'my.target.lan');
$a->ethsend;
$p = $a->pcapinit("eth0","dst port 21",1500,30);
$f = dump_open($p,"/my/home/log");
loop $p,10,\&dump,$f;
The basic call to get a socket is... socket(). It comes standard with perl 5. perl 5 basically gives you the standard socket(), bind(), listen(), accept() calls that traditional UNIX does.
For a more object oriented model, check out IO::Socket.
Be aware that if you're trying to use raw sockets to send a pile of SYN packets, and you just "use Socket;" that's going to fill up your ARP tables and bomb out with "No buffer space available" and a stack of "CLOSE_WAIT" entries in "netstat" (which stops your machine doing any more connections of any kind until some of them free up).
Or in other words - you do really need Net::RawIP - it makes a difference.