In Tue, 7 Oct 2003, Abd El-Hameed Mohammed wrote:
> Thank you all.
> OK
> Let me ask again, are there any way to store a web site bandwidth statistics
> in a file or a database
Yes.
I adapted some of the Apache::AuthDBI module into a logging hook that
interfaces to a database via dbi via custom query(ies). You can use
tokens I've defined to insert just about any of the available retrievable
information from the objects available to a module into the custom
queries. You can use this to execute any custom query on a database with
time and bandwidth used, for instance thus allowing you to generate the
most detailed bandwidth statistics you could ever want, or as general as
you like. Group it how you please.
This is not a fully tested module. Use at your own risk. Help me make
it better.
Perldoc should work on it to help you figure out how to use the tokens.
Ask if you hvae any questions, and please let me know of any suggestions
for improvements!
With intrepidation, here is the code.
Skylos
---
package Apache::ActivityLogDBI;
use Apache ();
use Apache::Constants qw( OK SERVER_ERROR );
use DBI ();
use strict;
# $Id: ActivityLogDBI.pm,v 0.01 2003/10/07 08:36:38 ask Exp $
require_version DBI 1.00;
$ActivityLogDBI::VERSION = '0.01';
# 1: report about cache miss
# 2: full debug output
$ActivityLogDBI::DEBUG = 0;
# configuration attributes, defaults will be overwritten with values from .htaccess.
my %Config = (
'Activity_Log_DBI_data_source' => '',
'Activity_Log_DBI_username' => '',
'Activity_Log_DBI_password' => '',
);
# stores the configuration of current URL.
# initialized during authentication, eventually re-used for authorization.
my $Attr = { };
# rectify queries with the appropriate information
sub subvars {
my $r = shift;
my $query = shift;
my $dbh = shift;
my $s = $r->server;
my $c = $r->connection;
my $vals = {
CONNECTION_REMOTEHOST => sub { $c->remote_host(); },
CONNECTION_REMOTEIP => sub { $c->remote_ip(); },
CONNECTION_REMOTELOGNAME => sub { $c->remote_logname(); },
CONNECTION_USER => sub { $c->user(); },
CONNECTION_AUTHTYPE => sub { $c->auth_type(); },
CONNECTION_ABORTED => sub { $c->aborted(); },
REQUEST_METHOD => sub { $r->method(); },
REQUEST_BYTES => sub { $r->bytes_sent(); },
REQUEST_HEADER => sub { $r->header_only(); },
REQUEST_PROTOCOL => sub { $r->protocol(); },
REQUEST_HOSTNAME => sub { $r->hostname(); },
REQUEST_TIME => sub { my @d = localtime($r->time()); sprintf '%04d-%02d-%02d
%02d:%02d:%02d', 1900+$d[5], 1+$d[4], $d[3], $d[2], $d[1], $d[0]; },
REQUEST_URI => sub { $r->uri(); },
REQUEST_FILENAME => sub { $r->filename(); },
REQUEST_LOCATION => sub { $r->location(); },
REQUEST_PATH_INFO => sub { $r->path_info(); },
REQUEST_ARGS => sub { $r->args(); },
SERVER_DOCUMENTROOT => sub { $s->document_root(); },
SERVER_SERVERROOT => sub { $s->server_root_relative(); },
SERVER_SERVERPORT => sub { $s->get_server_port(); },
SERVER_ADMIN => sub { $s->server_admin(); },
SERVER_HOSTNAME => sub { $s->server_hostname(); },
SERVER_ISVIRTUAL => sub { $s->server_is_virtual(); },
SERVER_UID => sub { $s->uid(); },
SERVER_GID => sub { $s->gid(); },
SERVER_LOGLEVEL => sub { $s->loglevel(); },
};
foreach (keys %{$vals}) {
if ($query =~ /$_/) {
my $value = $dbh->quote($vals->{$_}->());
$query =~ s/$_/$value/g;
}
}
return $query;
}
# log handler
sub log {
my ($r) = @_;
my ($key, $val, $dbh);
my $prefix = "$$ ActivityLogDBI::log";
if ($ActivityLogDBI::DEBUG > 1) {
my ($type) = '';
$type .= 'initial ' if $r->is_initial_req;
$type .= 'main' if $r->is_main;
print STDERR "==========\n$prefix request type = >$type< \n";
}
return OK unless $r->is_initial_req; # only the first internal request
print STDERR "REQUEST:\n", $r->as_string if $ActivityLogDBI::DEBUG > 2;
# get username
my ($user_sent) = $r->connection->user;
print STDERR "$prefix user sent = >$user_sent<\n" if $ActivityLogDBI::DEBUG > 1;
# get configuration
while(($key, $val) = each %Config) {
$val = $r->dir_config($key) || $val;
$key =~ s/^Activity_Log_DBI_//;
$Attr->{$key} = $val;
printf STDERR "$prefix Config{ %-16s } = %s\n", $key, $val if
$ActivityLogDBI::DEBUG > 1;
}
my @queries;
my $temp = $r->dir_config();
while(($key, $val) = each %{$temp}) {
next unless ($key =~ /^Activity_Log_DBI_Query/);
push @queries, $val;
printf STDERR "$prefix Config{ %-16s } = %s\n", $key, $val if
$ActivityLogDBI::DEBUG > 1;
}
undef $temp;
unless (scalar @queries) {
printf STDERR "$prefix No queries - return OK\n" if $ActivityLogDBI::DEBUG > 1;
return OK;
}
# parse connect attributes, which may be tilde separated lists
my @data_sources = split(/~/, $Attr->{data_source});
my @usernames = split(/~/, $Attr->{username});
my @passwords = split(/~/, $Attr->{password});
$data_sources[0] = '' unless $data_sources[0]; # use ENV{DBI_DSN} if not defined
# connect to database, use all data_sources until the connect succeeds
my $j;
for ($j = 0; $j <= $#data_sources; $j++) {
last if ($dbh = DBI->connect($data_sources[$j], $usernames[$j],
$passwords[$j]));
}
unless ($dbh) {
$r->log_reason("$prefix db connect error with data_source
>$Attr->{data_source}<", $r->uri);
return SERVER_ERROR;
}
foreach (@queries) {
# generate statement
my $statement = subvars $r, $_, $dbh;
print STDERR "$prefix statement: $statement\n" if $ActivityLogDBI::DEBUG > 1;
# run statement
my $rows;
unless ($rows = $dbh->do($statement)) {
$r->log_reason("$prefix can not do statement: $DBI::errstr
$DBI::lasth->{Statement}", $r->uri);
$dbh->disconnect;
return SERVER_ERROR;
}
print STDERR "$prefix rows affected: $rows\n" if $ActivityLogDBI::DEBUG > 0;
if ($dbh->err) {
$dbh->disconnect;
return SERVER_ERROR;
}
}
$dbh->disconnect;
printf STDERR "$prefix return OK\n" if $ActivityLogDBI::DEBUG > 1;
return OK;
}
1;
__END__
=head1 NAME
ActivityLogDBI - Activity Logging via Perl's DBI
=head1 SYNOPSIS
# Configuration in httpd.conf or startup.pl:
PerlModule Apache::ActivityLogDBI
PerlLogHandler ActivityLogDBI::log
PerlSetVar Activity_Log_DBI_data_source dbi:driver:dsn
PerlSetVar Activity_Log_DBI_username db_username
PerlSetVar Activity_Log_DBI_password db_password
#DBI->connect($data_source, $username, $password)
PerlSetVar Activity_Log_DBI_Query[...] custom queries
Any active variables that start with Activity_Log_DBI_Query is executed
upon the triggering of the logging hook. Use the variable scoping for
sites and directories to overwrite lower level queries as necessary.
=head1 DESCRIPTION
This module allows custom logging against a database using Perl's DBI. For
supported DBI drivers see:
http://dbi.perl.org/
=head1 LIST OF TOKENS
=item *
Activity_Log_DBI_data_source (Database Authentication)
The data_source value has the syntax 'dbi:driver:dsn'. This parameter is
passed to the database driver for processing during connect. The data_source
parameter (as well as the username and the password parameters) may be a
tilde ('~') separated list of several data_sources. All of these triples will
be used until a successful connect is made. This way several backup-servers can
be configured. if you want to use the environment variable DBI_DSN instead of
a data_source, do not specify this parameter at all.
=item *
Activity_Log_DBI_username (Database Authentication)
The username argument is passed to the database driver for processing during
connect. This parameter may be a tilde ('~') separated list. See the data_source
parameter above for the usage of a list.
=item *
Activity_Log_DBI_password (Database Authentication)
The password argument is passed to the database driver for processing during
connect. This parameter may be a tilde ('~') separated list. See the data_source
parameter above for the usage of a list.
=item *
Activity_Log_DBI_Query[...]
Any token beginning with 'Activity_Log_DBI_Query' will be added to a list of
queries that are executed on the DBI connection when the activity hook is
implimented. See MACROS below for macros that will automatically be substituted
in for values from the module environment.
=head1 CONFIGURATION
The module should be loaded upon startup of the Apache daemon.
Add the following line to your httpd.conf:
PerlModule Apache::ActivityLogDBI
A common usage is to load the module in a startup file via the PerlRequire
directive. See eg/startup.pl for an example.
To enable debugging the variable $ActivityLogDBI::DEBUG must be set. This
can either be done in startup.pl or in the user script. Setting the variable
to 1, just reports about a cache miss. Setting the variable to 2 enables full
debug output.
=head1 PREREQUISITES
Note that this module needs mod_perl-1.08 or higher, apache_1.3.0 or higher
and that mod_perl needs to be configured with the appropriate call-back hooks:
PERL_LOG=1 PERL_STACKED_HANDLERS=1
=head1 SECURITY
In some cases it is more secure not to put the username and the password in
the .htaccess file. The following example shows a solution to this problem:
httpd.conf:
<Perl>
my($uid,$pwd) = My::dbi_pwd_fetch();
$Location{'/foo/bar'}->{PerlSetVar} = [
[ Activity_Log_DBI_username => $uid ],
[ Activity_Log_DBI_password => $pwd ],
];
</Perl>
=head1 MACROS
=item *
CONNECTION_REMOTEHOST
Output of the remote_host() method of the Connection object.
=item *
CONNECTION_REMOTEIP
Output of the remote_ip() method of the Connection object.
=item *
CONNECTION_REMOTELOGNAME
Output of the remote_logname() method of the Connection object.
=item *
CONNECTION_USER
Output of the user() method of the Connection object.
=item *
CONNECTION_AUTHTYPE
Output of the auth_type() method of the Connection object.
=item *
CONNECTION_ABORTED
Output of the aborted() method of the Connection object.
=item *
REQUEST_METHOD
Output of the method() method of the Request object.
=item *
REQUEST_BYTES
Output of the bytes_sent() method of the Request object.
=item *
REQUEST_HEADER
Output of the header_only() method of the Request object.
=item *
REQUEST_PROTOCOL
Output of the protocol() method of the Request object.
=item *
REQUEST_HOSTNAME
Output of the hostname() method of the Request object.
=item *
REQUEST_TIME
ISO formatted output of the time() method of the Request object.
=item *
REQUEST_URI
Output of the uri() method of the Request object.
=item *
REQUEST_FILENAME
Output of the filename() method of the Request object.
=item *
REQUEST_LOCATION
Output of the location() method of the Request object.
=item *
REQUEST_PATH_INFO
Output of the path_info() method of the Request object.
=item *
REQUEST_ARGS
Output of the args() method of the Request object.
=item *
SERVER_DOCUMENTROOT
Output of the document_root() method of the Request object.
=item *
SERVER_SERVERROOT
Output of the server_root_realative() method of the Request object.
=item *
SERVER_SERVERPORT
Output of the get_server_port() method of the Request object.
=item *
SERVER_ADMIN
Output of the server_admin() method of the Request object.
=item *
SERVER_HOSTNAME
Output of the server_hostname() method of the Server object.
=item *
SERVER_ISVIRTUAL
Output of the server_is_virtual() method of the Server object.
=item *
SERVER_UID
Output of the uid() method of the Server object.
=item *
SERVER_GID
Output of the gid() method of the Server object.
=item *
SERVER_LOGLEVEL
Output of the loglevel() method of the Server object.
=head1 SEE ALSO
L<Apache>, L<mod_perl>, L<DBI>
=head1 AUTHORS
=item *
Apache::ActivityLogDBI by David Ihnen <[EMAIL PROTECTED]>
=item *
Code structure derived from Apache::AuthDBI by Edmund Mergl; now maintained and
supported by the modperl mailinglist.
=item *
mod_perl by Doug MacEachern <[EMAIL PROTECTED]>
=item *
DBI by Tim Bunce <[EMAIL PROTECTED]>
=head1 COPYRIGHT
The ActivityLogDBI module is free software; you can redistribute it and/or
modify it under the same terms as Perl itself.
=cut
---
> ----- Original Message -----
> From: "Ged Haywood" <[EMAIL PROTECTED]>
> To: "Abd El-Hameed Mohammed" <[EMAIL PROTECTED]>
> Cc: <[EMAIL PROTECTED]>
> Sent: Sunday, October 05, 2003 12:45 PM
> Subject: Re: Apache bandwidth calculating
>
>
> > Hi there,
> >
> > On Fri, 3 Oct 2003, Abd El-Hameed Mohammed wrote:
> >
> > > Do any one know where i can find the source of mod_bwlimited
> > > or any recources for modules like it.
> >
> > http://modules.apache.org/search
> >
> > Type the word "bandwidth" into the box.
> >
> > Try CPAN too, and you might want to look at
> >
> > http://www.modperlcookbook.org/chapters/ch13.pdf
> >
> > in which Geoff which mentions mod_throttle_access
> > (and brings us more-or-less back on-topic:).
> >
> > 73,
> > Ged.
> >
> > [This E-mail scanned for viruses using McAfee.]
> >
> >
> >
>
>
- [EMAIL PROTECTED]
- The best part about the internet is nobody knows you're a dog.
(Peter Stiener, The New Yorker, July 5, 1993)
- Dogs like... TRUCKS! (Nissan commercial, 1996)
- PGP key: http://dogpawz.com/skylos/mykey.asc
