From a832cd596e85a2deac94a1ccc6536f0b079a1543 Mon Sep 17 00:00:00 2001 From: Marius Gavrilescu Date: Mon, 28 Sep 2015 13:20:34 +0300 Subject: [PATCH] Add gruntmaster-opener --- MANIFEST | 3 ++ gruntmaster-opener | 48 +++++++++++++++++ lib/Gruntmaster/Opener.pm | 110 ++++++++++++++++++++++++++++++++++++++ t/00-compile.t | 3 +- t/Gruntmaster-Opener.t | 30 +++++++++++ t/perlcriticrc | 6 +++ 6 files changed, 199 insertions(+), 1 deletion(-) create mode 100755 gruntmaster-opener create mode 100644 lib/Gruntmaster/Opener.pm create mode 100644 t/Gruntmaster-Opener.t diff --git a/MANIFEST b/MANIFEST index 0d3b2f2..6a285eb 100644 --- a/MANIFEST +++ b/MANIFEST @@ -1,6 +1,7 @@ Changes db.sql gm +gruntmaster-opener lib/Gruntmaster/App.pm lib/Gruntmaster/App/Command/Add.pm lib/Gruntmaster/App/Command/Get.pm @@ -10,6 +11,7 @@ lib/Gruntmaster/App/Command/Rm.pm lib/Gruntmaster/App/Command/Set.pm lib/Gruntmaster/App/Command/Show.pm lib/Gruntmaster/Data.pm +lib/Gruntmaster/Opener.pm Makefile.PL make_test_db.sh MANIFEST @@ -17,6 +19,7 @@ README testdata.sql t/00-compile.t t/Gruntmaster-Data.t +t/Gruntmaster-Opener.t t/tools.t t/perlcritic.t t/perlcriticrc diff --git a/gruntmaster-opener b/gruntmaster-opener new file mode 100755 index 0000000..723a77b --- /dev/null +++ b/gruntmaster-opener @@ -0,0 +1,48 @@ +#!/usr/bin/perl +use 5.014; +use warnings; + +use Gruntmaster::Data; +use Gruntmaster::Opener; + +dbinit $ENV{GRUNTMASTER_DSN} // 'dbi:Pg:'; +handle_line $_ while <>; + +__END__ + +=encoding utf-8 + +=head1 NAME + +gruntmaster-opener - Populate opens table from NCSA access logs + +=head1 SYNOPSIS + + gruntmaster-opener /var/log/apache2/access.log + varnishncsa | gruntmaster-opener + +=head1 DESCRIPTION + +gruntmaster-opener reads a NCSA access log supplied via arguments or +(if there are no arguments) stdin, finds lines that represent +successful requests to problems during contests, extracts data from +them and inserts it into the database. + +=head1 SEE ALSO + +L + +=head1 AUTHOR + +Marius Gavrilescu Emarius@ieval.roE + +=head1 COPYRIGHT AND LICENSE + +Copyright (C) 2015 by Marius Gavrilescu + +This library is free software; you can redistribute it and/or modify +it under the same terms as Perl itself, either Perl version 5.18.1 or, +at your option, any later version of Perl 5 you may have available. + + +=cut diff --git a/lib/Gruntmaster/Opener.pm b/lib/Gruntmaster/Opener.pm new file mode 100644 index 0000000..d55b767 --- /dev/null +++ b/lib/Gruntmaster/Opener.pm @@ -0,0 +1,110 @@ +package Gruntmaster::Opener; +use 5.014; +use warnings; + +use parent qw/Exporter/; +use re '/s'; + +our @EXPORT = qw/handle_line/; +our @EXPORT_OK = @EXPORT; +our $VERSION = '5999.000_013'; + +use Date::Parse qw/str2time/; +use Gruntmaster::Data; + +sub _analyze_request { + s/%([0-9A-Fa-f]{2})/chr(hex($1))/eg for @_; # From URI::Escape POD + my ($req, $parms) = @_; + return unless $parms =~ /contest=(\w+)/; + my $ct = $1; + return $req =~ m,/pb/(\w+), ? ($1, $ct) : (); +} + +sub handle_line { + my ($owner, $datetime, $request, $parms) = $_[0] =~ + /(\w+)\s # user + \[([^]]+)\]\s # date + "\w+\s # request method + ([^" ?]+) # URL (without query string) + [?] + ([^" ]+)\s # query string + [^"]+"\s # HTTP version + 2 # response code starts with 2 + /x or return; + my ($pb, $ct) = _analyze_request $request, $parms or return; + my $time = str2time $datetime; + open_problem $ct, $pb, $owner, $time; +} + +1; +__END__ + +=encoding utf-8 + +=head1 NAME + +Gruntmaster::Opener - Populate opens table from NCSA access logs + +=head1 SYNOPSIS + + use Gruntmaster::Opener; + + open my $fh, '<', '/var/log/apache2/access.log'; + handle_line $_ while <$fh>; + +=head1 DESCRIPTION + +Gruntmaster::Opener is the backend of the L script +that reads NCSA-style access logs, finds lines that represent +successful requests to problems during contests, extracts data from +them and inserts it into the database. + +B($line) + +The only function in this module. Exported by default. Takes a single +parameter, a line from a logfile in NCSA common/combined format. + +If the request described in the given line: + +=over + +=item * + +Is successful (response code is 2xx) + +=item * + +Targets a problem (C) + +=item * + +Has a query parameter named C + +=item * + +Happened during the contest named in the C query parameter +(this restriction is enforced by the B function). + +=back + +an entry is added to the C table, using the B +function from L. + +=head1 SEE ALSO + +L + +=head1 AUTHOR + +Marius Gavrilescu Emarius@ieval.roE + +=head1 COPYRIGHT AND LICENSE + +Copyright (C) 2014 by Marius Gavrilescu + +This library is free software; you can redistribute it and/or modify +it under the same terms as Perl itself, either Perl version 5.18.1 or, +at your option, any later version of Perl 5 you may have available. + + +=cut diff --git a/t/00-compile.t b/t/00-compile.t index 3772699..18ad507 100644 --- a/t/00-compile.t +++ b/t/00-compile.t @@ -2,6 +2,7 @@ use v5.14; use warnings; -use Test::More tests => 1; +use Test::More tests => 2; BEGIN { use_ok('Gruntmaster::Data') }; +BEGIN { use_ok('Gruntmaster::Opener') }; diff --git a/t/Gruntmaster-Opener.t b/t/Gruntmaster-Opener.t new file mode 100644 index 0000000..403ed97 --- /dev/null +++ b/t/Gruntmaster-Opener.t @@ -0,0 +1,30 @@ +#!/usr/bin/perl +use v5.14; +use warnings; + +use Test::More tests => 8; +use Gruntmaster::Opener; + +my $opened; +BEGIN { + no warnings 'redefine'; + *Gruntmaster::Opener::open_problem = sub { $opened = 1 }; +} + +sub _test { + my ($line, $should_open, $name) = @_; + $line =~ s,DATE,[01/Jan/2015:00:00:00 +0200],; + $opened = ''; + handle_line $line; + is $opened, $should_open, $name +} + +_test '192.0.2.41 - mgv DATE "GET /pb/problem1?contest=test HTTP/1.1" 200 1234', 1, 'normal case'; +_test '192.0.2.41 - mgv DATE "HEAD http://gruntmaster.example.org/pb/problem1?contest=test HTTP/1.0" 200 1234', 1, 'absolute url'; +_test '2001:db8:abcd::1234 - mgv DATE "GET /pb/%61%62%63%64?%63ontes%74=%62%61%64 SPDY/3" 200 1234', 1, 'superfluous percent encoding'; + +_test '192.0.2.41 - mgv DATE "GET /pb/problem1?contest=test HTTP/1.1" 500 1234', '', 'internal server error'; +_test '192.0.2.41 - - DATE "GET /pb/problem1?contest=test HTTP/1.1" 401 1234', '', 'not logged in'; +_test '192.0.2.41 - mgv DATE "GET /pb/?contest=test HTTP/1.0" 200 1234', '', 'problem list'; +_test '2001:db8:abcd::1234 - mgv DATE "GET /pb/asd SPDY/3" 200 1234', '', 'not in contest'; +_test 'junk', '', 'junk'; diff --git a/t/perlcriticrc b/t/perlcriticrc index c80009c..eea00bd 100644 --- a/t/perlcriticrc +++ b/t/perlcriticrc @@ -7,19 +7,25 @@ severity = 1 [-Documentation::PodSpelling] [-Documentation::RequirePodLinksIncludeText] [-InputOutput::RequireBracedFileHandleWithPrint] +[-Modules::ProhibitAutomaticExportation] [-Modules::RequireExplicitPackage] [-References::ProhibitDoubleSigils] [-RegularExpressions::ProhibitEnumeratedClasses] +[-RegularExpressions::ProhibitUnusualDelimiters] [-RegularExpressions::RequireLineBoundaryMatching] [-Subroutines::RequireFinalReturn] [-ValuesAndExpressions::ProhibitConstantPragma] [-ValuesAndExpressions::ProhibitEmptyQuotes] +[-ValuesAndExpressions::ProhibitLeadingZeros] [-ValuesAndExpressions::ProhibitMagicNumbers] [-ValuesAndExpressions::ProhibitNoisyQuotes] [-Variables::ProhibitLocalVars] [-Variables::ProhibitPackageVars] [-Variables::ProhibitPunctuationVars] +[BuiltinFunctions::ProhibitStringyEval] +allow_includes = 1 + [RegularExpressions::RequireExtendedFormatting] minimum_regex_length_to_complain_about = 20 -- 2.39.2