Consider the following snippet of a Perl script:
use IO::Socket;
# ...
my $sock = IO::Socket::INET->new(
PeerAddr => $host, # e.g. "google.com"
PeerPort => $port, # e.g. 80
Proto => 'tcp'
);
die("no socket: $!") unless $sock;
# ...
Everything works as expected under normal conditions but when then host system's internet connection is inactive the "sock" variable is empty and $! has the message "Invalid argument".
Am I using the INET constructor inappropriately or is this the expected behavior? If the latter, is there a way to differentiate between a "network interface inactive" error and a genuine invalid argument to the constructor method?
You are seeing "Invalid argument" because the constructor tries to resolve the hostname, gets an error, and returns EINVAL in $!. If you would use an IP address in $host, you would see the real error, "Network is unreachable".
Also, IO::Socket::INET sets $# to qualify the error returned in $!, so if you print $# as well as $!, you will see "Bad hostname 'google.com'", which is probably an even better diagnostic than "Network unreachable" you would get with an IP address instead of the hostname. In both cases it should be immediately clear what is going on.
Related
I use IO:Socket::SSL to connect to a number of upstream sources. There is an IPv6 connectivity issue with one of the sources which I want to circumvent by using IPv4 for the time being. To do so, I have used the IPv4 address in my conf file instead of the hostnname. However, I would prefer using the hostname and an additional option to force IPv4 for this source.
Now I am unsure what option to use with IO::Socket::SSL. Perldoc reads "you can either force IPv4 by specifying and AF_INET as theDomain" which seems a bit garbled.
I'd appreciate if someone could provide an example how to do that. To clarify, I would not like to use IO::Socket::SSL qw (inet) as other connections shan't be affected.
Best,
Marcus
If you're looping over each system, this (untested) code should do what you want. If you have multiple v4 servers, you can put them all into an array, then instead of doing an eq for a single name, use grep instead.
for (#servers){
my %params = (
Proto => $proto,
PeerAddr => $_,
PeerPort => $port,
...
);
my $sock;
if ($_ eq 'ipv4_servername'){
$sock = IO::Socket::SSL->new(%params, Domain => AF_INET);
}
else {
$sock = IO::Socket::SSL->new(%params);
}
...
}
I am beginner to Perl and I have to write a script which could change the IP address after every 1 hour.
I want to change it because I receive some data from a dongle from a website and that website has some time limit to receive that data, so currently we need to unplug the connecting device and use another to
change IP address. (I mean I have to request DHCP for another IP.)
But currently I am asked to write a script using Perl. Could someone please help me how to do that?
My try to do it is :
#!/usr/bin/perl
# Simple DHCP client - sending a broadcasted DHCP Discover request
use IO::Socket::INET;
use Net::DHCP::Packet;
use Net::DHCP::Constants;
use POSIX qw(setsid strftime);
# sample logger
sub logger{
my $str = shift;
print STDOUT strftime "[%d/%b/%Y:%H:%M:%S] ", localtime;
print STDOUT "$str\n";
}
logger("DHCPd tester - dummy client");
logger("Opening socket");
$handle = IO::Socket::INET->new(Proto => 'udp',
Broadcast => 1,
PeerPort => '67',
LocalPort => '68',
PeerAddr => '255.255.255.255',
)
|| die "Socket creation error: $#\n"; # yes, it uses $# here
# create DHCP Packet DISCOVER
$discover = Net::DHCP::Packet->new(
Xid => 0x12345678,
DHO_DHCP_MESSAGE_TYPE() => DHCPDISCOVER(),
DHO_VENDOR_CLASS_IDENTIFIER() => 'foo',
);
logger("Sending DISCOVER to 127.0.0.1:67");
logger($discover->toString());
$handle->send($discover->serialize())
or die "Error sending:$!\n";
logger("Waiting for response from server");
$handle->recv($buf, 4096) || die("recv:$!");
logger("Got response");
$response = new Net::DHCP::Packet($buf);
logger($response->toString());
# create DHCP Packet REQUEST
$request = Net::DHCP::Packet->new(
Xid => 0x12345678,
Ciaddr => $response->yiaddr(),
DHO_DHCP_MESSAGE_TYPE() => DHCPREQUEST(),
DHO_VENDOR_CLASS_IDENTIFIER() => 'foo',
DHO_DHCP_REQUESTED_ADDRESS() => $response->yiaddr(),
);
logger("Sending REQUEST to 127.0.0.1:67");
logger($request->toString());
$handle->send($request->serialize())
or die "Error sending:$!\n";
logger("Waiting for response from server");
$handle->recv($buf, 4096) || die("recv:$!");
logger("Got response");
$response = new Net::DHCP::Packet($buf);
logger($response->toString());
It's output on terminal is :
C:\shekhar_Axestrack_Intern\IpAddressChangeScripts>test6.pl
[08/Jan/2015:18:01:01] DHCPd tester - dummy client
[08/Jan/2015:18:01:01] Opening socket
[08/Jan/2015:18:01:01] Sending DISCOVER to 127.0.0.1:67
[08/Jan/2015:18:01:01] op = BOOTREQUEST
htype = HTYPE_ETHER
hlen = 6
hops = 0
xid = 12345678
secs = 0
flags = 0
ciaddr = 0.0.0.0
yiaddr = 0.0.0.0
siaddr = 0.0.0.0
giaddr = 0.0.0.0
chaddr =
sname =
file =
Options :
DHO_DHCP_MESSAGE_TYPE(53) = DHCPDISCOVER
DHO_VENDOR_CLASS_IDENTIFIER(60) = foo
padding [0] =
[08/Jan/2015:18:01:01] Waiting for response from server
//And it is stuck here since last 45 minutes....
My idea to do it is:
I will send a request to server (DHCP) (I think DHCPREQUEST() do that)that please provide me new IP adress.
Could some one please let me know if my last line will print ID adress or not ? I mean :
$response = new Net::DHCP::Packet($buf);
logger($response->toString());
EDIT:
I also tried this on suggestion by the experienced guys below but it still do not change IP adress (even i tried to run this perl code 4 times without success in IP change-Even i tried to run manually ipconfig /renew but still the IP is same all the time).
my $ipconfig = `ipconfig /renew`;
my $ipcfg_success = $?;
print $ipconfig;
if ($ipcfg_success == 0) {
do print "n succesfully runned \n";
} else {
do "\n succesfully NOT sunned \n";
}
Writing a DHCP client isn't going to change your system's IP address. You need to use the system's client.
system('ipconfig /release & ipconfig /renew');
You're not guaranteed to get a new address, though. It causes less headaches if machines always have the same IP address, so DHCP servers tend to always give the same address to a machine.
This more of a comment but it grew too long.
Just have your script call ipconfig /release and ipconfig /renew with a few seconds in between. That will request a new IP from the DHCP server, just as your script apparently tries to do.
Of course you are not exactly guaranteed a new IP that way, that depends on the configuration of the DHCP server but you are dependent on that either way. If the possible range of addresses is very small and you are afraid you might get the old IP by bad luck, check and renew again if it happened. If you get the same IP every time, it most likely means that the server recognizes you (by MAC or hostname) and assigns your static IP to you. In that case all you can do is talk to your network adminstrator (a course of action i would suggest anyways).
If you really need a guarantee, then you have to ditch DHCP and set your own IP. That however requires that you have some range of IPs reserved just for you. Otherwise your network administrator might hunt you down with their crossbow.
Be aware that depending on what that dongle is for and who set up that time limit, they may do anyways.
#!/usr/bin/perl -w
use Net::SMTP;
$smtp = Net::SMTP->new('mailhost');
print $smtp->domain,"\n";
$smtp->quit;
I run this pl file and get error "Can't call method "domain" on an undefined value"
and in this pl file:
#!/usr/bin/perl -w
use Net::SMTP;
$smtp = Net::SMTP->new('mailhost');
$smtp->mail($ENV{USER});
$smtp->to('postmaster');
$smtp->data();
$smtp->datasend("To: postmaster\n");
$smtp->datasend("\n");
$smtp->datasend("A simple test message\n");
$smtp->dataend();
$smtp->quit;
I get error Can't call method "mail" on an undefined value
What I need todo ?
Has it occured to you that Net::SMTP may have had problems finding your mailhost, and establishing an SMTP connection? I see that you took your scripts directly from the documentation – you do have to supply an actual value for mailhost.
If you had read the documentation a bit further, especially to the documentation for the new method, you'd have found this interesting snippet:
new ( [ HOST ] [, OPTIONS ] )
This is the constructor for a new Net::SMTP object. HOST is the name of the remote host to which an SMTP connection is required.
On failure undef will be returned and $# will contain the reason for the failure.
So let's print out that reson for failure:
my $mailhost = "your mailhost";
my $smpt = Net::SMTP->new($mailhost) or die "Can't connect to $mailhost: $#";
die aborts your program with an error message. This message should tell you more about the actual error.
Do note that the example code in the documentation is not neccessarily meant to be used for real projects – it is just there to showcase the capabilities of the module. For real code, always use strict; use warnings at the top of your code, and declare all your variables with my. This helps finding more errors.
I'm writing a small script to monitor if certain ports are attempted to be accessed on my Linux box (Centos 6) using Perl 5.10.1. I'm getting back blank entries for my peerhost request. I'm not sure why. It sounds like it may be a failure in the IO socket module (http://snowhare.com/utilities/perldoc2tree/example/IO/Socket.html) but I'm not really sure. Any insight would be much appreciated.
EDIT:
Since I enabled the strict and warnings I'm getting an 'uninitialized value $display' in the cases where I thought it was blank.
#! /usr/bin/perl
use strict;
use warnings;
use IO::Socket;
use Sys::Syslog qw( :DEFAULT setlogsock);
use threads;
my #threads=();
my #ports=(88,110,389);
main(\#ports);
sub main
{
my $ports=shift;
setlogsock('unix');
openlog($0,'','user');
for my $port (#{$ports} ) {
push #threads, threads->create(\&create_monitor, $port );
}
$_->join foreach #threads;
closelog;
# wait for all threads to finish
}
sub create_monitor{
my $LocalPort=shift;
my $sock = new IO::Socket::INET (
LocalPort => $LocalPort,
Proto => 'tcp',
Listen => 1,
Reuse => 1,
) or die "Could not create socket: $!\n";
while(1)
{
my $peer_connection= $sock->accept;
my $display = $peer_connection->peerhost();
my $message="Connection attempt on port $LocalPort from $display";
#syslog('info', $message);
print $message."\n";
}
}
NOTE - it is intentional that this script never finish. I'll eventually wrap this with an init script and have it run as a service.
Perl accept() has an error code like most other functions. For accept() it is a false return, see also here.
So when you get undefined as result there is an error in accept() call. The error of accept is saved in the errno variable ($!).
Same is true for peerhost() (see here). It also can fail and return an error code.
If you only use the above code without anything else, then probably you reach connection limit of your system (you should close the connections) when accept() fails. See rlimit() to find out how that number can be increased.
One case where peerhost() fails may be that remote connection was closed already.
Solution
As reported by #limulus in the answer I accepted, this was a bug in Net::HTTPS version 6.00. Always be wary of fresh .0 releases. Here's the relevant diff between the buggy and fixed version of that module:
D:\Opt\Perl512.32 :: diff lib\Net\HTTPS.pm site\lib\Net\HTTPS.pm
6c6
< $VERSION = "6.00";
---
> $VERSION = "6.02";
75,78c75,80
< # The underlying SSLeay classes fails to work if the socket is
< # placed in non-blocking mode. This override of the blocking
< # method makes sure it stays the way it was created.
< sub blocking { } # noop
---
> if ($SSL_SOCKET_CLASS eq "Net::SSL") {
> # The underlying SSLeay classes fails to work if the socket is
> # placed in non-blocking mode. This override of the blocking
> # method makes sure it stays the way it was created.
> *blocking = sub { };
> }
Original question
Relevance: It is annoying to see your HTTPS client block indefinitely because the connection endpoint is unreliable.
This experiment is easy to set up and replay at home. You just need two things, a tarpit to trap an incoming client, and a Perl script. The tarpit can be set up using netcat:
nc -k -l localhost 9999 # on Linux, for multiple requests
nc -l -p 9999 localhost # on Cygwin, for one request only
Then, point the script to this tarpit:
use strict;
use LWP::UserAgent;
use HTTP::Request::Common;
print 'LWP::UserAgent::VERSION ', $LWP::UserAgent::VERSION, "\n";
print 'IO::Socket::SSL::VERSION ', $IO::Socket::SSL::VERSION, "\n";
my $ua = LWP::UserAgent->new( timeout => 5, keep_alive => 1 );
$ua->ssl_opts( timeout => 5, Timeout => 5 ); # Yes - see note below!
my $rsp = $ua->request( GET 'https://localhost:9999' );
if ( $rsp->is_success ) {
print $rsp->as_string;
} else {
die $rsp->status_line;
}
What is this going to do? Well, connect to the port opened by NetCat, and then ... hang. Indefinitely. At least in terms of developer time. I mean it might time out after ten minutes or two hours, but I haven't checked; the specified timeout doesn't take effect, not on Linux, and not on Windows (Win32, haven't checked Cygwin).
Versions used:
LWP::UserAgent::VERSION 6.02
IO::Socket::SSL::VERSION 1.44
# on Linux
LWP::UserAgent::VERSION 6.02
IO::Socket::SSL::VERSION 1.44
# on Win32
Now for the timeout and Timeout parameters. The former is the name of the parameter for LWP::UA, the latter is the name for IO::Socket::SSL, used via LWP::Protocol::https. (Incidentally, why is metacpan HTTPS? Well, at least it's not a tarpit.) I am somehow hoping to have these parameters passed along :)
Just so you know, keep_alive doesn't have anything to do with the timeout not working, I verified that empirically. :)
Anyway, before digging deeper, does anyone know what's going on here and how to make the timeout work with HTTPS? Hard to believe I'm the first person running into this.
This is a result of the Net::HTTPS module overriding the blocking method of IO::Socket with a noop. Upgrading to the latest Net::HTTP package should fix this.
The timeout (and Timeout) options apply only to the connection -- how many seconds will LWP::UserAgent wait while connecting -- they are not for setting a timeout on the whole transaction.
You'll want to use Perl's alarm with a $SIG{ALRM} handler to timeout the whole transaction. See perldoc -f alarm or perlipc.
local $SIG{ALRM} = sub { die "SSL timeout\n" };
my $ua = LWP::UserAgent->new( timeout => 5, keep_alive => 1 );
$ua->ssl_opts( timeout => 5, Timeout => 5 );
eval {
alarm(10);
my $rsp = $ua->request( GET 'https://localhost:9999' );
if ( $rsp->is_success ) {
print $rsp->as_string;
} else {
die $rsp->status_line;
}
};
alarm(0);
if ($#) {
if ($# =~ /SSL timeout/) {
warn "request timed out";
} else {
die "error in request: $#";
}
}
(tested on Linux. Alarms can be a bit more cantankerous in Windows/Cygwin)
I asked this question on PerlMonks, and received an answer to the effect that:
The underlying IO::Socket::INET does not support non-blocking sockets
on Win32, thus non-blocking IO::Socket::SSL is not supported on Win32,
which means also, that timeouts don't work (because they are based on
non-blocking). See also http://www.perlmonks.org/?node_id=378675
http://cpansearch.perl.org/src/SULLR/IO-Socket-SSL-1.60/README.Win32
The PerlMonks post pointed to is from 2004. Not sure the information still applies; after all, I've seen the timeout does work on Windows, just not via SSL.