home *** CD-ROM | disk | FTP | other *** search
/ rtsi.com / 2014.01.www.rtsi.com.tar / www.rtsi.com / OS9 / FAQ / discus_admin_1357211388 / source / prgdebug.pl < prev    next >
Text File  |  2009-11-06  |  11KB  |  355 lines
  1. # FILE: prgdebug.pl
  2. # DESCRIPTION: For debugging actions by individual users
  3. #-------------------------------------------------------------------------------
  4. # DISCUS COPYRIGHT NOTICE
  5. #
  6. # Discus is copyright (c) 2002 by DiscusWare, LLC, all rights reserved.
  7. # The use of Discus is governed by the Discus License Agreement which is
  8. # available from the Discus WWW site at:
  9. #    http://www.discusware.com/discus/license
  10. #
  11. # Pursuant to the Discus License Agreement, this copyright notice may not be
  12. # removed or altered in any way.
  13. #-------------------------------------------------------------------------------
  14.  
  15. use strict;
  16. use vars qw($GLOBAL_OPTIONS $PARAMS $DCONF);
  17.  
  18. ###
  19. ### program_debug_invoke
  20. ###
  21. ### Begins the debug logging process
  22. ###
  23.  
  24. sub program_debug_invoke {
  25.     my ($FORMref, $uname) = @_;
  26.     $PARAMS->{debugging_on} = 1;
  27.     $PARAMS->{debugging_username} = $uname;
  28.     my $filename = program_debug_get_filename();
  29.     my $debugdir = join("/", $DCONF->{admin_dir}, "data", "debug");
  30.     if (! -e $debugdir) {
  31.         if (mkdir($debugdir, oct($DCONF->{perms0777}))) {
  32.             chmod(oct($DCONF->{perms0777}), $debugdir);
  33.         } else {
  34.             error_message("Directory Creation Error", "Could not create debugging directory $debugdir!");
  35.         }
  36.     }
  37.     open (DEBUGOUTFILE, "> $debugdir/$filename.STDOUT") || error_message("Debug Filehandle Create Error", "Could open DEBUGOUTFILE file $filename.STDOUT for writing!");
  38.     binmode(DEBUGOUTFILE);
  39.     select (DEBUGOUTFILE);
  40.     open (STDERR, "> $debugdir/$filename.STDERR") || error_message("Debug Filehandle Create Error", "Could open STDERR file $filename.STDERR for writing!");
  41.     binmode(STDERR);
  42.     open (FORMFILE, "> $debugdir/$filename.FORM") || error_message("Debug Filehandle Create Error", "Could open file $filename.FORM for writing!");
  43.     binmode(FORMFILE);
  44.     print FORMFILE "$0\n";
  45.     foreach my $key (keys(%{ $FORMref })) {
  46.         print FORMFILE join("", $key, "=", escape($FORMref->{$key}), "\n");
  47.     }
  48.     close (FORMFILE);
  49.     open (FORMFILE, "> $debugdir/$filename.COOKIE") || error_message("Debug Filehandle Create Error", "Could open file $filename.COOKIE for writing!");
  50.     binmode(FORMFILE);
  51.     foreach my $key (keys(%{ $FORMref->{COOKIE} })) {
  52.         next if ref $key eq "HASH";
  53.         print FORMFILE join("", $key, "=", escape($FORMref->{COOKIE}->{$key}), "\n");
  54.     }
  55.     close (FORMFILE);
  56.     open (FORMFILE, "> $debugdir/$filename.ENV") || error_message("Debug Filehandle Create Error", "Could open file $filename.ENV for writing!");
  57.     binmode(FORMFILE);
  58.     foreach my $key (keys(%ENV)) {
  59.         print FORMFILE join("", $key, "=", escape($ENV{$key}), "\n");
  60.     }
  61.     close (FORMFILE);
  62.     return 1;
  63. }
  64.  
  65. ###
  66. ### program_debug_close
  67. ###
  68. ### Closes the debug logging process and writes STDOUT
  69. ###
  70.  
  71. sub program_debug_close {
  72.     my $filename = program_debug_get_filename();
  73.     my $debugdir = join("/", $DCONF->{admin_dir}, "data", "debug");
  74.     close (DEBUGOUTFILE);
  75.     close (STDERR);
  76.     select(STDOUT);
  77.     $PARAMS->{debugging_on} = 0;
  78.     if (open(DEBUGOUTFILE, "< $debugdir/$filename.STDOUT")) {
  79.         binmode(DEBUGOUTFILE);
  80.         binmode(STDOUT);
  81.         while (<DEBUGOUTFILE>) {
  82.             print STDOUT;
  83.         }
  84.         close (DEBUGOUTFILE);
  85.         chmod(oct($DCONF->{perms0666}), "$debugdir/$filename.STDOUT");
  86.         chmod(oct($DCONF->{perms0666}), "$debugdir/$filename.STDERR");
  87.         chmod(oct($DCONF->{perms0666}), "$debugdir/$filename.FORM");
  88.         chmod(oct($DCONF->{perms0666}), "$debugdir/$filename.COOKIE");
  89.         chmod(oct($DCONF->{perms0666}), "$debugdir/$filename.ENV");
  90.     } else {
  91.         error_message("Output Error", "Could not read output file $filename.STDOUT");
  92.     }    
  93. }
  94.  
  95. ###
  96. ### program_debug_get_filename
  97. ###
  98. ### Gets a file name for debugging based on IP address and process ID
  99. ###
  100.  
  101. sub program_debug_get_filename {
  102.     my $filename = $ENV{REMOTE_ADDR};
  103.     $filename =~ s/\D+/\-/g;
  104.     my $pid = $$; $pid =~ s/\D//g;
  105.     $filename = join("-", $filename, $pid, $PARAMS->{debugging_username});
  106.     return $filename;    
  107. }
  108.  
  109. ###
  110. ### program_debug_get_debugging_users
  111. ###
  112. ### Reads global option for users that will be debugged
  113. ###
  114.  
  115. sub program_debug_get_debugging_users {
  116.     my ($go) = @_;
  117.     return {} if $go eq "";
  118.     my $h = {};
  119.     foreach my $user (split(/,/, $go)) {
  120.         $h->{$user} = 1;
  121.     }
  122.     return $h;
  123. }
  124.  
  125. ###
  126. ### program_debug_admin_interface
  127. ###
  128. ### Administration interface to let you debug user operations
  129. ###
  130.  
  131. sub program_debug_admin_interface {
  132.     my ($FORMref) = @_;
  133.     my $result = check_password($FORMref->{username}, undef, { type_required => 'moderator' }, $FORMref->{'COOKIE'});
  134.     bad_login( { bad_username => 1 } ) if scalar(@{ $result }) == 0;
  135.     bad_login( { superuser_required => 1 } ) if $result->[0]->{user} ne $DCONF->{superuser};
  136.     program_debug_lister($FORMref) if $FORMref->{action} eq "debugging";
  137.     program_record_delete($FORMref) if $FORMref->{action} eq "debug_form";
  138.     program_debug_input($FORMref) if $FORMref->{action} eq "debug_in";
  139.     program_debug_errors($FORMref) if $FORMref->{action} eq "debug_err";
  140.     program_debug_output($FORMref) if $FORMref->{action} eq "debug_out";
  141. }
  142.  
  143. ###
  144. ### program_debug_output
  145. ###
  146. ### Reproduces an actual output from a user's query
  147. ###
  148.  
  149. sub program_debug_output {
  150.     my ($FORMref) = @_;
  151.     my $file = $FORMref->{file}; $file =~ s/[^\w\-]//g;
  152.     my $debugdir = join("/", $DCONF->{admin_dir}, "data", "debug");
  153.     my $subst = {};
  154.     if (open(FILE, "< $debugdir/$file.STDOUT")) {
  155.         binmode(FILE);
  156.         my @file = <FILE>;
  157.         close (FILE);
  158.         if (grep(/^Content-type:/i, @file)) {
  159.             binmode(STDOUT);
  160.             @file = grep(!/^Set-Cookie:/i, @file);
  161.             if (open(FILE, "< $debugdir/$file.FORM")) {
  162.                 my @file2 = <FILE>;
  163.                 close (FILE2);
  164.                 my @u = grep(/^password=/, @file2);
  165.                 if ($u[0] =~ /^password=(.*)/) {
  166.                     my $pass = quotemeta(unescape($1));
  167.                     foreach my $line (@file) {
  168.                         $line =~ s/"($pass)"/join('', '"', "x" x length($1), '"')/ge;
  169.                     }
  170.                 }
  171.             } else {
  172.                 error_message("File Error", "The requested file, $file.FORM, could not be opened");
  173.             }
  174.             print STDOUT @file;
  175.             program_exit(0);
  176.         } else {
  177.             $subst->{general}->{username} = $FORMref->{username};
  178.             $subst->{general}->{screen} = 2;
  179.             $subst->{general}->{output} = join("", @file);
  180.             $subst->{general}->{output} =~ s/([<>&])/join("", "&#", ord($1), ";")/ge;
  181.             screen_out("debug02", $subst);
  182.         }            
  183.     } else {
  184.         error_message("File Error", "The requested file, $file.STDOUT, could not be opened");
  185.     }
  186. }
  187.  
  188. ###
  189. ### program_debug_errors
  190. ###
  191. ### Lists errors occurring from a particular action
  192. ###
  193.  
  194. sub program_debug_errors {
  195.     my ($FORMref) = @_;
  196.     my $file = $FORMref->{file}; $file =~ s/[^\w\-]//g;
  197.     my $debugdir = join("/", $DCONF->{admin_dir}, "data", "debug");
  198.     my $subst = {};
  199.     $subst->{general}->{username} = $FORMref->{username};
  200.     if (open(FILE, "< $debugdir/$file.STDERR")) {
  201.         my @file = <FILE>;
  202.         close (FILE);
  203.         foreach my $line (@file) {
  204.             $line =~ s/([<>&])/join("", "&#", ord($1), ";")/ge;
  205.         }
  206.         $subst->{general}->{error_log} = join("<br>", @file);
  207.     }
  208.     $subst->{general}->{screen} = 1;
  209.     screen_out("debug02", $subst);
  210. }
  211.  
  212. ###
  213. ### program_debug_input
  214. ###
  215. ### Lists form variables, cookies, and environment variables associated with
  216. ### a particular form action
  217. ###
  218.  
  219. sub program_debug_input {
  220.     my ($FORMref) = @_;
  221.     my $file = $FORMref->{file}; $file =~ s/[^\w\-]//g;
  222.     my $debugdir = join("/", $DCONF->{admin_dir}, "data", "debug");
  223.     my $subst = {};
  224.     $subst->{general}->{username} = $FORMref->{username};
  225.     my @fv = ();
  226.     my @ck = ();
  227.     my @en = ();
  228.     if (open(FILE, "< $debugdir/$file.FORM")) {
  229.         my @file = <FILE>;
  230.         close (FILE);
  231.         shift @file;
  232.         foreach my $j (@file) {
  233.             my ($name, $var) = split(/=/, $j);
  234.             chomp $var;
  235.             $var = unescape($var);
  236.             $var =~ s/([<>&])/join("", "&#", ord($1), ";")/ge;
  237.             $var = join("", "<font color=#ff0000>", "*" x length($var), "</font>") if $name =~ /^pass/;
  238.             push @fv, { name => $name, value => $var } if $j =~ /=/;
  239.         }
  240.     }
  241.     if (open(FILE, "< $debugdir/$file.COOKIE")) {
  242.         my @file = <FILE>;
  243.         close (FILE);
  244.         shift @file;
  245.         foreach my $j (@file) {
  246.             my ($name, $var) = split(/=/, $j);
  247.             chomp $var;
  248.             push @ck, { name => $name, value => unescape($var) } if $j =~ /=/;
  249.         }
  250.     }
  251.     if (open(FILE, "< $debugdir/$file.ENV")) {
  252.         my @file = <FILE>;
  253.         close (FILE);
  254.         shift @file;
  255.         foreach my $j (@file) {
  256.             my ($name, $var) = split(/=/, $j);
  257.             chomp $var;
  258.             push @en, { name => $name, value => unescape($var) } if $j =~ /=/;
  259.         }
  260.     }
  261.     @fv = sort { $a->{name} cmp $b->{name} } @fv;
  262.     @ck = sort { $a->{name} cmp $b->{name} } @ck;
  263.     @en = sort { $a->{name} cmp $b->{name} } @en;
  264.     $subst->{formvars} = \@fv;
  265.     $subst->{cookies} = \@ck;
  266.     $subst->{env} = \@en;
  267.     $subst->{general}->{screen} = 0;
  268.     screen_out("debug02", $subst);
  269. }
  270.  
  271. ###
  272. ### program_debug_lister
  273. ###
  274. ### Lists the debugging contents
  275. ###
  276.  
  277. sub program_debug_lister {
  278.     my ($FORMref) = @_;
  279.     my $subst = {};
  280.     $subst->{general}->{username} = $FORMref->{username};
  281.     my @i = ();
  282.     if (opendir(DIR, "$DCONF->{admin_dir}/data/debug")) {
  283.         while (my $file = readdir(DIR)) {
  284.             next if $file !~ /\.FORM\s*$/;
  285.             my $filename = join("/", "$DCONF->{admin_dir}/data/debug", $file);
  286.             $file = $`;
  287.             next if ! -f $filename;
  288.             my $hash = {};
  289.             $hash->{filename} = $file;
  290.             my ($ip1, $ip2, $ip3, $ip4, $pid, $user) = split(/\-/, $file, 6);
  291.             $hash->{ip_addr} = join(".", $ip1, $ip2, $ip3, $ip4);
  292.             my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,$blksize,$blocks) = stat "$DCONF->{admin_dir}/data/debug/$file.STDOUT";            
  293.             $hash->{'time'} = $mtime;
  294.             $hash->{'size'} = int(($size + 500) / 100) / 10;
  295.             $hash->{'user'} = $user;
  296.             $hash->{file} = $file;
  297.             open (FILE, "< $filename");
  298.             my @file = <FILE>;
  299.             close (FILE);
  300.             my $sn = shift @file; chomp $sn;
  301.             $sn = $' if $sn =~ /.*[\/\\]/;
  302.             $hash->{script} = $sn;
  303.             my @k = grep(/^action=/, @file);
  304.             $hash->{action} = unescape($1) if $k[0] =~ /^.*?=(.*)/;
  305.             $hash->{showerr} = 1 if -s "$filename.STDERR";
  306.             push @i, $hash;
  307.         }
  308.         closedir(DIR);
  309.     }
  310.     @i = sort { $a->{'time'} <=> $b->{'time'} } @i;
  311.     $subst->{traces} = \@i;
  312.     screen_out("debug01", $subst);
  313. }
  314.  
  315. ###
  316. ### program_record_delete
  317. ###
  318. ### Deletes a debugging record
  319. ###
  320.  
  321. sub program_record_delete {
  322.     my ($FORMref) = @_;
  323.     my $debugdir = join("/", $DCONF->{admin_dir}, "data", "debug");
  324.     my $pid = $$; $pid =~ s/\D//g;
  325.     if ($FORMref->{act} eq "") {
  326.         my $file = $FORMref->{del}; $file =~ s/[^\w\-]//g;
  327.         if (-e "$debugdir/$file.FORM") {
  328.             foreach my $ext ('STDOUT', 'STDERR', 'ENV', 'FORM', 'COOKIE') {
  329.                 unlink "$debugdir/$file.$ext";
  330.             }
  331.         }
  332.     } elsif ($FORMref->{act} eq "IP") {
  333.         my $ip = $FORMref->{del}; $ip =~ s/\D/-/g;
  334.         opendir(DIR, "$debugdir");
  335.         while (my $file = readdir(DIR)) {
  336.             next if ! -f "$debugdir/$file";
  337.             next if $file =~ /-$pid-([^\-]+)\.(\w+)$/;
  338.             unlink "$debugdir/$file" if $file =~ /^$ip/;
  339.         }
  340.         closedir(DIR);
  341.     } elsif ($FORMref->{act} eq "USER") {
  342.         my $ip = $FORMref->{del}; $ip =~ s/\W/-/g;
  343.         opendir(DIR, "$debugdir");
  344.         while (my $file = readdir(DIR)) {
  345.             next if ! -f "$debugdir/$file";
  346.             next if $file =~ /-$pid-([^\-]+)\.(\w+)$/;
  347.             unlink "$debugdir/$file" if $file =~ /-$ip\.(\w+)$/;
  348.         }
  349.         closedir(DIR);
  350.     }
  351.     program_debug_lister($FORMref);    
  352. }
  353.  
  354. 1;
  355.