#!/usr/bin/perl

$ver="1.21";
print "Content-type: text/html\n\n";
$SN=$ENV{'SCRIPT_NAME'};
$FP="pipwd.pwd";
close(STDERR);
$|=1;
if($ENV{'QUERY_STRING'}){&Q;}
else{$q{f}="main";}

use Socket;
use Sys::Hostname;

if(-e "$FP") {
open(F,"<$FP") || P("Can't read file $!\n");
$p=<F>;
close F;
if($q{p}){
if(crypt($q{p}, "df") ne $p){prot("Access denied", 1);}
}else{prot("", 1);}
}

*cf=$q{f};
&cf(); 

&footer;
exit();

sub npsw{
prot("Passwords not identical") if($q{np} ne $q{r});
open(F,">$FP") || P("Can't write file $!\n");
print F crypt($q{p}=$q{np}, "df");
close F;
&main;
}

sub prot{
my($m, $l)=@_;
&head;
my $f;
P("<br><CENTER><div align=center><p><font face=Verdana size=2 color=red><b>$m</b></font></p><form action=$SN method=GET>");
T(2,"Access verification",300);
P(R("Password","<input type=password name=".($l?'':'n')."p size=12 maxlength=8>"));
if(!$l){P(R("Retype","<input type=hidden name=p value='$q{p}'><input type=password name=r size=12 maxlength=8>")); $f="npsw";}
else {$f="main";}
P(Z("<input type=hidden name=f value=$f><input type=submit value=\"Submit\">",2,2)."</table></div></body></html>");
exit();
}

sub proc{
$s="ps aux";
$s.=" -U $q{u}" if($q{u});
P("<pre>".`$s`);
exit();
}

sub dev {
P("<pre>$s".G('pci'));
exit();
}

sub main {
&M;
$s=$ENV{'DOCUMENT_ROOT'};
if($s){
if($^O ne "MSWin32"){
$d=int(`du -ks $s`)." KB";
}else{
if($q{c}) {
$d=0;
use File::Find;
sub g{ $d+=(stat($s))[2] if(!-d($File::Find::name));}
find(\&g,$s);
$d=sprintf "%.1f KB",$d/1024;
}else{ 
$d=A("calculate","f=main&c=1",1);
}
}}

T(2,"Main Information");
P(Z("Server Information",1,2).
R("Operation System",$^O,1,2,"24%","76%").
R("Host Name",hostname()).
R("Server Name",$ENV{'SERVER_NAME'}).
R("Server IP",$ENV{'SERVER_ADDR'}).
R("Local Time",scalar(localtime($^T))).
R("GMT Time","".gmtime()).
R("Server Software",$ENV{'SERVER_SOFTWARE'}).
R("Document Root",$s).
R("Disk Usage by Root",$d) );

P(R("Perl Version:",$]));
P(R("Crypt:",((crypt("df","df") ne "dfjbcW0cNOvkQ")?"Not ":"")."Standart"));
if($^O eq "linux"){$s=(split(/\n/, `/lib/libc.so.6`))[0];}
elsif($^O eq "freebsd"){$s=(-e "/usr/lib/libc.so.4")? "4.x":"Not found";}
else{$s="N/A";}
@f=split('/',$ENV{'SCRIPT_NAME'});
($m,$u,$g)=(stat($f[$#f]))[2,4,5];

P(R("C++ Library:", $s).Z("Attribute and Permissions",1,2).
R("User:","$< (".gu($<).")").
R("Group:","$( (".gg($().")").
R("Script Owner User:",$u." (".gu($u).")").
R("Script Owner Group:",$g." (".gg($g).")").
R("File Permissions:",FM($m))
);

sub W{
my $b=shift;
join("<BR>\n", (grep {/$b$/} split(" ",`whereis -b $b`)));
}

$l="Location of";
P(Z("System Paths",1,2).
R("Script Path:",`pwd`).
R("$l Sendmail:",W("sendmail")).
R("$l Apache:",W("httpd")).
R("$l MySQL:",W("mysql")).
R("$l htpasswd:",W("htpasswd")).
R("$l Perl:",W("perl")).
R("$l Mail:",W("mail")).
R("Directories of Perl modules:",join("<BR>", @INC)).
R("$l Tar:",W("tar")).
R("$l GZip:",W("gzip")).
R("$l Zip:",W("zip")));

$o=$p=$d=$c=$m=$s="";

if($^O ne "MSWin32") {
$v=G('version');
$s=G('uptime');
@O=split(" ",$s);
$o="".gmtime(time-$O[0]);
$w=`who`;
$c=G('cpuinfo');
$m=G('meminfo');
$s=`df`;
$s=~s/  / &nbsp;/g;
$s=~s/\n/<br>\n/g;
$d=G('pci');
$p=`ps aux`;
}else{$v=`ver`;}

P(Z("Server Details",1,2).
R("Operation System:",$v).
($o?R("Last reboot time:",$o):"").
($o?R("Average server usage:", $O[0]? sprintf("%.2f%%",(1-$O[1]/$O[0])*100): "N/A"):"").
($w?R("Working users (who):","<PRE>$w"):"").
($p?R("Processes",A("view all",0,1,"'proc',''")." ".A("view my processes",0,1,"'proc','".gu($<)."'")):"").
($c?R("CPU:",$c):"").
($m?R("Memory:",$m):"").
($s?R("Disk Usage:","<font face='Courier New'>$s</font>",1,0):"").
($d?R("Devices:",A("view devices",0,1,"'dev',''")):"").
"</table>");
}

sub plib {
&M;
T(3,"Installed Perl Modules");
use File::Find;
for $b(@INC){ find(\&mod, $b);}

@L=sort { lc($a) cmp lc($b) }@L;
sub mod {
$File::Find::prune = 1, return if
exists $p{$File::Find::dir} and $File::Find::dir ne $b; 
my $m=substr $File::Find::name, length $b;
return unless $m=~s/\.pm$//;
$m=~s!^/+!!;
$m=~s!/!::!g;
push (@L,$m);
}

for($i=0;$i<=$#L;$i+=3){
P("<TR>".D($L[$i],2,120).D($L[$i+1],2,120).D($L[$i+2],2,120)."</TR>\n");
}
$#L++;
P("<TR><td colspan=3 align=left class=s1>&nbsp; Found $#L Perl Modules</td></tr></table>");
}

sub signl {
&M;
T(8,"Signals");
@sg=sort((keys %SIG));
for($i=0;$i<=$#sg;$i+=3){
P("<TR>".D($sg[$i],1,120).D("$SIG{$sg[$i]}&nbsp;",2,126).D('',0,3).
D($sg[$i+1],1,120).D("$SIG{$sg[$i+1]}&nbsp;",2,126).D('',0,3).
D($sg[$i+2],1,120).D("$SIG{$sg[$i+2]}&nbsp;",2,126).D('',0,3).
"</TR>\n");
}
P("</table>");
}

sub env {
&M;
T(2,"Variables");
P(Z("Environment Variables",1,2));
foreach $v(sort(keys(%ENV))){
$ENV{$v}=~s/;/;\n/g if($v eq "PATH");
P(R($v,$ENV{$v},1,2,195,550));
}

if($ENV{'CONTENT_LENGTH'}>0){
P(Z("Post Data",1,2));
$b="";
read(STDIN,$b,$ENV{'CONTENT_LENGTH'});
$b=~ s/&/&amp;/g; $b=~s/</&lt;/g; $b=~s/>/&gt;/g;
P(Z($b,2,2));
}


$s="</TR><TR>";
P("</table><table width=745 cellspacing=1 cellpadding=3 border=0>".
Z("Other Variables",1,3).
"<TR>".D("\$0",1,40).D("Contains the name of the file containing the perl script being executed",3,360).D($0,2,350).$s.
D("\$^T",1).D("The time at which the script began running, in seconds since the epoch",3).D("$^T (".scalar(localtime($^T)).")",2).$s.
D("\$&lt",1).D("The real uid of this process",3).D(gu($<)." $<",2).$s.
D("\$>",1).D("The effective uid of this process",3).D(gu($>)." $>",2).$s.
D("\$(",1).D("The real gid of this proces",3).D(gg($()." $(",2).$s.
D("\$)",1).D("The effective gid of this process",3).D(gg($))." $)",2).$s.
D("\$\$",1).D("The process number of the perl running this script",3).D("$$",2).$s.
D("\$-",1).D("The number of lines left on the page of the currently selected output channel",3).D("$-",2).$s.
D("\$!",1).D("Fields the current value of errno",3).D("$!",2).$s.
D("\$%",1).D("The current page number of the currently selected output channel",3).D("$%",2).$s.
D("\$?",1).D("The status returned by the last pipe close, backtick (``) command or system operator",3).D("$?",2).$s.
D("\$\~",1).D("The name of the current report format for the currently selected output channel",3).D($~,2).$s.
D("\$^",1).D("The name of the current top-of-page format for the currently selected output channel",3).D("$^",2).$s.
D("\$^F",1).D("The maximum system file descriptor, ordinarily",3).D("$^F",2).$s.
D("\$^I",1).D("The current value of the inplace-edit extension",3).D("$^I",2).$s.
D("\$^L",1).D("What formats output to perform a formfeed",3).D(unpack('c',$^L),2).$s.
D("\$^P",1).D("The internal flag that the debugger clears so that it doesn't debug itself",3).D("$^P",2).$s.
D("\$^W",1).D("The current value of the warning switch",3).D("$^W",2).$s.
D("\$^D",1).D("The current value of the debugging flags",3).D("$^D",2).$s.
D("\$|",1).D("If set to nonzero, forces a flush after every write or print on the currently selected output channel",3).D("$|",2).$s.
D("\$=",1).D("The current page length (printable lines) of the currently selected output channel.Default is 60",3).D("$=",2).
"$s</table>");
}

sub user {
&M;
T(2,"User Information");
P(Z("User Information",1,2).R("User Agent",$ENV{'HTTP_USER_AGENT'},1,2,195,550));

$a=$ENV{'HTTP_USER_AGENT'};
$s="";
if($a=~/win/i) {
$s="95" if($a=~/win95/i || $a=~/windows 95/i);
$s="98" if($a=~/win98/i || $a=~/windows 98/i);
$s="ME" if($a=~/win 9x 4.90/i);
$s="NT" if($a=~/winnt/i || $a=~/windows nt/i);
$s="2000" if($a=~/windows nt 5.0/i);
$s="XP" if($a=~/windows nt 5.1/i);
if($s) { $s="Windows ".$s; }
else { $s="Unknown Windows"; }
} else {
$s="Linux" if($a=~/linux/i);
$s="Unix" if($a=~/x11/i);
$s="Mac" if($a=~/mac/i);
$s="an unknown operating system" if($s);
}

$b="";
if ($INPUT{'log'}) {&log;}
elsif ($INPUT{'del'}) {&del;}
if($a=~/konqueror/i) {$b="Konqueror";}
elsif($a=~/safari/i) {$b="Safari";}
elsif($a=~/omniweb/i) {$b="OmniWeb";}
elsif($a=~/k-meleon/i) {$b="K-Meleon";}
elsif($a=~/webtv/i) {$b="WebTV";}
elsif($a=~/icab/i) {$b="iCab";}
elsif($a=~/msie/i) {$b="Internet Explorer";}
elsif($a!=~/compatible/i) {$b="nc";}
$'=~/[0-9]\.[0-9]/;
$v=$&;

print qq~
<TR><TD class=s1>Operation system</td><td class=s2>$s
<SCRIPT Language="JavaScript"><!--
document.write(navigator.systemLanguage? navigator.systemLanguage.toUpperCase(): "");
document.write(navigator.appMinorVersion? " &nbsp; Service Pack: "+navigator.appMinorVersion: "");
//--> </SCRIPT>
</td></tr>
<SCRIPT Language="JavaScript"><!--
if (typeof(navigator.cpuClass)!="undefined") {
var c;
c=navigator.cpuClass;
switch(c){
case "x86" : s="x86 Compatible processor (Intel, AMD, Cyrix, etc...)"; break;
case "Alpha" : s="Digital processor"; break;
case "68K" : s="Motorola processor"; break;
case "PPC" : s="Motorola processor"; break;
case "Other" : s="Other CPU classes, including Sun SPARC"; break;
}
} else
s="Property not supported or blank!";
pr("CPU", (c?c+" - ":"")+s);
var v="$v";
var b="$b";
var ua=navigator.userAgent.toLowerCase();
if(b=="K-Meleon") {
var q=ua.match(/k-meleon ([\\w.]+)/);
if(q){ q=q[0]; v=q.substr(3); }
}

if(b=="nc") {
b="Netscape Navigator";
var nv=navigator.appVersion;
v=nv.substring(nv.indexOf(".")+1, nv.indexOf(" "));
v=nv.substring(0,nv.indexOf(" "));		
if(typeof(navigator.product)!="undefined"){
b="Mozilla";
q=ua.match(/(Mozilla Firebird)\\/([\\w|\\+.]+)/);
if(q){b=q[1]; v=q[2];}
else{q=ua.match(/rv:([\\w|\\+.]+)/);
if(q){q=q[0]; v=q.substr(3);}
}
}
}
if(!b) { b="An unknown browser"; }

var s="";
if(b) s+=b;
if(v) s+=" "+v;
if(s) s=s+" "+(navigator.browserLanguage? navigator.browserLanguage.toUpperCase():"");
s=(s)?s:"Unable to detect!";
~;

if($b eq "Internet Explorer" ) {
print qq~
document.write("<div id=\\"o\\" style=\\"behavior:'url(#default#clientCaps)'\\"></div>");
w=o.getComponentVersion("{89820200-ECBD-11CF-8B85-00AA005B4383}","componentid");
if(w) s=s+" (ver:"+w+")";
~;
}
P("pr(\"Browser Name\",s);
// --></script>
<tr><td class=s1>User IP:</td><td class=s2>$ENV{'REMOTE_ADDR'}</td></tr>");

$s="$ENV{'HTTP_X_FORWARDED_FOR'} $ENV{'HTTP_VIA'} $ENV{'HTTP_FORWARDED'} $ENV{'HTTP_PROXY_CONNECTION'}";
$s="N/A" if($s eq "   ");

P(R("User Proxy:",$s).
R("Accept Language","$ENV{'HTTP_ACCEPT_LANGUAGE'}&nbsp;").
R("Cookie:","$ENV{'HTTP_COOKIE'}&nbsp;").
R("Referrer:","$ENV{'HTTP_REFERER'}&nbsp;"));
print qq~
<SCRIPT Language="JavaScript"><!--
var D = new Date();
pr("Time and Date",D);
pr("Screen", "Resolution: "+window.screen.width+"x"+window.screen.height+" &nbsp;  Color: "+window.screen.colorDepth+"bit");
s=o.connectionType;
switch (s) {
case "lan" : s+=" - You are connected via a network"; break;
case "modem" : s+=" - You are connected via a modem"; break;
case "offline" : s+=" - You are working offline"; break;
}
pr("Connection Type", s);
pr("JavaEnabled", (navigator.javaEnabled()==true)?"True":"False");
pr("CookiesEnabled", (navigator.cookieEnabled==true)?"True":"False");
//--> </SCRIPT>
</table>
~;
}

sub P{ print @_; }

sub T{
my($r,$s,$w)=@_;
$w=745 if(!$w);
print "<table width=$w cellspacing=1 cellpadding=3 border=0>
<TR><td colspan=$r bgcolor=#ff9900 align=left><font size=2 color=#000000 face=Verdana><b>&nbsp; $s</b></font></td></tr>";
}

sub D{
my($s,$c,$w)=@_;
$w=" WIDTH=$w" if($w);
$c="class=s$c" if($c);
"<TD$w valign=top $c>$s</td>";
}
sub R{
my($s1,$s2,$c1,$c2,$w1,$w2)=@_;
$c1=1 if(!$c1);
$c2=2 if(!$c2);
"<TR>".D($s1,$c1,$w1).D($s2,$c2,$w2)."</TR>\n";
}
sub Z{
my($s,$c,$n)=@_;
"<tr><td align=center class=s$c colspan=$n>$s</td></tr>";
}
sub A{
my($s,$q,$c,$h)=@_;
$c=" class=a$c" if($c);
"<a $c href=".(($h)?"\"javascript:win($h);\"":"$SN?".(($q{p} ne "")?"p=$q{p}&":""))."$q".">$s</a>";
}
sub M{
&head;
P("<table border=0 cellpadding=3 cellspacing=0 style=\"border-collapse:collapse\" width=100% bgcolor=#21231B><tr>".
D("&nbsp;","","10%").D("<font face=Impact color=#727272 size=4>DF Perl Informer  $ver</font>","","60%").
D(A("protect","f=prot",1),"","30%")."</tr></table>");

sub C{ ($q{f} eq @_[0])?5:4; }

P("<table cellspacing=0 cellpadding=0 border=0 width=800 align=center>
<tr><td valign=top height=10><br>
<table cellspacing=0 cellpadding=3 border=0 width=100% height=20>
<tr align=center>\n".
D("","",50).
D("&nbsp;".A("Main&nbsp;Information","f=main",'')."&nbsp;",&C('main'),125).D("","",5).
D("&nbsp;".A("User&nbsp;Information","f=user",'')."&nbsp;",&C('user'),125).D("","",5).
D("&nbsp;".A("Environments","f=env",'')."&nbsp;",&C('env'),125).D("","",5).
D("&nbsp;".A("Perl&nbsp;Modules","f=plib",'')."&nbsp;",&C('plib'),125).D("","",5).
D("&nbsp;".A("Signals","f=signl",'')."&nbsp;",&C('signl'),125).D("","",50).
"</tr></table>
</td></tr>
<tr><td height=2 bgcolor=#FF9900><img width=1 height=1></td>
</tr><tr>
<td align=center valign=top bgcolor=#21231B>
<br>");
}

sub head{

sub S{
my ($n,$s,$b,$c,$w)=@_;
$b="BACKGROUND-COLOR:$b;" if($b);
$w="font-weight:bold;" if($w);
$c="COLOR:$c;" if($c);
"$n { font-family:verdana; font-size:$s pt;$b$c$w }\n";
}
P("<HTML><HEAD><TITLE>DF Perl Informer $ver</TITLE>
<style type=\"text/css\"> <!--".
S("TD.s4",12,"#DCDCDC"). 
S("TD.s5",12,"#FF9900").
S("TD.s1",10,"#555555","",1).
S("TD.s2",10,"#454545","#c0c0c0",0).
S("TD.s3",8,"#454545","",0).
S("A",11,"","#000000",1).
S("A.a1",11,"","#C0C0C0",1).  #59a6a4
"-->
</style>");

print qq~
<SCRIPT Language=JavaScript>
//<!--
function pr(p,v){
document.write("<tr><td class=s1>"+p+"</td><td class=s2>"+v+"</td></tr>");     
}
function win(w,u) {
window.open("$SN?p=$q{p}&f="+w+"&u="+u,w,"scrollbars=1,width=800,height=700,status=0,menubar=0");
}
//-->
</SCRIPT>
</HEAD>
<body bgColor=#727272 text=#FFFFFF leftmargin=0 topmargin=0 MARGINWIDTH=0 MARGINHEIGHT=0>~;
}

sub footer {
P("<br></td></tr></table><center>
<b><font face=Verdana size=1>Powered By</font><a href=http://www.dfservice.com/ target=_blank style=\"text-decoration: none\">
<font face=Verdana size=1>DF&#153;</font></a></b>");
}

sub gg {
my $g="";
for(split(/ /,$_[0])){ $g.=" " if($g ne ""); eval{$g.=(getgrgid($_))[0];}; }
$g;
}
sub gu {
my $u="";
eval{$u=(getpwuid($_[0]))[0];};
$u;
}
sub FM{
$m=shift;
@p=qw(--- --x -w- -wx r-- r-x rw- rwx);
@c=qw(. p c ? d ? b ? - ? l ? s ? ? ?);
$c[0]='';
$i=($m&07000)>>9;
@s=@p[($m&0700)>>6,($m&0070)>>3,$m&0007];
$c=$c[($m&0170000)>>12];
@c=$opts{no_ftype}?():($c);
if($i){
$s[2]=~s/([-x])$/$1 eq 'x'?'t':'T'/e if($i&01);
$s[0]=~s/([-x])$/$1 eq 'x'?'s':'S'/e if($i&04);
$s[1]=~s/([-x])$/$1 eq 'x'?'s':'S'/e if($i&02);
}
$ps=join(' ',@c,@s);
$ps.=sprintf " (%04lo)",($m&07777);
}

sub G{
open(F,"</proc/$_[0]") || return 0;
$q=join("<BR>",<F>);
close F;
$q;
}

sub Q{
for(split(/&/,$ENV{'QUERY_STRING'})){
($n,$v)=split(/=/,$_);
$v=~s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
$q{$n}=$v;
}
}