After figuring out (via SO, of course) that the error for a bad $ftp = Net::FTP->new() call is in $# while subsequent errors can be obtained by $ftp->message(), I'm striking a small problem.
My code is basically:
while (1) {
# Wait for cycle start, then get file list into #filelist.
foreach $file (#filelist) {
my $ftp = Net::FTP->new ($host);
if (! $ftp) {
logError ("Could not connect to host [$host]: $#");
return;
}
# More FTP stuff below with $ftp->message() error checking.
$ftp->quit();
}
}
Aside: yes, I know I can probably do this in one FTP session, but there are good reasons for leaving it in separate sessions at the moment.
Now this is being called in a loop, once per file, all going to the same host, but I'm getting a slightly different behaviour on the first attempt in most cycles. The script is a long-running one, with each cycle starting on the hour and half hour so it's not some issue with the first ever attempt after program start, since it happens on cycles other than the first as well.
Now I know that these connections should fail, simply because the machines I'm trying to access are not available on my development network.
The trouble is that the errors coming out in the log file are:
E 2012-02-05 18:00:13 Could not connect to host [example.com]:
E 2012-02-05 18:00:13 Could not connect to host [example.com]:
Net::FTP: connect: Connection refused
E 2012-02-05 18:00:14 Could not connect to host [example.com]:
Net::FTP: connect: Connection refused
As you can see, the $# variable seems to be not populated the first file of the cycle. I've edited this question slightly since I've just noticed the latest cycle had all three lines with the error message. Going back over the logs with the command:
grep refused logfile | awk '{print substr($3,1,5)}' | uniq -c
to get the dates and counts, turns up the following statistics:
3 11:00
3 11:30
3 12:00
3 12:30
3 13:00
3 13:30
2 14:00
3 14:30
3 15:00
3 15:30
3 16:00
2 16:30
2 17:00
2 17:30
2 18:00
2 18:30
2 19:00
3 19:30
indicating that some have the correct count of error messages but not all.
I'm wondering if anyone knows why this may be the case.
Try upgrading http://cpansearch.perl.org/src/GBARR/libnet-1.22_01/Changes says
libnet 1.22_01 -- Mon May 31 09:40:25 CDT 2010
*Set $# when ->new returns undef
If you're using a version of libnet prior to 1.22_01, it had a small bug in the new function in regards to responses that didn't start with a code.
For example, FTP.pm 2.77 which is from libnet 1.21 has the following snippet:
unless ($ftp->response() == CMD_OK) {
$ftp->close();
$# = $ftp->message;
undef $ftp;
}
With FTP.pm 2.77_2 from libnet 1.22_01, this is changed to:
unless ($ftp->response() == CMD_OK) {
$ftp->close();
# keep #$ if no message. Happens, when response did not start with a code.
$# = $ftp->message || $#;
undef $ftp;
}
Is there anything going on between the ->new call and printing the $#? It can overwrite the value of $#, so if it is neccesary, store the value for later use:
my $ftp = Net::FTP->new ($host);
my $potential_error = $#;
$whatever_that->can_call(eval => 'inside');
if (! $ftp) {
logError ("Could not connect to host [$host]: $potential_error");
}
Related
I can't manage to find the error preventing fail2ban to match these lines:
Apr 19 20:17:12 localhost sm-mta[201892]: ruleset=check_relay, arg1=[12.345.7.789], arg2=12.345.7.789, relay=host.hostname.com [12.345.7.789] (may be forged), reject=421 4.3.2 Connection rate limit exceeded.
Apr 19 20:17:53 localhost sm-mta[201902]: 13JIHpTD201902: [12.345.7.789] did not issue MAIL/EXPN/VRFY/ETRN during connection to MTA-v4
Here is the associated fail2ban configuration:
[Definition]
_daemon = (?:(sm-(mta|acceptingconnections)|sendmail))
__prefix_line = %(known/__prefix_line)s(?:\w{14,20}: )?
prefregex = ^<F-MLFID>%(__prefix_line)s</F-MLFID><F-CONTENT>.+</F-CONTENT>$
cmnfailre = ^ruleset=check_relay, arg1=(?P<dom>\S+), arg2=(?:IPv6:<IP6>|<IP4>), relay=((?P=dom) )?\[(\d+\.){3}\d+\](?: \(may be forged\))?, reject=421 4\.3\.2 (Connection rate limit exceeded\.|Too many open connections\.)$
^(?:\S+ )?\[(?:IPv6:<IP6>|<IP4>)\](?: \(may be forged\))? did not issue (?:[A-Z]{4}[/ ]?)+during connection to (?:TLS)?M(?:TA|S[PA])(?:-\w+)?$
I am testing with fail2ban-regex test-mail.log /etc/fail2ban/filter.d/sendmail-reject.conf
Resulting in:
Results
=======
Failregex: 0 total
Ignoreregex: 0 total
Date template hits:
|- [# of hits] date format
| [5] {^LN-BEG}(?:DAY )?MON Day %k:Minute:Second(?:\.Microseconds)?(?: ExYear)?
`-
Lines: 5 lines, 0 ignored, 0 matched, 5 missed
[processed in 0.00 sec]
Any idea ?
Thanks !
The second message (did not issue MAIL/EXPN/VRFY/ETRN) can be found if you would set mode aggressive by sendmail-reject jail (after this fix, e. g. v.0.10.6 and 0.11.2).
There was indeed no exact rule for the first message (rate limit exceeded) matching this kind of message exactly, due to different handling on the arguments, but...
I fixed this now in f0214b3 on github.
Unless not released you can extend it by yourselves either in filter (copy & paste from github filter) or directly in jail:
[sendmail-reject]
enabled = true
mode = aggressive
failregex = %(known/failregex)s
^ruleset=check_relay(?:, arg\d+=\S*)*, relay=(\S+ )?\[?<ADDR>\]?(?: \(may be forged\))?, reject=421 4\.3\.2 (Connection rate limit exceeded\.|Too many open connections\.)$"
^(?:\S+ )?\[<ADDR>\](?: \(may be forged\))? did not issue \S+ during connection
Want to get specific hour to another and save output. First hour is my start point for example:
Nov 20 13:42:52 host sendmail[14819]: qAKCgpxF014819: Milter: read returned -1: Connection reset by mail.yahoo.com
And my finish point is:
Nov 20 16:22:23 host sendmail[16326]: qAKCgpxF016326: Milter: read returned -1: Connection reset by mail.yahoo.com
I need to save all data from my start point to my finish point into file only.
If the records are sorted by time, you can just
sed -n '/^Nov 20 13:42:52/,/^Nov 20 16:22:23/p' input.log > output.log
Beware, if there are more records with the end time, only the first one will be printed. You can improve it by
sed -n '/start/,/end/{p;d};/end/p'
does this work for you? (didn't test)
awk -F' |:' 'BEGIN{m="Nov";d=20;sh=13;eh=16}$1==m && $2==d && $3>=sh && $3<=eh' file
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.
I have the following code on Windows XP and ActiveState ActivePerl 5.8.
What could be the problem with it? Why does it not work?
I tried to set it as a proxy to my IE but when I connect to some URLs from my IE nothing happens. The code enters the thread function and nothing happens.
use HTTP::Daemon;
use threads;
use HTTP::Status;
use LWP::UserAgent;
my $webServer;
my $d = HTTP::Daemon->new(
LocalAddr => '127.0.0.1',
LocalPort => 80,
Listen => 20
) || die;
print "Web Server started!\n";
print "Server Address: ", $d->sockhost(), "\n";
print "Server Port: ", $d->sockport(), "\n";
while (my $c = $d->accept) {
threads->create(\&process_one_req, $c)->detach();
}
sub process_one_req {
STDOUT->autoflush(1);
my $c = shift;
while (my $r = $c->get_request) {
if ($r->method eq "GET") {
print "Session info\n", $r->header('Host');
my $ua = LWP::UserAgent->new;
my $response = $ua->request($r);
$c->send_response($response);
} else {
$c->send_error(RC_FORBIDDEN);
}
}
$c->close;
undef($c);
}
I added the following line to the code before LWP::UserAgent->new and it seems to be working for me (in linux).
$r->uri("http://" . $r->header('Host') . "/" . $r->uri());
The uri that you got from the HTTP::Request object from the original request does not have the hostname. So added it to make it a absolute uri. Tested as follows:
$ curl -D - -o /dev/null -s -H 'Host: www.yahoo.com' http://localhost:8080/
HTTP/1.1 200 OK
Date: Thu, 27 Jan 2011 12:59:56 GMT
Server: libwww-perl-daemon/5.827
Cache-Control: private
Connection: close
Date: Thu, 27 Jan 2011 12:57:15 GMT
Age: 0
---snip--
UPDATE: Looks like I was completely wrong. I didnt need to make the change to URI object. Your original code worked for me as it is in Linux
If I recall correctly, this is because of the threading model in Windows where file handles are not passed between processes unless specifically asked for. This PerlMonks post seems to shed some light on the underlying problem, and may lead to an approach that works for you (I imagine you may be able to call the windows API on the file descriptor of of the client connection to allow access to it within the spawned thread).
Perl threads on Windows generally make my head hurt, while on UNIX-list systems I find them very easy to deal with. Then again, I imagine figuring out how to correctly use forked processes to emulate threads on a system that ONLY supports threads and not forking would make most people's head hurt.
How to check if today is a weekend using bash or even perl?
I want to prevent certain programs to run on a weekend.
You can use something like:
if [[ $(date +%u) -gt 5 ]]; then echo weekend; fi
date +%u gives you the day of the week from Monday (1) through to Sunday (7). If it's greater than 5 (Saturday is 6 and Sunday is 7), then it's the weekend.
So you could put something like this at the top of your script:
if [[ $(date +%u) -gt 5 ]]; then
echo 'Sorry, you cannot run this program on the weekend.'
exit
fi
Or the more succinct:
[[ $(date +%u) -gt 5 ]] && { echo "Weekend, not running"; exit; }
To check if it's a weekday, use the opposite sense (< 6 rather than > 5):
$(date +%u) -lt 6
case "$(date +%a)" in
Sat|Sun) echo "weekend";;
esac
This is actually a surprisingly difficult problem, because who is to say that "weekend" means Saturday and Sunday... what constitutes "the weekend" can actually vary across cultures (e.g. in Israel, people work on Sunday and have Friday off). While you can get the date with the date command, you will need to store some additional data indicating what constitutes the weekend for each locale if you are to implement this in a way that works for all users. If you target only one country, then the solution posed in the other answers will work... but it is always good to keep in mind the assumptions being made here.
Use Perl's localtime operator.
localtime
Converts a time as returned by the time function to a 9-element list with the time analyzed for the local time zone. Typically used as follows:
# 0 1 2 3 4 5 6 7 8
($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time);
…
$wday is the day of the week, with 0 indicating Sunday and 3 indicating Wednesday.
For example:
$ date
Sun Aug 15 20:27:29 CDT 2010
$ perl -le 'my $wday = (localtime)[6];
print $wday >= 1 && $wday <= 5 ? "weekday" : "weekend"'
weekend
printf also has date
printf -v day '%(%a)T'
case $day in
Sat|Sun) echo "Hooray!";;
esac
https://ideone.com/wU7C0c - demo
I am not really sure if this is suited to this question but I wanted to share this it to help others out and this is the closest Stack question to what I was looking for.
This is a shell script that I use for starting an application when i boot my computer, the application cannot connect to its server over the weekend (its down for maintenance as the service doesn't run at weekends (forex trading application).
Information about this script, d is 1 to 7 (mon to sun) h is 24 time. You can adjust this to your own settings, maybe you have a midweek maintenance or any other cause. This is my first ever shell script, so I'm sure there is a better way and if anybody wants make edits, feel free I will review for acceptance (or somebody else may do it)
#!/bin/bash
d=$(date +%u)
h=$(date +%H)
case $d in
'5')
# Friday after 10pm
if (($h >= 22)) ; then
exit
fi
;;
'6')
# all day saturday
exit
;;
'7')
#sunday before 10pm
if (($h < 22)) ; then
exit
fi
;;
*)
# any other time run the program
;;
esac
I like this way of running programs on weekdays:
[[ $(date +%u) -lt 6 ]] && weekday-program
It is a bit tricky construction, but compact and easy to add.