#!/usr/bin/perl # # IMSpector real-time log viewer # (c) SmoothWall Ltd 2008 # # Released under the GPL v2. use POSIX qw(strftime); # Common configuration parameters. my $logbase = "/var/log/imspector/"; my $oururl = '/cgi-bin/imspector.cgi'; # Colours my $protocol_colour = '#06264d'; my $local_colour = '#1d398b'; my $remote_colour = '#2149c1'; my $conversation_colour = '#335ebe'; my $local_user_colour = 'blue'; my $remote_user_colour = 'green'; # No need to change anything from this point # Page declaration, The following code should parse the CGI headers, and render the page # accordingly... How you do this depends what environment you're in. my %cgiparams; print "Content-type: text/html\n"; print "\n"; if ($ENV{'QUERY_STRING'}) { my @vars = split('\&', $ENV{'QUERY_STRING'}); foreach $_ (@vars) { my ($var, $val) = split(/\=/); $cgiparams{$var} = $val; } } # Act in Tail mode (as in just generate the raw logs and pass back to the other CGI if ( defined $cgiparams{'mode'} and $cgiparams{'mode'} eq "render" ){ &parser( $cgiparams{'section'}, $cgiparams{'offset'}, $cgiparams{'conversation'}, $cgiparams{'skimhtml'} ); exit; } # Start rendering the Page using Express' rendering functions my $script = &scriptheader(); # Print Some header information print qq| IMSpector real-time log viewer $script |; print &pagebody(); # and now finish off the HTML page. print qq| |; exit; # ----------------------------------------------------------------------------- # ---------------------- IMSPector Log Viewer Code ---------------------------- # ----------------------------------------------------------------------------- # ^"^ ^"^ # Scriptheader # ------------ # Return the bulk of the page, which should reside in the pages field sub scriptheader { my ( $sec, $min, $hour, $mday, $mon, $year, $wday, $yday ) = localtime( time() ); $year += 1900; $mon++; my $conversation = sprintf( "%.4d-%.2d-%.2d", $year, $mon, $mday ); my $script = qq { }; return $script; } # pagebody function # ----------------- # Return the HTML fragment which includes the page body. sub pagebody { my $body = qq {
 
For conversations on: 
[HTML] [SCROLL LOCK]
}; return $body; } # Parser function ... # --------------- # Retrieves the IMspector logs from their nestling place and displays them accordingly. sub parser { my ( $section, $offset, $conversationdate, $skimhtml ) = @_; # render the user list ... chomp $offset; unless ( $offset =~ /^([\d]*)$/ ){ print STDERR "Illegal offset ($offset $1) resetting...\n"; $offset = 0; } # browse for the available protocols unless ( opendir DIR, $logbase ){ exit; } my %conversationaldates; my @protocols = grep {!/^\./} readdir(DIR); foreach my $protocol ( @protocols ){ unless ( opendir LUSER, "$logbase$protocol" ){ next; } my @localusers = grep {!/^\./} readdir(LUSER); foreach my $localuser ( @localusers ){ unless ( opendir RUSER, "$logbase$protocol/$localuser/" ){ next; } my @remoteusers = grep {!/^\./} readdir( RUSER ); foreach my $remoteuser ( @remoteusers ){ unless ( opendir CONVERSATIONS, "$logbase$protocol/$localuser/$remoteuser/" ){ next; } my @conversations = grep {!/^\./} readdir( CONVERSATIONS ); foreach my $conversation ( @conversations ){ $conversationaldates{ $conversation } = $localuser; } closedir CONVERSATIONS; my ( $sec, $min, $hour, $mday, $mon, $year, $wday, $yday ) = localtime( time() ); $year += 1900; $mon++; my $conversation = sprintf( "%.4d-%.2d-%.2d", $year, $mon, $mday ); $conversation = $conversationdate if ( defined $conversationdate and $conversationdate ne "" ); if ( -e "$logbase$protocol/$localuser/$remoteuser/$conversation" ){ my $modi = -M "$logbase$protocol/$localuser/$remoteuser/$conversation"; print "|$protocol|$localuser|$remoteuser|$conversation|$modi\n"; } } closedir RUSER; } closedir LUSER; } closedir DIR; print "--END--\n"; # display a list of conversational dates .. i.e. the dates which we have conversations on. foreach my $key ( sort keys %conversationaldates ){ print "$key\n"; } print "--END--\n"; # now check the log file ... if ( $section ne "none" ){ my ( $protocol, $localuser, $remoteuser, $conversation ) = split /\|/, $section; print "$protocol, $localuser, $remoteuser, $conversation\n"; print "--END--\n"; my $filename = "$logbase$protocol/$localuser/$remoteuser/$conversation"; unless ( open(FD, "$filename" ) ){ exit; }; # perform some *reasonably* complicated file hopping and stuff of that ilk. # it's not beyond reason that logs *could* be extremely large, so what we # should do to speed up their processing is to jump to the end of the file, # then backtrack a little (say a meg, which is a reasonably amount of logs) # and parse from that point onwards. This, *post* filtering might of course # not leave us with the desired resolution for the tail. If this is the case, # we keep that array and jump back another meg and have another go, concatinating # the logs as we go.... my $jumpback = 100000; # not quite a meg, but hey ho my $goneback = 0; my $gonebacklimit = 1000000000; # don't go back more than 100MB # firstly jump to the end of the file. seek( FD, 0, 2 ); my $log_position = tell( FD ); my $end = $log_position; my $end_position = $log_position; my $lines; my @content; my $TAILSIZE = 100; do { $end_position = $log_position; if ( $offset != 0 ){ # we were given a hint as to where we should have been anyhow .. # so we might as well use that to go back to. $log_position = $offset; $goneback = $end_position - $log_position; } else { $log_position -= $jumpback; $goneback += $jumpback; } last if ( $goneback > $gonebacklimit ); if ( $log_position > 0 ){ seek( FD, $log_position, 0 ); } else { seek( FD, 0, 0 ); } my @newcontent; while ( my $line = and ( tell( FD ) <= $end_position ) ){ chomp $line; push @content, $line; } shift @content if $#content >= $TAILSIZE; } while ( $#content < $TAILSIZE and $log_position > 0 and $offset == 0 ); # trim the content down as we may have more entries than we should. while ( $#content > $TAILSIZE ){ shift @content; }; close FD; print "$end_position\n--END--\n"; foreach my $line ( @content ){ my ( $address, $timestamp, $direction, $type, $filtered, $cat, $data ); ( $address, $timestamp, $direction, $type, $filtered, $cat, $data ) = ( $line =~ /([^,]*),(\d+),(\d+),(\d+),(\d+),([^,]*),(.*)/ ); # are we using the oldstyle or new style logs ? if ( not defined $address and not defined $timestamp ){ ( $address, $timestamp, $type, $data ) = ( $line =~ /([^,]*),([^,]*),([^,]*),(.*)/ ); if ( $type eq "1" ){ $direction = 0; $type = 1; } elsif ( $type eq "2" ){ $direction = 1; $type = 1; } elsif ( $type eq "3" ){ $direction = 0; $type = 2; } elsif ( $type eq "4" ){ $direction = 1; $type = 4; } } my ( $severity, $classification ) = '0', 'None'; if ($cat) { ( $severity, $classification) = split(/ /, $cat, 2); } else { $cat = 'N/A'; } my $red = 255; my $green = 255; my $blue = 255; if ($severity < 0 && $severity >= -5) { $red = 0; $green = abs($severity) * (255 / 5); $blue = 0; } elsif ($severity > 0 && $severity <= 5) { $red = $severity * (255 / 5); $green = 0; $blue = 0; } else { $red = 0; $green = 0; $blue = 0; } my $severitycolour = ''; if ($cat ne 'N/A') { $severitycolour = sprintf("background-color: #%02x%02x%02x;", $red, $green, $blue); } # some protocols (ICQ, I'm looking in your direction) have a habit of starting # and ending each sentence with HTML (evil program) if ( defined $skimhtml and $skimhtml eq "1" ){ $data =~ s/^]*>]*>//ig; $data =~ s/<\/FONT><\/BODY><\/HTML>//ig; } $data = &htmlescape($data); $data =~ s/\r\\n/
\n/g; my $user = ""; my $bstyle = ""; $bstyle = "style='background-color: #FFE4E1;'" if ( $filtered eq "1" ); if ( $type eq "1" ){ # a message message (from remote user) if ( $direction eq "0" ){ # incoming my $u = $remoteuser; $u =~ s/\@.*//g; $user = "<$u>"; } else { # outgoing message my $u = $localuser; $u =~ s/\@.*//g; $user = "<$u>"; } } elsif ($type eq "2") { if ( $direction eq "0" ){ # incoming file my $u = $remoteuser; $u =~ s/\@.*//g; $user = "<$u>"; } else { # outgoing file my $u = $localuser; $u =~ s/\@.*//g; $user = "<$u>"; } } my $t = strftime "%H:%M:%S", localtime($timestamp); if ($type eq "3" or $type eq "4") { $data = "$data"; } print "[$t]$user$data"; } } return; } sub htmlescape { my ($value) = @_; $value =~ s/&/\&/g; $value =~ s//\>/g; $value =~ s/"/\"/g; $value =~ s/'/\'/g; return $value; }