| Subject: | Lines with no file requested are not properly parsed |
The parsing of lines with no file requested is wrong:
207.36.180.53 - - [04/Feb/2005:12:55:20 -0500] "GET HTTP/1.1" 400 - "-" "-"
is valid (although in this case it is also a crack attempt).
In this case I get HTTP/1.1 as the file name.
The attached test.pl is a replacement for the original test.pl which shows the bug.
The fix is to remove the + from the split in line 33 of AccessLogEntry.pm:
- ($Ref->{rtype},$Ref->{file},$Ref->{proto},$Ref->{code},$Ref->{bytes},$R2)=split(/\s+/,$Rest,6);
+ ($Ref->{rtype},$Ref->{file},$Ref->{proto},$Ref->{code},$Ref->{bytes},$R2)=split(/\s/,$Rest,6);
# Before `make install' is performed this script should be runnable with
# `make test'. After `make install' it should work as `perl test.pl'
#########################
# change 'tests => 1' to 'tests => last_test_to_print';
use Test;
BEGIN { plan tests => 4 };
use Parse::AccessLogEntry;
ok(1); # If we made it this far, we're ok.
#########################
# Insert your test code below, the Test module is use()ed here so read
# its man page ( perldoc Test ) for help writing this test script.
{
my $P=Parse::AccessLogEntry::new();
my $Line='1.2.3.4 - - [14/Aug/2002:06:53:08 -0600] "GET /test.html HTTP/1.1" 200 2700 "http://www.securelevel.com" "Mozilla/4.0 (compatible)"';
my $parsed= q{host=1.2.3.4#user=-#date=14/Aug/2002#time=06:53:08#diffgmt=-0600#rtype=GET#file=/test.html#proto=HTTP/1.1#code=200#bytes=2700#refer=http://www.securelevel.com#agent=Mozilla/4.0 (compatible)};
my $Ref=$P->parse($Line);
is( $Ref, $parsed, 2, 'basic parsing');
}
{
my $P=Parse::AccessLogEntry::new();
my $Line='1.2.3.4 - foo [14/Aug/2002:06:53:08 -0600] "GET /test.html HTTP/1.1" 200 2700 "http://www.securelevel.com" "Mozilla/4.0 (compatible)"';
my $parsed= q{host=1.2.3.4#user=foo#date=14/Aug/2002#time=06:53:08#diffgmt=-0600#rtype=GET#file=/test.html#proto=HTTP/1.1#code=200#bytes=2700#refer=http://www.securelevel.com#agent=Mozilla/4.0 (compatible)};
my $Ref=$P->parse($Line);
is( $Ref, $parsed, 3, 'user name included');
}
{ # test parse bug when no file is requested
my $line='207.36.180.53 - - [04/Feb/2005:12:55:20 -0500] "GET HTTP/1.1" 400 - "-" "-"';
my $parsed="host=207.36.180.53#user=-#date=04/Feb/2005#time=12:55:20#diffgmt=-0500#rtype=GET#file=#proto=HTTP/1.1#code=400#bytes=-#refer=-#agent=-";
my $p=Parse::AccessLogEntry::new();
my $h= $p->parse( $line);
is( $h, $parsed, 4, 'no file requested');
}
sub is
{ my( $obj, $dump, $nb, $message)= @_;
my $got= dump_obj( $obj);
if( $got eq $dump) { ok( $nb) }
else { ok( !$nb); warn "error in $message, \nexpected: '$dump'\n got : '$got'\n"; }
}
sub dump_obj
{ my $obj= shift;
my @fields= qw( host user date time diffgmt rtype file proto code bytes refer agent);
return join( '#', map( { "$_=$obj->{$_}" } @fields) );
}