Index: /trunk/arclog/.arclogrc =================================================================== --- /trunk/arclog/.arclogrc (revision 17269) +++ /trunk/arclog/.arclogrc (revision 17269) @@ -0,0 +1,6 @@ +--- +hosts: +event_filters: + - Raid Powered On + - HTTP Log In +logdb: .arclog_db Index: /trunk/arclog/arclog.pl =================================================================== --- /trunk/arclog/arclog.pl (revision 17269) +++ /trunk/arclog/arclog.pl (revision 17269) @@ -0,0 +1,172 @@ +#!/usr/bin/env perl + +use strict; +use warnings; +use vars qw( $VERSION ); +$VERSION = '0.01'; + +use Config::YAML; +use HTML::TreeBuilder; +use HTTP::Request; +use LWP::UserAgent; +use LWP::ConnCache; +use DateTime::Format::Strptime; +use DBI; + +#use Getopt::Long qw( GetOptions :config auto_help auto_version ); +use Pod::Usage qw( pod2usage ); +# accept no options +pod2usage( -msg => "Unknown option: @ARGV", -exitval => 2 ) if @ARGV; + +my $rcfile = "$ENV{HOME}/.arclogrc"; +$rcfile = File::Spec->canonpath($rcfile); + +my $c = read_rcfile($rcfile); +my $myhosts = $c->get_hosts; +die "no hosts configured" unless $myhosts; +my $logdb = $c->get_logdb; +die "no log file configured" unless $logdb; +my $dbh = DBI->connect("dbi:SQLite:dbname=$logdb","",""); +die "can not open logdb" unless $dbh; + +$dbh->do("CREATE TABLE IF NOT EXISTS log(record TEXT, PRIMARY KEY(record))") + or die "db error"; + +# HTTP authentication realm +my $realm = "Raid Console"; +my $user = "admin"; # unconfigurable on the areca card as far as I know +my $http_port = "81"; + +# collection of fetched HTML log pages +my %log_pages; + +# iterate over the list of hosts and passwords +foreach my $host (keys %$myhosts) { + my $hostport = "$host:$http_port"; + my $ua = LWP::UserAgent->new; + $ua->conn_cache(LWP::ConnCache->new()); + $ua->credentials( "$hostport", $realm, $user => $myhosts->{$host}); + + # first query: access the doc root to setup HTTP digest auth and grab + # exclusive control of the HTTP admin interace + my $res = $ua->request(HTTP::Request->new(GET => "http://$hostport/")); + unless ($res->is_success) { + warn $res->status_line; + next; + } + + # second query: access the log page + my $req = HTTP::Request->new(GET => "http://$hostport/evt0.htm"); + + # if the referer is not set the access attempt with fail + $req->referer("http://$hostport/menu.htm"); + # we must copy the auth credentals from the first query attempt as LWP + # seems to always do a non digest access attempt first, which fails, and + # then does the HTTP digest. In the case of the arcea card this first non + # authed query resets the state of the card and we have to go back and + # request '/' again. + $req->header( Authorization => $res->request->header('Authorization')); + $res= $ua->request($req); + unless ($res->is_success) { + die $res->status_line; + } + + $log_pages{$host} = $res->content; +} + +my $strptime = DateTime::Format::Strptime->new( + pattern => '%Y-%m-%d %H:%M:%S' +); + +my @records; +foreach my $host (keys %log_pages) { + my $page = $log_pages{$host}; + my $root = HTML::TreeBuilder->new->parse($page); + my $table = $root->look_down('_tag', 'table'); + foreach my $row ($table->descendants) { + next unless $row->tag eq "tr"; + my $row_data = parse_row($row); + if (defined $row_data) { + # add the host name to the hash + $row_data->{host} = $host; + push @records, $row_data; + } + } +} + +#use Data::Dumper; +#print Dumper(\@records); +# sort by time +# insert all records +@records = sort { $a->{time} cmp $b->{time} } @records; +my $query = $dbh->prepare("INSERT OR IGNORE INTO log VALUES(?)") + or die "database error: $!"; + +my @myfilters; +foreach my $filter (@{$c->get_event_filters}) { + push @myfilters, qr/$filter/; +} + +RECORDS: foreach my $rec (@records) { + no warnings qw( uninitialized ); + + my ($host, $time, $device, $event, $elapse_time, $errors) + = @$rec{qw( host time device event elapse_time errors )}; + $query->execute("$host|$time|$device|$event|$elapse_time|$errors") + or die "database error: $!"; + + # do not print filtered records + foreach my $filter (@myfilters) { + next RECORDS if $event =~ /$filter/; + } + print "$host $time $device $event $elapse_time $errors\n"; + + use warnings; +} + + +sub parse_row +{ + my $row = shift; + # log table format in firmware "V1.43 2007-4-17" + # + #Time + #Device + #Event Type + #Elapse Time + #Errors + # + my @fields; + foreach my $child ($row->descendants) { + return if $child->tag eq "th"; + my $text = $child->as_text; + # translate HTML " " into undef + $text = undef if $text eq chr(160); + push @fields, $text; + } + my %row_data; + @row_data{qw( time device event elapse_time errors )} = @fields; + + # parse time string into a DateTime object for easy sorting later + $row_data{time} = $strptime->parse_datetime($row_data{time}); + + return \%row_data; +} + + +sub read_rcfile +{ + my $rcfile = shift; + + return unless defined $rcfile; + + if (!-f $rcfile) { + open(my $fh, '>', $rcfile) or die "can't open file: $!"; + close($fh) or die "can't close file:$!"; + } + + return Config::YAML->new( + config => $rcfile, + output => $rcfile, + ); +} Index: /trunk/arclog/arclog_readdb.pl =================================================================== --- /trunk/arclog/arclog_readdb.pl (revision 17269) +++ /trunk/arclog/arclog_readdb.pl (revision 17269) @@ -0,0 +1,75 @@ +#!/usr/bin/env perl + +use strict; +use warnings; +use vars qw( $VERSION ); +$VERSION = '0.01'; + +use Config::YAML; +use HTML::TreeBuilder; +use HTTP::Request; +use LWP::UserAgent; +use LWP::ConnCache; +use DateTime::Format::Strptime; +use DBI; + +#use Getopt::Long qw( GetOptions :config auto_help auto_version ); +use Pod::Usage qw( pod2usage ); +# accept no options +pod2usage( -msg => "Unknown option: @ARGV", -exitval => 2 ) if @ARGV; + +my $rcfile = "$ENV{HOME}/.arclogrc"; +$rcfile = File::Spec->canonpath($rcfile); + +my $c = read_rcfile($rcfile); +my $logdb = $c->get_logdb; +die "no log file configured" unless $logdb; +my $dbh = DBI->connect("dbi:SQLite:dbname=$logdb","",""); +die "can not open logdb" unless $dbh; + +my $query = $dbh->prepare("SELECT * FROM log LIMIT 10") + or die "database error: $!"; +$query->execute or die "database error: $!"; +my $records = $query->fetchall_arrayref(undef); + +my @myfilters; +foreach my $filter (@{$c->get_event_filters}) { + push @myfilters, qr/$filter/; +} + +RECORDS: foreach my $rec (@$records) { + no warnings qw( uninitialized ); + +# use Data::Dumper; +# print Dumper($rec); +# die; + + my ($host, $time, $device, $event, $elapse_time, $errors) + = split(/\|/, $rec->[0]); + + # do not print filtered records + foreach my $filter (@myfilters) { + next RECORDS if $event =~ /$filter/; + } + print "$host $time $device $event $elapse_time $errors\n"; + + use warnings; +} + + +sub read_rcfile +{ + my $rcfile = shift; + + return unless defined $rcfile; + + if (!-f $rcfile) { + open(my $fh, '>', $rcfile) or die "can't open file: $!"; + close($fh) or die "can't close file:$!"; + } + + return Config::YAML->new( + config => $rcfile, + output => $rcfile, + ); +}