home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
rtsi.com
/
2014.01.www.rtsi.com.tar
/
www.rtsi.com
/
OS9
/
FAQ
/
cgi-bin
/
discus4_00
/
source
/
prgdebug.pl
< prev
next >
Wrap
Text File
|
2009-11-06
|
11KB
|
355 lines
# FILE: prgdebug.pl
# DESCRIPTION: For debugging actions by individual users
#-------------------------------------------------------------------------------
# DISCUS COPYRIGHT NOTICE
#
# Discus is copyright (c) 2002 by DiscusWare, LLC, all rights reserved.
# The use of Discus is governed by the Discus License Agreement which is
# available from the Discus WWW site at:
# http://www.discusware.com/discus/license
#
# Pursuant to the Discus License Agreement, this copyright notice may not be
# removed or altered in any way.
#-------------------------------------------------------------------------------
use strict;
use vars qw($GLOBAL_OPTIONS $PARAMS $DCONF);
###
### program_debug_invoke
###
### Begins the debug logging process
###
sub program_debug_invoke {
my ($FORMref, $uname) = @_;
$PARAMS->{debugging_on} = 1;
$PARAMS->{debugging_username} = $uname;
my $filename = program_debug_get_filename();
my $debugdir = join("/", $DCONF->{admin_dir}, "data", "debug");
if (! -e $debugdir) {
if (mkdir($debugdir, oct($DCONF->{perms0777}))) {
chmod(oct($DCONF->{perms0777}), $debugdir);
} else {
error_message("Directory Creation Error", "Could not create debugging directory $debugdir!");
}
}
open (DEBUGOUTFILE, "> $debugdir/$filename.STDOUT") || error_message("Debug Filehandle Create Error", "Could open DEBUGOUTFILE file $filename.STDOUT for writing!");
binmode(DEBUGOUTFILE);
select (DEBUGOUTFILE);
open (STDERR, "> $debugdir/$filename.STDERR") || error_message("Debug Filehandle Create Error", "Could open STDERR file $filename.STDERR for writing!");
binmode(STDERR);
open (FORMFILE, "> $debugdir/$filename.FORM") || error_message("Debug Filehandle Create Error", "Could open file $filename.FORM for writing!");
binmode(FORMFILE);
print FORMFILE "$0\n";
foreach my $key (keys(%{ $FORMref })) {
print FORMFILE join("", $key, "=", escape($FORMref->{$key}), "\n");
}
close (FORMFILE);
open (FORMFILE, "> $debugdir/$filename.COOKIE") || error_message("Debug Filehandle Create Error", "Could open file $filename.COOKIE for writing!");
binmode(FORMFILE);
foreach my $key (keys(%{ $FORMref->{COOKIE} })) {
next if ref $key eq "HASH";
print FORMFILE join("", $key, "=", escape($FORMref->{COOKIE}->{$key}), "\n");
}
close (FORMFILE);
open (FORMFILE, "> $debugdir/$filename.ENV") || error_message("Debug Filehandle Create Error", "Could open file $filename.ENV for writing!");
binmode(FORMFILE);
foreach my $key (keys(%ENV)) {
print FORMFILE join("", $key, "=", escape($ENV{$key}), "\n");
}
close (FORMFILE);
return 1;
}
###
### program_debug_close
###
### Closes the debug logging process and writes STDOUT
###
sub program_debug_close {
my $filename = program_debug_get_filename();
my $debugdir = join("/", $DCONF->{admin_dir}, "data", "debug");
close (DEBUGOUTFILE);
close (STDERR);
select(STDOUT);
$PARAMS->{debugging_on} = 0;
if (open(DEBUGOUTFILE, "< $debugdir/$filename.STDOUT")) {
binmode(DEBUGOUTFILE);
binmode(STDOUT);
while (<DEBUGOUTFILE>) {
print STDOUT;
}
close (DEBUGOUTFILE);
chmod(oct($DCONF->{perms0666}), "$debugdir/$filename.STDOUT");
chmod(oct($DCONF->{perms0666}), "$debugdir/$filename.STDERR");
chmod(oct($DCONF->{perms0666}), "$debugdir/$filename.FORM");
chmod(oct($DCONF->{perms0666}), "$debugdir/$filename.COOKIE");
chmod(oct($DCONF->{perms0666}), "$debugdir/$filename.ENV");
} else {
error_message("Output Error", "Could not read output file $filename.STDOUT");
}
}
###
### program_debug_get_filename
###
### Gets a file name for debugging based on IP address and process ID
###
sub program_debug_get_filename {
my $filename = $ENV{REMOTE_ADDR};
$filename =~ s/\D+/\-/g;
my $pid = $$; $pid =~ s/\D//g;
$filename = join("-", $filename, $pid, $PARAMS->{debugging_username});
return $filename;
}
###
### program_debug_get_debugging_users
###
### Reads global option for users that will be debugged
###
sub program_debug_get_debugging_users {
my ($go) = @_;
return {} if $go eq "";
my $h = {};
foreach my $user (split(/,/, $go)) {
$h->{$user} = 1;
}
return $h;
}
###
### program_debug_admin_interface
###
### Administration interface to let you debug user operations
###
sub program_debug_admin_interface {
my ($FORMref) = @_;
my $result = check_password($FORMref->{username}, undef, { type_required => 'moderator' }, $FORMref->{'COOKIE'});
bad_login( { bad_username => 1 } ) if scalar(@{ $result }) == 0;
bad_login( { superuser_required => 1 } ) if $result->[0]->{user} ne $DCONF->{superuser};
program_debug_lister($FORMref) if $FORMref->{action} eq "debugging";
program_record_delete($FORMref) if $FORMref->{action} eq "debug_form";
program_debug_input($FORMref) if $FORMref->{action} eq "debug_in";
program_debug_errors($FORMref) if $FORMref->{action} eq "debug_err";
program_debug_output($FORMref) if $FORMref->{action} eq "debug_out";
}
###
### program_debug_output
###
### Reproduces an actual output from a user's query
###
sub program_debug_output {
my ($FORMref) = @_;
my $file = $FORMref->{file}; $file =~ s/[^\w\-]//g;
my $debugdir = join("/", $DCONF->{admin_dir}, "data", "debug");
my $subst = {};
if (open(FILE, "< $debugdir/$file.STDOUT")) {
binmode(FILE);
my @file = <FILE>;
close (FILE);
if (grep(/^Content-type:/i, @file)) {
binmode(STDOUT);
@file = grep(!/^Set-Cookie:/i, @file);
if (open(FILE, "< $debugdir/$file.FORM")) {
my @file2 = <FILE>;
close (FILE2);
my @u = grep(/^password=/, @file2);
if ($u[0] =~ /^password=(.*)/) {
my $pass = quotemeta(unescape($1));
foreach my $line (@file) {
$line =~ s/"($pass)"/join('', '"', "x" x length($1), '"')/ge;
}
}
} else {
error_message("File Error", "The requested file, $file.FORM, could not be opened");
}
print STDOUT @file;
program_exit(0);
} else {
$subst->{general}->{username} = $FORMref->{username};
$subst->{general}->{screen} = 2;
$subst->{general}->{output} = join("", @file);
$subst->{general}->{output} =~ s/([<>&])/join("", "", ord($1), ";")/ge;
screen_out("debug02", $subst);
}
} else {
error_message("File Error", "The requested file, $file.STDOUT, could not be opened");
}
}
###
### program_debug_errors
###
### Lists errors occurring from a particular action
###
sub program_debug_errors {
my ($FORMref) = @_;
my $file = $FORMref->{file}; $file =~ s/[^\w\-]//g;
my $debugdir = join("/", $DCONF->{admin_dir}, "data", "debug");
my $subst = {};
$subst->{general}->{username} = $FORMref->{username};
if (open(FILE, "< $debugdir/$file.STDERR")) {
my @file = <FILE>;
close (FILE);
foreach my $line (@file) {
$line =~ s/([<>&])/join("", "", ord($1), ";")/ge;
}
$subst->{general}->{error_log} = join("<br>", @file);
}
$subst->{general}->{screen} = 1;
screen_out("debug02", $subst);
}
###
### program_debug_input
###
### Lists form variables, cookies, and environment variables associated with
### a particular form action
###
sub program_debug_input {
my ($FORMref) = @_;
my $file = $FORMref->{file}; $file =~ s/[^\w\-]//g;
my $debugdir = join("/", $DCONF->{admin_dir}, "data", "debug");
my $subst = {};
$subst->{general}->{username} = $FORMref->{username};
my @fv = ();
my @ck = ();
my @en = ();
if (open(FILE, "< $debugdir/$file.FORM")) {
my @file = <FILE>;
close (FILE);
shift @file;
foreach my $j (@file) {
my ($name, $var) = split(/=/, $j);
chomp $var;
$var = unescape($var);
$var =~ s/([<>&])/join("", "", ord($1), ";")/ge;
$var = join("", "<font color=#ff0000>", "*" x length($var), "</font>") if $name =~ /^pass/;
push @fv, { name => $name, value => $var } if $j =~ /=/;
}
}
if (open(FILE, "< $debugdir/$file.COOKIE")) {
my @file = <FILE>;
close (FILE);
shift @file;
foreach my $j (@file) {
my ($name, $var) = split(/=/, $j);
chomp $var;
push @ck, { name => $name, value => unescape($var) } if $j =~ /=/;
}
}
if (open(FILE, "< $debugdir/$file.ENV")) {
my @file = <FILE>;
close (FILE);
shift @file;
foreach my $j (@file) {
my ($name, $var) = split(/=/, $j);
chomp $var;
push @en, { name => $name, value => unescape($var) } if $j =~ /=/;
}
}
@fv = sort { $a->{name} cmp $b->{name} } @fv;
@ck = sort { $a->{name} cmp $b->{name} } @ck;
@en = sort { $a->{name} cmp $b->{name} } @en;
$subst->{formvars} = \@fv;
$subst->{cookies} = \@ck;
$subst->{env} = \@en;
$subst->{general}->{screen} = 0;
screen_out("debug02", $subst);
}
###
### program_debug_lister
###
### Lists the debugging contents
###
sub program_debug_lister {
my ($FORMref) = @_;
my $subst = {};
$subst->{general}->{username} = $FORMref->{username};
my @i = ();
if (opendir(DIR, "$DCONF->{admin_dir}/data/debug")) {
while (my $file = readdir(DIR)) {
next if $file !~ /\.FORM\s*$/;
my $filename = join("/", "$DCONF->{admin_dir}/data/debug", $file);
$file = $`;
next if ! -f $filename;
my $hash = {};
$hash->{filename} = $file;
my ($ip1, $ip2, $ip3, $ip4, $pid, $user) = split(/\-/, $file, 6);
$hash->{ip_addr} = join(".", $ip1, $ip2, $ip3, $ip4);
my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,$blksize,$blocks) = stat "$DCONF->{admin_dir}/data/debug/$file.STDOUT";
$hash->{'time'} = $mtime;
$hash->{'size'} = int(($size + 500) / 100) / 10;
$hash->{'user'} = $user;
$hash->{file} = $file;
open (FILE, "< $filename");
my @file = <FILE>;
close (FILE);
my $sn = shift @file; chomp $sn;
$sn = $' if $sn =~ /.*[\/\\]/;
$hash->{script} = $sn;
my @k = grep(/^action=/, @file);
$hash->{action} = unescape($1) if $k[0] =~ /^.*?=(.*)/;
$hash->{showerr} = 1 if -s "$filename.STDERR";
push @i, $hash;
}
closedir(DIR);
}
@i = sort { $a->{'time'} <=> $b->{'time'} } @i;
$subst->{traces} = \@i;
screen_out("debug01", $subst);
}
###
### program_record_delete
###
### Deletes a debugging record
###
sub program_record_delete {
my ($FORMref) = @_;
my $debugdir = join("/", $DCONF->{admin_dir}, "data", "debug");
my $pid = $$; $pid =~ s/\D//g;
if ($FORMref->{act} eq "") {
my $file = $FORMref->{del}; $file =~ s/[^\w\-]//g;
if (-e "$debugdir/$file.FORM") {
foreach my $ext ('STDOUT', 'STDERR', 'ENV', 'FORM', 'COOKIE') {
unlink "$debugdir/$file.$ext";
}
}
} elsif ($FORMref->{act} eq "IP") {
my $ip = $FORMref->{del}; $ip =~ s/\D/-/g;
opendir(DIR, "$debugdir");
while (my $file = readdir(DIR)) {
next if ! -f "$debugdir/$file";
next if $file =~ /-$pid-([^\-]+)\.(\w+)$/;
unlink "$debugdir/$file" if $file =~ /^$ip/;
}
closedir(DIR);
} elsif ($FORMref->{act} eq "USER") {
my $ip = $FORMref->{del}; $ip =~ s/\W/-/g;
opendir(DIR, "$debugdir");
while (my $file = readdir(DIR)) {
next if ! -f "$debugdir/$file";
next if $file =~ /-$pid-([^\-]+)\.(\w+)$/;
unlink "$debugdir/$file" if $file =~ /-$ip\.(\w+)$/;
}
closedir(DIR);
}
program_debug_lister($FORMref);
}
1;