This is the code I am using. What is the problem with the code?
Moreover, how can I specify the timeout parameter? tcp_timeout does not seem to work.
sub resolve_dns()
{
my $dns = $_[0];
my $res = Net::DNS::Resolver->new(
nameservers => [qw(24.116.197.232)],
recurse => 0,
debug => 1,
tcp_timeout => 3
);
my $query = $res->search($dns);
if ($query) {
foreach my $rr ($query->answer) {
next unless $rr->type eq "A";
print $rr->address, "\n";
}
} else {
warn "query failed: ", $res->errorstring, "\n";
}
}
This is the output I am getting.
Output
query failed: query timed out
;; search(www.youtube.com)
;; setting up an AF_INET() family type UDP socket
;; send_udp(24.116.197.232:53)
;; send_udp(24.116.197.232:53)
;; send_udp(24.116.197.232:53)
;; send_udp(24.116.197.232:53)
You can specify a timeout using:
$res->udp_timeout(3);
or, replace the specify it in the constructor.
Related
I am making socket programming for simple communication now.
I have noticed that the server is not the one I created and it works fine (given the experimental client)
In my code, recv works fine, but send does not work. Is there anything wrong with my code?
my $socket = new IO::Socket::INET (
#PeerHost => '127.0.0.1',
PeerHost => '192.168.0.100',
PeerPort => '8472',
Proto => 'tcp',
);
die "cannot connect to the server $!\n" unless $socket;
print "connected to the server\n";
while (1) {
my $response = "";
$socket->recv($response, 1024);
if ($response) {
my #test = split(//,$response);
my ($length,$data) = unpack("N A*",$response);
%json = json_decode($data,$length);
switch ($json{'type'}) {
case 1 { print "Game Start\n";}
#case 2 { my $tmp = &my_turn(%json);} #my_turn func is return "{'type': 0, 'point': [5, 4]}", but fail!
#case 2 { $socket->send("{'type': 0, 'point': [5, 4]}");} # fail!
case 2 { print $socket "{'type': 0, 'point': [5, 4]}"; print "ok\n";} # print is executed. However, the server does not receive packets
#case 2 { $socket->send("{'type': 0, 'point': [5, 4]}");} #fail...
case 3 { print "ACCEPT\n";}
case 5 { print "NOPOINT\n";}
case 6 { print "GAMEOVER\n";}
case 7 { print "ERROR\n";}
else {print "ERROR type : $json{'type'}\n"}
}
}
}
The server works fine. I checked with the example source (python code) given with the server. What am I missing?
You can't assume the recv (or read) will return the entire response. You need to call it repeatedly.
You can't assume the recv (or read) will just the response. You need to limit the size of the read of buffer the excess.
decode_json returns a reference (not a list of key-value pairs you can assign to a hash).
You might also have to handle encoding of the JSON string. The example below assumes UTF-8 encoding.
JSON response to the server (case 2 in the original code) needs to include length too.
The following code should be used instead:
#!/usr/bin/perl
use strict;
use warnings;
use JSON;
use IO::Socket;
my $socket = IO::Socket::INET->new(
PeerHost => '127.0.0.1',
PeerPort => '22',
Proto => 'tcp',
) or
die "cannot connect to the server $!\n";
print "connected to the server\n";
sub read_bytes($$) {
my($socket, $length) = #_;
my $result = '';
print "ATTEMPT TO READ ${length}\n";
while ($length > 0) {
my $received = $socket->read($result, $length, length($result));
die "socket error: $!\n" unless defined($received);
die "unexpected EOF\n" unless $received;
$length -= $received;
}
print "READ '${result}'\n";
return($result);
}
while (1) {
my $length = unpack("N", read_bytes($socket, 4));
my $json = read_bytes($socket, $length);
my $data = JSON->new->utf8->decode($json);
print $data->{type}, "\n";
if ($data->{type} == 2) {
my $response = {
type => 0,
point => [5, 4],
};
my $resp_json = JSON->new->utf8->encode($response);
print "JSON: ${resp_json}\n";
my $packet = pack('NA*', length($resp_json), $resp_json);
print "PACKET: ", unpack('H*', $packet), "\n";
$socket->write($packet);
}
}
As I don't have access to your server I used sshd on my local machine, which of course does not send me a JSON. But it shows that reading works :-)
$ perl dummy.pl
connected to the server
ATTEMPT TO READ 4
READ 'SSH-'
ATTEMPT TO READ 1397966893
^C
Output for an example response to the server would be:
JSON: {"type":0,"point":[5,4]}
PACKET: 000000187b2274797065223a302c22706f696e74223a5b352c345d7d
The idea is that the first get_table gets the AP status off a WLAN controller, then it uses get_request to get the AP's hostname as it's printing out the status table. The problem I'm having is the $ap_name comes back as an array, when I just want the single value.
my ($session, $error) = Net::SNMP->session(
-hostname => "$hostaddr",
-community => "$community",
-timeout => "30",
-version => "2c",
-port => "161");
if (!defined($session)) {
printf("ERROR: %s.\n", $error);
exit 1;
}
my $ap_stat = $session->get_table( -baseoid => $ap_stat_oid );
my $ap_name = $session->get_table( -baseoid => $ap_name_oid);
if (! defined $ap_stat || ! defined $ap_name) {
die "Failed to get OID '$ap_stat_oid': " . $session->error;
$session->close();
}
my #ap_name_array;
foreach my $ap_name_key (keys %$ap_name) {
push(#ap_name_array,$ap_name->{$ap_name_key});
}
my #ap_stat_array;
foreach my $ap_stat_key (keys %$ap_stat) {
push(#ap_stat_array,$ap_stat->{$ap_stat_key});
}
Edit: I changed it up a bit but still can't figure out what's next. I think I want to store the print output's into arrays and then join them and print for the joined array but I'm not sure how.
Edit: Here's my desired output:
AP-01 = 1
AP-02 = 1
AP-03 = 2
AP-04 = 1
etc..
More edits: I got the values into an arrays, now I'm just trying to get the output right.
Figured it out using use List::MoreUtils qw(pairwise); from here
if (! defined $ap_stat || ! defined $ap_name) {
die "Failed to get OID '$ap_stat_oid': " . $session->error;
$session->close();
}
my #ap_name_array;
foreach my $ap_name_key (keys %$ap_name) {
push(#ap_name_array,$ap_name->{$ap_name_key});
}
my #ap_stat_array;
foreach my $ap_stat_key (keys %$ap_stat) {
push(#ap_stat_array,$ap_stat->{$ap_stat_key});
}
print pairwise { "$a = $b\n" } #ap_name_array, #ap_stat_array;
Beat you to it #ThisSuitIsBlackNot, thanks anyways!
I am passing two name servers to the Net::DNS::Resolver constructor but I am getting only one result back.
How should I change the code to receive result from all the name servers?
sub resolve_dns()
{
my $dns = $_[0];
my $res = Net::DNS::Resolver->new(
nameservers => [qw(24.116.197.232 114.130.11.67 )],
recurse => 0,
debug => 1,
tcp_timeout => 3
);
my $query = $res->search($dns);
if ($query) {
foreach my $rr ($query->answer) {
next unless $rr->type eq "A";
print $rr->address, "\n";
}
} else {
warn "query failed: ", $res->errorstring, "\n";
}
}
I presume the DNS servers after the first are there for fallback purposes and only a single reply will ever be returned.
The best way seems to be to manipulate the Net::DNS::Resolver server list and explicitly make a request to each of them.
This example code demonstrates the principle
sub resolve_dns {
my $address = shift;
my $res = Net::DNS::Resolver->new
recurse => 0,
debug => 1,
tcp_timeout => 3,
);
for my $ns (qw( 24.116.197.232 114.130.11.67 )) {
$res->nameservers($ns);
my $reply = $res->send($address);
if ($reply) {
my #type_a = grep $_->type eq 'A', $reply->answer;
print $_->address, "\n" for #type_a;
}
else {
warn sprintf "Query to %s failed: %s\n", $ns, $res->errorstring;
}
}
}
I need some help identifying, and eliminating, the cause of an odd child process error when polling SNMP services.
During SNMP connect, I verify SNMP connectivity by polling for the
device name until it times out:
sub snmp_close {
my $self = shift;
$self->{SNMP_SESSION}->close if (defined $self->{SNMP_SESSION} && $self->{SNMP_SESSION});
$self->{SNMP_SESSION} = undef;
}
sub {
my ($self, $ip, $community) = #_;
# If there's a leftover session around, make sure it's closed
$self->snmp_close;
my ($session, $error) = Net::SNMP->session(
-hostname => $ip,
-community => $community,
-nonblocking => 1,
-version => 'snmpv2c',
-translate => [
-timeticks => 0x0
],
);
if (!defined $session) {
$self->_logger->logcluck("Can't create SNMP object, error: '$error'");
return;
}
$self->{SNMP_SESSION} = $session;
my $end = time() + 90;
while (time < $end) {
$self->_logger->debug("Probing for SNMP connectivity, giving up in " . int($end - time()) . " seconds");
my %sysName = $self->get_bulk('1.3.6.1.2.1.1.5');
if(scalar keys %sysName >= 1) { # try polling sysName..
return 1;
}
else {
sleep 5;
}
}
# if we've made it this far there's no hope for snmp...
$self->_logger->warn("No SNMP connectivity after 90 seconds");
$self->{SNMP_SESSION} = 0;
return;
}
sub get_bulk { # return a hash of oid keys and values
my ($self, $oid) = #_;
$self->_logger->logdie("Not connected; call snmp_connect") if not defined $self->{SNMP_SESSION};
$self->_logger->logdie("Connection failed") if not $self->{SNMP_SESSION};
my %table;
my $result = $self->snmp->get_bulk_request(
-varbindlist => [ $oid ],
-maxrepetitions => 20,
-callback => [\&_table_callback, $self, \%table, $oid],
);
if (!defined $result) {
$self->_logger->warn("SNMP error: '" . $self->snmp->error() . "'");
return;
}
snmp_dispatcher();
use Data::Dumper; my %_table = map {s/\Q$oid.\E//; $_} %table; $self->_logger->debug("SNMP Debug, OID polled: '$oid', response is: " . Dumper(\%_table));
return %table;
}
Most of the time, this works flawlessly, but some percentage of the time
I get a FATAL error out of Net::SNMP::Dispatcher:
FATAL: select() error [No child processes] at perl/lib/perl5.8/Net/SNMP/Dispatcher.pm line 635.
at perl/lib/perl5.8/Net/SNMP/Dispatcher.pm line 635
Net::SNMP::Dispatcher::_event_select('Net::SNMP::Dispatcher=HASH(0xaca5ce0)', 4.99994683265686) called at perl/lib/perl5.8/Net/SNMP/Dispatcher.pm line 601
Net::SNMP::Dispatcher::_event_handle('Net::SNMP::Dispatcher=HASH(0xaca5ce0)') called at perl/lib/perl5.8/Net/SNMP/Dispatcher.pm line 80
Net::SNMP::Dispatcher::activate('Net::SNMP::Dispatcher=HASH(0xaca5ce0)') called at perl/lib/perl5.8/Net/SNMP.pm line 611
Net::SNMP::snmp_dispatcher() called at perl/lib/perl5.8/Device.pm line 857
Device::get_bulk('Device::Class=HASH(0xb1e405c)', 1.3.6.1.2.1.1.5) called at perl/lib/perl5.8/Device.pm line 824
Device::snmp_connect('Device::Class=HASH(0xb1e405c)', 10.0.0.1, 'COMMUNITY_STRING') called at perl/lib/perl5.8/Device.pm line 912
(Line 857 is the snmp_dispatcher in get_bulk, above)
I'm new enough to perl -- and totally new to SNMP -- that I don't really
know how to troubleshoot this. The method in question is executed in a
mod_perl CGI call, if that helps isolate the problem.
Some local investigation turned up the fact that this is a side effect of multi-core machines; the child process ran on another core, and its pipe file handle was not available to the parent process.
I've been trying to debug this perl issue for awhile but had made no head way. what I'm trying to do is determain if the connection is a socks4/5 connection.
# ./pctest.pl
Name "main::junk" used only once: possible typo at ./pctest.pl line 60.
Name "main::empty" used only once: possible typo at ./pctest.pl line 60.
IO::Socket::INET: Bad hostname 'C1(X' ...propagated at ./pctest.pl line 52.
I've also had this error (before i added or die #$; at the end):
Can't use an undefined value as a symbol reference at ./pctest.pl line 56.
.
...
$look = IO::Socket::INET->new( PeerAddr => $_, Proto => 'tcp', Timeout => 5 ) or die #$;
$sock4 = pack( "CCS", 4, 1, 80 );
print $look $sock4;
read( $look, $recv, 10 );
( $empty, $granted, $junk ) = unpack( "C C C6", $recv );
if( $granted == 0x5A )
{
print " Yes\n";
}
else
{
print " No\n";
}
...
There's a typo. #$ should really be $#.
To get rid of the "possible typo" messages and since $empty and $junk seem to be unused in your code, write:
my #result = unpack("C C C6", $recv);
if ($result[1] == 0x5A) {
# ...
}
Just a side note : I think you are thinking of $#, instead of #$. You need to enclose the code in an
eval { ... };
construction. See:
my $look;
eval { $look = IO::Socket::INET->new( PeerAddr => $_, Proto => 'tcp', Timeout => 5 ) };
if ($#) {
do_something_with($#);
}
Granted, that doesn't answer the original question :)
The error message means that your parameter value for PeerAddr in the IO::Socket::INET->new call is invalid.
The constructor expects the PeerAddr value to be a hostname or an IP address (nnn.nnn.nnn.nnn). Check the contents of $_ and I bet you'll find something different.