Status.pm 10.5 KB
Newer Older
1 2 3 4 5
## @file
# Status process mechanism
#
# @copy 2008 Xavier Guimard <x.guimard@free.fr>

6 7 8
package Lemonldap::NG::Handler::Status;

use strict;
9
use POSIX;
10
use Data::Dumper;
11

12 13
our $VERSION  = "0.2";

14 15 16
our $status   = {};
our $activity = [];
our $start    = int( time / 60 );
17
use constant MN_COUNT => 5;
18

19
## @fn private hashRef portalTab()
20
# @return Constant hash used to convert error codes into string.
21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50
sub portalTab {
    return {
        -2 => 'PORTAL_REDIRECT',
        -1 => 'PORTAL_ALREADY_AUTHENTICATED',
        0  => 'PORTAL_OK',
        1  => 'PORTAL_SESSIONEXPIRED',
        2  => 'PORTAL_FORMEMPTY',
        3  => 'PORTAL_WRONGMANAGERACCOUNT',
        4  => 'PORTAL_USERNOTFOUND',
        5  => 'PORTAL_BADCREDENTIALS',
        6  => 'PORTAL_LDAPCONNECTFAILED',
        7  => 'PORTAL_LDAPERROR',
        8  => 'PORTAL_APACHESESSIONERROR',
        9  => 'PORTAL_FIRSTACCESS',
        10 => 'PORTAL_BADCERTIFICATE',
        11 => 'PORTAL_LA_FAILED',
        12 => 'PORTAL_LA_ARTFAILED',
        13 => 'PORTAL_LA_DEFEDFAILED',
        14 => 'PORTAL_LA_QUERYEMPTY',
        15 => 'PORTAL_LA_SOAPFAILED',
        16 => 'PORTAL_LA_SLOFAILED',
        17 => 'PORTAL_LA_SSOFAILED',
        18 => 'PORTAL_LA_SSOINITFAILED',
        19 => 'PORTAL_LA_SESSIONERROR',
        20 => 'PORTAL_LA_SEPFAILED',
        21 => 'PORTAL_PP_ACCOUNT_LOCKED',
        22 => 'PORTAL_PP_PASSWORD_EXPIRED',
    };
}

51 52 53 54 55
eval {
    POSIX::setgid( ( getgrnam( $ENV{APACHE_RUN_GROUP} ) )[2] );
    POSIX::setuid( ( getpwnam( $ENV{APACHE_RUN_USER} ) )[2] );
};

56
## @rfn void run(string localStorage, hashRef localStorageOptions)
57 58 59 60
# Main.
# Reads requests from STDIN to :
# - update counts
# - display results
61
sub run {
62
    my ( $localStorage, $localStorageOptions ) = ( shift, shift );
63
    my $refLocalStorage;
64 65
    eval
"use $localStorage; \$refLocalStorage = new $localStorage(\$localStorageOptions);";
66 67
    die($@) if ($@);
    $| = 1;
68
    my ( $lastMn, $mn, $count );
69
    while (<STDIN>) {
70
        $mn = int( time / 60 ) - $start + 1;
71 72 73 74 75

        # Cleaning activity array
        if ( $mn > $lastMn ) {
            for ( my $i = 0 ; $i < $mn - $lastMn ; $i++ ) {
                unshift @$activity, {};
76
                delete $activity->[ MN_COUNT + 1 ];
77 78 79 80 81
            }
        }
        $lastMn = $mn;

        # Activity collect
82
        if (/^(\S+)\s+=>\s+(\S+)\s+(OK|REJECT|REDIRECT|LOGOUT|\-?\d+)$/) {
83
            my ( $user, $uri, $code ) = ( $1, $2, $3 );
84

85
            # Portal error translation
86
            $code = portalTab->{$code} || $code if ( $code =~ /^\-?\d+$/ );
87

88
            # Per user activity
89
            $status->{user}->{$user}->{$code}++;
90 91

            # Per uri activity
92 93
            $uri =~ s/^(.*?)\?.*$/$1/;
            $status->{uri}->{$uri}->{$code}++;
94 95
            $count->{uri}->{$uri}++;

96
            # Per vhost activity
97
            my ($vhost) = ( $uri =~ /^([^\/]+)/ );
98 99
            $status->{vhost}->{$vhost}->{$code}++;
            $count->{vhost}->{$vhost}++;
100 101 102

            # Last 5 minutes activity
            $activity->[0]->{$code}++;
103
        }
104 105 106

        # Status requests

107
        # $args contains parameters passed to url status page (a=1 for example
108 109 110
        # if request is http://test.example.com/status?a=1). To be used
        # later...
        elsif (/^STATUS(?:\s+(\S+))?$/) {
111
            my $tmp  = $1;
112
            my $args = {};
113
            %$args = split( /[=&]/, $tmp ) if ($tmp);
114
            &head;
115

116 117
            #print Dumper($args),&end;next;
            my ( $c, $m, $u );
118
            while ( my ( $user, $v ) = each( %{ $status->{user} } ) ) {
119 120
                $u++ unless ( $user =~ /^\d+\.\d+\.\d+\.\d+$/ );

121
                # Total requests
122 123 124 125
                foreach ( keys %$v ) {
                    $c->{$_} += $v->{$_};
                }
            }
126 127 128
            for ( my $i = 1 ; $i < @$activity ; $i++ ) {
                $m->{$_} += $activity->[$i]->{$_}
                  foreach ( keys %{ $activity->[$i] } );
129 130 131 132
            }
            foreach ( keys %$m ) {
                $m->{$_} = sprintf( "%.2f", $m->{$_} / MN_COUNT );
                $m->{$_} = int( $m->{$_} ) if ( $m->{$_} > 99 );
133
            }
134 135
            if ( $args->{'dump'} ) {
                print "<div id=\"dump\"><pre>\n";
136
                print Dumper( $status, $activity, $count );
137
                print "</pre></div>\n";
138 139
            }

140 141
            # Total requests
            print "<h2>Total</h2>\n<div id=\"total\"><pre>\n";
142
            print sprintf( "%-30s : \%6d (%.02f / mn)\n",
143
                $_, $c->{$_}, $c->{$_} / $mn )
144
              foreach ( sort keys %$c );
145
            print "\n</pre></div>\n";
146

147
            # Average
148 149
            print "<h2>Average for last " . MN_COUNT
              . " minutes</h2>\n<div id=\"average\"><pre>\n";
150
            print sprintf( "%-30s : %6s / mn\n", $_, $m->{$_} )
151 152
              foreach ( sort keys %$m );
            print "\n</pre></div>\n";
153

154 155
            # Users connected
            print "<div id=\"users\"><p>\nTotal users : $u\n</p></div>\n";
156

157
            # Local cache
158 159
            my @t =
              $refLocalStorage->get_keys( $localStorageOptions->{namespace} );
160 161
            print "<div id=\"cache\"><p>\nLocal Cache : " . @t
              . " objects\n</p></div>\n";
162

163 164
            # Top uri
            if ( $args->{top} ) {
165
                print "<hr/>\n";
166
                $args->{categories} ||= 'REJECT,PORTAL_FIRSTACCESS,LOGOUT,OK';
167

168 169 170 171 172
                # Vhost activity
                print
                  "<h2>Virtual Host activity</h2>\n<div id=\"vhost\"><pre>\n";
                foreach (
                    sort { $count->{vhost}->{$b} <=> $count->{vhost}->{$a} }
173 174
                    keys %{ $count->{vhost} }
                  )
175
                {
176
                    print sprintf( "%-40s : %6d\n", $_, $count->{vhost}->{$_} );
177
                }
178 179
                print "\n</pre></div>\n";

180 181
                # General
                print "<h2>Top used URI</h2>\n<div id=\"uri\"><pre>\n";
182
                my $i = 0;
183 184 185 186
                foreach (
                    sort { $count->{uri}->{$b} <=> $count->{uri}->{$a} }
                    keys %{ $count->{uri} }
                  )
187 188
                {
                    last if ( $i == $args->{top} );
189
                    last unless ( $count->{uri}->{$_} );
190
                    $i++;
191
                    print sprintf( "%-80s : %6d\n", $_, $count->{uri}->{$_} );
192 193
                }
                print "\n</pre></div>\n";
194

195
                # Top by category
196 197
                print
"<table border=\"1\" width=\"100%\"><tr><th>Code</th><th>Top</ht></tr>\n";
198
                foreach my $cat ( split /,/, $args->{categories} ) {
199 200
                    print
"<tr><td><pre>$cat</pre></td><td nowrap>\n<div id=\"$cat\">\n";
201
                    topByCat( $cat, $args->{top} );
202 203
                    print "</div>\n</td></tr>";
                }
204
                print "</table>\n";
205
            }
206 207 208
            print "<div id=\"up\"><p>\nServer up for : "
              . &timeUp($mn)
              . "\n</p></div>\n";
209
            &end;
210
        }
211 212
    }
}
213

214
## @rfn private string timeUp(int d)
215 216 217
# Return the time since the status process was launched (last Apache reload).
# @param $d Number of minutes since start
# @return Date in format "day hour minute"
218 219 220 221 222
sub timeUp {
    my $d  = shift;
    my $mn = $d % 60;
    $d = ( $d - $mn ) / 60;
    my $h = $d % 24;
Xavier Guimard's avatar
Xavier Guimard committed
223
    $d = ( $d - $h ) / 24;
224 225 226
    return "$d\d $h\h $mn\mn";
}

227
## @rfn private void topByCat(string cat,int max)
228
# Display the "top 10" for a category (OK, REDIRECT,...).
229 230
# @param $cat Category to display
# @param $max Number of lines to display
231
sub topByCat {
232 233
    my ( $cat, $max ) = @_;
    my $i = 0;
234
    print "<pre>\n";
235 236
    foreach (
        sort { $status->{uri}->{$b}->{$cat} <=> $status->{uri}->{$a}->{$cat} }
237 238
        keys %{ $status->{uri} }
      )
239 240 241
    {
        last if ( $i == $max );
        last unless ( $status->{uri}->{$_}->{$cat} );
242
        $i++;
243
        print sprintf( "%-80s : %6d\n", $_, $status->{uri}->{$_}->{$cat} );
244 245 246 247
    }
    print "</pre>\n";
}

248
## @rfn private void head()
249
# Display head of HTML status responses.
250 251 252 253 254 255 256 257 258 259 260
sub head {
    print <<"EOF";
<!DOCTYPE html
    PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN"
         "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
<html xmlns="http://www.w3.org/1999/xhtml" lang="en-US" xml:lang="en-US">
<head>
<title>Lemonldap::NG Status</title>
<meta http-equiv="Content-Type" content="text/html; charset=utf8" />
</head>
<body>
261
<h1>Lemonldap::NG Status</h1>
262 263 264 265 266
EOF
}

sub end {
    print <<"EOF";
267 268 269 270 271 272 273 274
<hr/>
<script type="text/javascript" language="Javascript">
  //<!--
  var a = document.location.href;
  a=a.replace(/\\?.*\$/,'');
  document.write('<a href="'+a+'?top=10&categories=REJECT,PORTAL_FIRSTACCESS,LOGOUT,OK">Top 10</a>');
  //-->
</script>
275 276
</body>
</html>
277
END
278 279
EOF
}
280
1;
281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342 343 344 345 346 347 348 349 350 351 352 353
__END__

=head1 NAME

Lemonldap::NG::Handler::Status - Perl extension to add a mod_status like system for L<Lemonldap::NG::Handler>

=head1 SYNOPSIS

=head2 Create your Apache module

Create your own package (example using a central configuration database):

  package My::Package;
  use Lemonldap::NG::Handler::SharedConf;
  @ISA = qw(Lemonldap::NG::Handler::SharedConf);
  
  __PACKAGE__->init ( {
    # Activate status feature
    status              => 1,
    # Local storage used for sessions and configuration
    localStorage        => "Cache::DBFile",
    localStorageOptions => {...},
    # How to get my configuration
    configStorage       => {
        type                => "DBI",
        dbiChain            => "DBI:mysql:database=lemondb;host=$hostname",
        dbiUser             => "lemonldap",
        dbiPassword          => "password",
    }
    # ... See Lemonldap::N::Handler
  } );

=head2 Configure Apache

Call your package in /apache-dir/conf/httpd.conf:

  # Load your package
  PerlRequire /My/File
  # Normal Protection
  PerlHeaderParserHandler My::Package
  
  # Status page
  <Location /status>
    Order deny,allow
    Allow from 10.1.1.0/24
    Deny from all
    PerlHeaderParserHandler My::Package->status
  </Location>

=head1 DESCRIPTION

Lemonldap::NG::Handler::Status adds a mod_status like feature to display
Lemonldap::NG::Handler activity on a protected server. It can so be used by
L<mrtg> or directly browsed by your browser.

=head1 SEE ALSO

L<Lemonldap::NG::Handler>, L<Lemonldap::NG::Portal>, L<Lemonldap::NG::Manager>,
L<http://wiki.lemonldap.objectweb.org/xwiki/bin/view/NG/Presentation>

=head1 AUTHOR

Xavier Guimard, E<lt>guimard@E<gt>

=head1 COPYRIGHT AND LICENSE

Copyright (C) 2008 by Xavier Guimard

This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself, either Perl version 5.8.8 or,
at your option, any later version of Perl 5 you may have available.

=cut