#!/usr/bin/perl -U
#
# v0.01m (c)mahatma, no warranty
use CGI qw(:standard);
use CGI::Carp qw(fatalsToBrowser);
# optional:
#use MD5; my $use_md5=1; # uncomment to use faster MD5 lib

my $cgi = new CGI;

my $session="$ENV{REMOTE_ADDR} $ENV{HTTP_X_FORWARDED_FOR}";

umask 0177;

### config start
##   $auth - password: 0-none/.htpasswd; 1:crypt; 2:unencrypted; 3:md5
## 2,3 - additionally md5 hashed
my $auth=0;
## don't touch this (better):
my ($user,$password,@sig) = $auth==0?($ENV{REMOTE_USER},''):login_get();
my $passwd="";	# passwords filename ($auth!=0)
my %hpasswd;    # predefined or buffer
## you may use own password database (undef $passwd first):
#dbmopen(%hpasswd,'/etc/dbpasswd/dbpasswd',600);
## or you may enter own login:
#$hpasswd{'user'}='password';
my $base="./";
my $webbase="/";
my $iam=$ENV{SCRIPT_NAME};
my $secure=0;		# 0:none; 1:uid/gid; 2:1+deny chown/chmod
my @suid;
## for upload:
#$cgi::POST_MAX = 1048576;		# max to upload
#my $temp='/tmp/'; 			# undef = direct
#my $mv='/bin/mv';			# if $temp defined only
### config end

### alt config - standard multi-user unix hosting example, exec as root
#my $auth=1; 
#my ($user,$password,@sig) = $auth==0?($ENV{REMOTE_USER},''):login_get();
#my $passwd="/etc/shadow";
#my %hpasswd;
#my $base="/home/$user/public_html/";
#my $webbase="/~$user/";
#my $iam=$ENV{SCRIPT_NAME};
#my $secure=1;
#my @suid=($user,$user);
##$cgi::POST_MAX = 1048576;
##my $temp='/tmp/';
##my $mv='/bin/mv';
### alt config end

my @md5_i=(0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,1,6,11,0,5,10,15,4,9,14,3,8,13,2,7,12,5,8,11,14,1,4,7,10,13,0,3,6,9,12,15,2,0,7,14,5,12,3,10,1,8,15,6,13,4,11,2,9);
my @md5_s=(7,12,17,22,5,9,14,20,4,11,16,23,6,10,15,21);
my @md5_t=(0xd76aa478,0xe8c7b756,0x242070db,0xc1bdceee,0xf57c0faf,0x4787c62a,0xa8304613,0xfd469501,0x698098d8,0x8b44f7af,0xffff5bb1,0x895cd7be,0x6b901122,0xfd987193,0xa679438e,0x49b40821,0xf61e2562,0xc040b340,0x265e5a51,0xe9b6c7aa,0xd62f105d,0x02441453,0xd8a1e681,0xe7d3fbc8,0x21e1cde6,0xc33707d6,0xf4d50d87,0x455a14ed,0xa9e3e905,0xfcefa3f8,0x676f02d9,0x8d2a4c8a,0xfffa3942,0x8771f681,0x6d9d6122,0xfde5380c,0xa4beea44,0x4bdecfa9,0xf6bb4b60,0xbebfbc70,0x289b7ec6,0xeaa127fa,0xd4ef3085,0x04881d05,0xd9d4d039,0xe6db99e5,0x1fa27cf8,0xc4ac5665,0xf4292244,0x432aff97,0xab9423a7,0xfc93a039,0x655b59c3,0x8f0ccc92,0xffeff47d,0x85845dd1,0x6fa87e4f,0xfe2ce6e0,0xa3014314,0x4e0811a1,0xf7537e82,0xbd3af235,0x2ad7d2bb,0xeb86d391);

#push (@INC, "/home/~$user");
#$ENV{PATH}="/home/~$user";
my $header="Content-type: text/html\n\n";
my $head='<html><head><meta http-equiv="Content-Script-Type" content="text/javascript">';
my $error;
my $path=param('path')||'';
my $action=param('action')||'start';
my @item;
my $lastpath='';
my $it;
for(my $i=0;$i<65535 && defined($it=param("item$i")) && $it ne '';$i++){
 push @item,param("item$i");
};

### install ###
install() if($ARGV[0] eq install);
if($action eq 'menu'){a_menu();ex(0)}
elsif($action eq 'start'){a_start();ex(0)}
### /install ###
if(!login()){
 $error.='Invalid login<br>' if($user ne '');
 $error.='Not logged in!';
 $user=$password='';
 @item=();
 a_ls();
 ex(-2);
}
seq() if($secure>0);
if($action eq 'ls' || $action eq 'reload'){a_lsd()}
elsif($action eq 'get'){a_get()}
elsif($action eq 'upload'){a_upload()}
elsif($action eq 'delete'){a_rm()}
elsif($action eq 'mkdir'){a_mkdir()}
elsif($action eq 'chmod'){a_chmod()}
elsif($action eq 'chown'){a_chown()}
elsif($action eq 'link'){a_link()}
elsif($action eq 'symlink'){a_symlink()}
elsif($action eq 'logoff'){a_logoff()}
else{zerr("Invalid command \"$action\"")}

ex(0);

### login ###
sub login_get(){
return split(/:/,param('sig'));
}

sub login_js(){
my $t='p';
$t="md5h($t)" if($auth==3);
$t="md5h($t+t+s)" if($auth!=0);
return qq(
var sig='';
function setpass(p,t,s){sig=fm1.document.f.item0.value+':'+$t+':'+t}
function sign(f){f.sig.value=sig}
function logoff(){sig=''}
)
}

sub login(){
return 1 if($auth==0);
my $u,$p,$l;
if(defined($passwd)){
 open PF,"<$passwd" or return 0;
 while(defined($l=<PF>)){
  ($u,$p)=(split(/:/, $l))[0,1];
  if($u eq $user){
   $hpasswd{$u}=$p;
   last;
  }
 }
 close(PF);
}
return 0 if(!defined($p=$hpasswd{$user}));
if($auth==1){
 $password=crypt($password,$p)
}else{
 $p=md5h("$p@sig[0]$session");
}
return ($password eq $p);
}

sub logoff(){
@sig=[];
$user=$password='';
}
### /login ###

### md5
sub md5h(){
my ($s,$a,$b,$c,$d,$xx)=(shift,0x67452301,0xefcdab89,0x98badcfe,0x10325476,0xffffffff);
return MD5->hexhash($s) if($use_md5);
my $e,$m,$i,$j,@x;
my $l=length($s);
my $n=((($l+8)>>6)+1)<<4;
$xx++;
for($i=0;$i<$n;$i++) {@x[$i]=0}
$s.="\x80";
for($i=0;$i<=$l;$i++) {@x[$i>>2]|=(ord(substr($s,$i,1))&0xFF)<<(($i&3)<<3)}
@x[$n-2]=$l<<3;
for($i=0;$i<$n;$i+=16){
 my ($a1,$b1,$c1,$d1)=($a,$b,$c,$d);
 for($j=0;$j<64;$j++){
  $e=(((($m=($a+@x[$i+@md5_i[$j]]+@md5_t[$j]+(($e=$j>>4)==0?($b&$c)|($d&~$b):$e==1?($b&$d)|($c&~$d):$e==2?$b^$c^$d:$c^($b|~$d)))%$xx)<<($l=@md5_s[$e<<2|($j&3)]))|($m>>(32-$l))&((1<<$l)-1))+$b)%$xx;
    $a=$d;$d=$c;$c=$b;$b=$e;
 }
 $a=($a+$a1)%$xx;$b=($b+$b1)%$xx;$c=($c+$c1)%$xx;$d=($d+$d1)%$xx;
}
my @r=($a,$b,$c,$d),$h='';
for($i=0;$i<16;$i++) {$h.=sprintf("%x%x",@r[$j=$i>>2]>>4&15,@r[$j]&15);@r[$j]>>=8;}
return $h;
}

sub a2js(){
my ($f,$s,$c)=(shift,'[','');
for my $x(@_){
 $s.=$c.sprintf($f,$x);
 $c=',';
}
return "$s]";
}

sub md5h_js(){
return "var md5_i=".&a2js("%u",@md5_i).",\nmd5_s=".&a2js("%u",@md5_s).",\nmd5_t=".&a2js("0x%x",@md5_t).qq(,nums='0123456789abcdef'.split('');

function s32(x,y){
 var l=(x&0xFFFF)+(y&0xFFFF);
 return (((x>>16)+(y>>16)+(l>>16))<<16)|(l&0xFFFF);  
}

function md5h(s){
var a=0x67452301,b=0xefcdab89,c=0x98badcfe,d=0x10325476,e,m,l=s.length,n=(((l+8)>>6)+1)<<4,i,j,x=[];
for(i=0;i<n;i++) x[i]=0;
for(i=0;i<l;i++) x[i>>2]|=(s.charCodeAt(i)&0xFF)<<((i&3)<<3);
x[i>>2]|=0x80<<((i&3)<<3);
x[n-2]=l<<3;
for(i=0;i<n;i+=16){
 var a1=a,b1=b,c1=c,d1=d;
 for(j=0;j<64;j++){
  e=s32((((m=s32(s32(a,((e=j>>4)==0?(b&c)|(d&~b):e==1?(b&d)|(c&~d):e==2?b^c^d:c^(b|~d))),s32(x[i+md5_i[j]],md5_t[j])))<<(l=md5_s[e<<2|(j&3)]))|(m>>>(32-l))),b);
  a=d;d=c;c=b;b=e;
 }
 a=s32(a1,a);b=s32(b1,b);c=s32(c1,c);d=s32(d1,d);
}
var r=[a,b,c,d],h='';
for(i=0;i<16;i++) {h+=nums[r[j=i>>2]>>4&15]+nums[r[j]&15];r[j]>>=8;}
return h;
}
);
}
# suggested (not sure):
# "e=s32..."->  e=(((m=a+((e=j>>4)==0?(b&c)|(d&~b):e==1?(b&d)|(c&~d):e==2?b^c^d:c^(b|~d))+x[i+md5_i[j]]+md5_t[j])<<(l=md5_s[e<<2|(j&3)]))|(m>>>(32-l)))+b;
# "a=s32..."-> a+=a1;b+=b1;c+=c1;d+=d1;
# and remove "s32" func
### /md5


sub err_(){
my $e=shift;
return "$!; $action \"$e\"<br>";
}

sub ex(){
exit shift;
}

sub seq(){
my $u=defined(@suid[0])?(getpwnam(@suid[0]) or &zerr("uid:\"@suid[0]\"")):-1;
my $g=defined(@suid[1])?(getgrnam(@suid[1]) or &zerr("gid:\"@suid[1]\"")):-1;
$)="$g $g"; $(=$g; $<=$>=$u;
if($) ne "$g $g" or $(!=$g or $<!=$u or $>!=$u){
 print "$header Security error (set uid/gid)";
 &ex(-3);
}
}

sub seq2(){
&zerr('Denyed') if($secure==2);
}

sub chk(){
 my $n=shift;
 $n=~s/%([0-9A-Fa-f]{2})/chr(hex($1))/eg;
 my @d=split(/\//,$n);
 for (my $i=0;$i<=$#d;$i++){
  if(@d[$i] eq '.' or @d[$i] eq ''){
   splice(@d,$i,1);
   $i-- if($i>-1);
  }elsif(@d[$i] eq '..'){
   if($i>0){splice(@d,--$i,2)}
   else{splice(@d,$i,1)};
   $i-- if($i>-1);
  }
 }
 $n='';
 my $f=pop(@d);
 for my $i(@d) {$n.=$i.'/'};
 $n.=$f;
 return $n;
}

sub a_logoff(){
$error.='Logged out!';
logoff();
@item=();
a_ls();
}

sub a_get(){
 for my $it(@item){
  my @s=stat(my $n=$base.(my $i=&chk("$path$it")));
#  err($n) if(!$s);
#  if(-d $n){
  if(@s[2]&0x4000){
   $lastpath=$path;
   $path=$i;
   $path.='/' if($path ne '');
   a_lsd();
  }else{
    open FH,"<$n" or err($it);
    print "Content-type: application/unknown\nContent-Length: @s[7]\nLast-Modified: ".localtime(@s[9])."\nContent-Transfer-Coding: binary\nContent-Disposition: download; filename=\"$it\"\n\n",<FH> or err($it);
    close(FH);
  }
 }
}

sub a_upload(){
 for my $it(@item){
  my @n=split(/[\\\/:]/,$it);
  my $d=&chk($path.pop(@n));
  my $f=defined($temp)?"$temp$user.".time.".tmp":"$base$d";
  open FH, ">$f" or err($it);
#  chown @own[0],@own[1],$f or err($it.rm()) if(defined(@own));
#  binmode FH;
  print FH <$it> or err($it.rm());
  close (FH);
  `$mv -f $f $base$d` if(defined($temp));
 }
 a_lsd();
 sub rm(){
  close FH;
  unlink FH;
  return '';
 }
}

sub a_link(){
for my $its(@item){for my $it(split(/,/,$its)){
 my ($l,$ll)=split(/:/,$it,2);
 link $base.&chk($ll),$base.&chk($l) or &err("$l -> $ll");
}}
a_lsd();
}

sub a_symlink(){
for my $its(@item){for my $it(split(/,/,$its)){
 my ($l,$ll)=split(/:/,$it,2);
 my @l0=split(/\//,&chk($l));
 my @l1=split(/\//,&chk($ll));
 my $n=0;
 my $i;
 for($i=0;($i<=$#l0)&&(@l0[$i] eq @l1[$i]);$i++){ $n++};
 splice(@l0,0,$n);
 splice(@l1,0,$n);
 $ll='';
 my $f=pop(@l1);
 for($i=0;$i<$#l0;$i++) {$ll.='../'};
 for $i(@l1) {$ll.=$i.'/'};
 $ll.=$f;
 symlink $ll,"$base$l" or &err("$l -> $ll");
}}
a_lsd();
}

sub a_mkdir(){
 for my $it(@item){mkdir($base.&chk("$path$it")) or err(&chk("$path$it"))}
 a_lsd();
}

sub a_rm(){
 for my $its(@item){for my $it(split(/,/,$its)){
  my $n=$base.&chk("$path$it");
  if(-l $n) {unlink($n) or err($it)}
  elsif(-d $n) {rmdir($n) or err($it)}
  else{unlink($n) or err($it);}
 }};
 a_lsd();
};

sub a_chmod(){
 seq2();
 for my $its(@item){for my $it(split(/,/,$its)){
  my @it1=split(/:/,$it,2); #### try 1 or 2!!!
  @it1[1]=$base.&chk($path.@it1[1]);
  chmod @it1 or err($it);
 }};
 a_lsd();
};

sub zerr(){
my $e=shift;
$error.="$e<br>";
a_lsd();
&ex(-1);
}

sub a_chown(){
 seq2();
 for my $its(@item){
   my @its1=split(/,/,$its);
   my @u=split(/:/,pop(@its1));
   my @uid;
   if(@u[0] && @u[0] ne '') {($uid=getpwnam(@u[0])) or &zerr(@u[0]);}
   my $gid;
   if(@u[1] && @u[1] ne '') {($gid=getgrnam(@u[1])) or &zerr(@u[1]);}
   for my $it(@its1){
    chown $uid||-1,$gid||-1,$base.&chk("$path$it") or err($it);
   }
 }
 a_lsd();
}

##################################################################
sub err(){
 $error.=&err_(shift||'');
 a_lsd();
 &ex(-1);
}

sub a_lsd(){
 @item=('');
 a_ls();
}

sub esc(){
my $x=shift;
#$x=~s/([\x00-\x29\x2c\x3a-\x3f\x5b-\x5e\x60\x7b-\x7f])/sprintf('%%%02X',ord($1))/eg;
$x=~s/([\x00-\x1f,:\"\'\\])/sprintf('%%%02X',ord($1))/eg;
return $x;
}

sub a_ls(){
my $e='';
my $err;
my $t=qq($header$head
</head><BODY);
my $tt='';
for my $it(@item){
 my @dir=();
 my $n=&chk("$path$it");
 opendir DH,"$base$n" or $err.=&err_($n);
 last if($err);
 @dir=readdir(DH) or $err.=&err_($n);
 my $x='';
 for my $i (@dir){
  if(defined(my @stat=lstat("$base$n$i"))){
   $tt.="$x\n['".&esc("$it$i")."',@stat[7],@stat[9],";
   if($secure==2){
    $tt.=@stat[2]&0xe000;
   }else{
    $tt.="@stat[2],'".getpwuid(@stat[4]).":".getgrgid(@stat[5])."'";
   }
   $tt.=(@stat[2]&0x2000?",'".readlink("$base$n$i")."'":'')."]";
   $x=',';
  }
 }
 closedir(DH);
}
if($err){
 $error.=$err;
 $path=$lastpath;
}elsif($tt ne ''){$ret=qq(parent.loaddir\(db,").&esc($path).qq(","$webbase"\);)};
$ret=qq(parent.click\("ls",""\);) if($ret eq '');
#$error.="Not logged in!" if($user eq '');
if($error){ 
 my $x="<input type=submit value=OK>";
 if($auth!=0 && $user eq ''){
  $ret=qq(parent.click\("ls",""\););
  $x=qq(<br><hr>$session<br>Login:<br><input name="item0" type=input onchange="parent.user=value"><br><input type=password onchange="parent.setpass\(value,).time.qq(,\\'$session\\'\)"><br>$x);
  $t.=" onload='document.f.item0.focus()'";
 }
 $e.=qq(<script>document.write\('<table width=30% height=30% align=center bgcolor=red><tr><th>ERROR[s]</th></tr><tr><tr><th>$error</th></tr><th>'+parent.form\('f','$x','\\'$ret;return false\\''\)\)+'</th></tr></table>'</script>);
}else{$t.=" onload=\'$ret\'";};
$t.="><SCRIPT>\n\ndb=[$tt];\n</SCRIPT>$e</BODY></html>";
print $t;
};

### install ###

#####################################################
sub menu(){
return qq($head</head><BODY onload="parent.drawmenu\(this\)"></BODY></html>);
}

sub a_menu(){
print $header,menu();
};
#####################################################

sub start(){
return qq($head
<title>FM/3</title>
</head>
<SCRIPT>
).&md5h_js().qq(
var
user='',
dir=[],
cgi='$iam',
path='',
webbase='',
error='',
statusline='',
xstate='',
secure=$secure,
linkselect='',
link1='',
linx=[],linx0=[];
).&login_js().qq(

function sel\(i\){
 if(isUndef(fm1.document.f1)) return;
 return fm1.document.f1.elements['chk'+i].checked;
}

function mklist\(\){
var l='',x='';
for\(var i=0;i<dir.length;i++\) if\(sel(i)\) {l+=x+dir[i][0];x=',';};
return l;
}

function chmod\(\){
var l='',x='',m;
 for\(var i=0;i<dir.length;i++\) if((m=getmode(i))!=dir[i][3]) {l+=x+m+':'+dir[i][0];x=',';};
 return l;
}

function wr\(f,s\) {
 f.document.open\('text/html'\);
 f.document.write\(s\);
 f.document.close\(\);
 help('');
}

var selhelp='Select file to link to ';

function xst(s){
 help(xstate=s);
}

function ffval(){
 return isUndef(fm1.document.ff)?'':fm1.document.ff.item0.value;
}

function al(s){
 if(!isUndef(fm1.document.ff)) fm1.document.ff.item0.focus();
 alert(s);
}

function click\(m,i\){
 var n='f',c=0;
 if(isUndef(fm1.document.f)) return;
 xst('');
 if\(m=='upload'\) {i=ffval(); n='ff';}
 else if\(m=='go'\) {path=i;i='';m='ls'}
 else if\(m=='link'||m=='symlink'\) {
  if(isUndef(i)){
   if((link1=ffval())=='') {al('Enter name of '+m);return;}
   link1=path+link1;
   if\(confirm\(xstate=selhelp+' from "'+link1+'"'\)\) linkselect=m
   else xst('');
   help('');
   return;
  }
  i=link1+':'+path+i;
  linkselect='';
 }
 else if\(m=='delete'\) {c=1;i=mklist()}
 else if\(m=='mkdir'\) i=ffval()
 else if\(m=='chmod'\)  {c=1;i=chmod()}
 else if\(m=='chown' \) i=mklist()+','+ffval()
 if((isUndef(i)||i=="")&&m!='ls'&&m!='reload'&&m!='logoff') alert\('Nothing to '+m\)
 else with\(fm1.document\) {
  if(c&&!confirm\('Sure to '+m+'"'+i+'"?'\)) return;
  forms[n].action.value=m;
  if(n!='ff') forms[n].item0.value=i;
  forms[n].path.value=path;
  sign(forms[n]);
  if\(m=='logoff' \) {
   logoff();
   linx=dir=[]; linkselect=path=webbase='';
  }
  forms[n].submit();
 }
}

function calcsize(){
var s1=0,s2=0,n1=0,n2=0,b;
for\(var i=0;i<dir.length;i++\){
 if\(b=sel(i)\) n2++;
 if(dir[i][1]+0==dir[i][1]){
  if\(b\) s2+=dir[i][1];
  s1+=dir[i][1];
  n1++;
 }
}
statusline='Total: '+dir.length+' entries; Files: '+n1+' / '+s1+' bytes; Selected: '+n2+' / '+s2+' bytes.';
help('');
}

function td\(x\){
 return '<td width=20><pre>'+x+'</pre></td>';
}

function lcl\(i,j,b,s\){
with \(s\){
 if(i<0){
  if\(color!='red'\) {color='red';textDecoration='underline';}
  else{
   if\(textDecoration=='underline'\)textDecoration='overline'
   else {textDecoration='none';color='black';}
  }
  linx0[j]=s;
 }else{
  if\(color!='red'\) {color='red';textDecoration=(b==1?'underline':'overline');}
  else {color='black';textDecoration='none';}
  linx[i][j]=s;
 }
}
calcsize();
}

function getmode\(i\){
var m=dir[i][3],j,d,d1,s=sel(i);
 for(j=0;j<16;j++) {
  d=typeof\(linx[i][j]\)!='object'?'':linx[i][j].textDecoration;
  if(s){
   d1=typeof\(linx0[j]\)!='object'?'':linx0[j].textDecoration;
   m=((m|((d1=='overline')<<j))&(0xffff^((d1=='underline')<<j)));
  }
  m=((m|((d=='overline')<<j))&(0xffff^((d=='underline')<<j)));
 }
 return m;
}

function cbox(c){
if(linkselect!='') click(linkselect,c.alt);
calcsize();
}

function ch(c){
if(linkselect!='') click(linkselect,c.value);
}

function help\(t\){
window.status=(t==''?window.defaultStatus=statusline+((xstate=='')?'':(' --- '+xstate)):t);
}

mm='xwrxwrxwrtgu+ldf'.split('');
function modes\(m,id\){
var x='',b,a;
var t=['all exec','all write','all read','group exec','group write','group read','user exec','user write','user read','sticky','group ID on exec','user ID on exec','','link','dir','file'];
for\(var j=0;j<16;j++\) {b=\(m>>j\)&1;x=lnk\('#','parent.lcl\('+id+','+j+','+b+',style\)',b?mm[j]:'-',mo(a='mode bit: '+t[j])+' class=m alt="'+a+'"'\)+x;};
return x;
}

function form(n,f,ons){
if(isUndef(ons)) ons=''
else ons=' onsubmit='+ons;
var fff=['sig','action','path','item0'],
s='<form name="'+n+'" method=post target=fm1'+ons+' action="'+cgi+'"; enctype="multipart/form-data">';
for\(var i=0;i<fff.length;i++\) if\(f.indexOf\('<input name="'+fff[i]+'"',0\)<0\) s+='<input name="'+fff[i]+'" type="hidden">';
return s+f+'</form>';
}

function mo\(t\){
return ' onmouseout=\\'parent.help\(""\);return true\\' onmouseover=\\'parent.help\("'+t+'"\);return true\\'';
}

function drawmenu\(f\){
var mm=[
['delete','delete selected files'],
['upload','upload file from inpuline'],
['reload','reload directory'],
['mkdir','make dir from inputline'],
['chmod','click on mode bits on files or table header to edit each file or selected files'],
['chown','change user:group from inputline for selected files'],
['link','make link to 1 selected file'],
['symlink','make symlink to 1 selected file'],
['logoff','logoff']
];
var s='$head</head><body bgcolor=gray><TABLE frame=0 border=0 bgcolor=gray width=100% height=100% cellspacing=0 cellpadding=0>'+
'<tr height=10% valign=top><th><font color=white>FM/3 v0.01m</font></th></tr>'+
'<tr valign=top><td><TABLE frame=0 border=1 bgcolor=darkgray width=100% cellspacing=1 cellpadding=1>';
for(var i=0;i<mm.length;i++) if(secure!=2||(i!=4&&i!=5)) s+='<tr><td bgcolor=lightgreen align=center'+mo(mm[i][1])+' onclick=parent.click\("'+mm[i][0]+'"\)>'+mm[i][0]+'</td></tr>';
s+='</td></tr></TABLE><tr valign=bottom><th><font size=1 color=white>&copy;mahatma</td></th></TABLE></body></html>';
wr\(f,s\);
}

function isUndef(x){
return typeof(x)=='undefined';
}

function lnk(h,j,l,x){
if(isUndef(x)) x='';
return '<a href="'+h+'"'+x+' onclick="'+j+';return false" ondblclick="'+j+';'+j+';return false">'+l+'</a>';
}

function clnk(h,a,x,l,xx){
return lnk\(h,'parent.click\(\\''+a+'\\',\\''+x+'\\'\)',l,xx\);
}

function drawdir\(\){
var i,d=new Date,a=unescape(path).split\('/'\),p='',s=clnk(webbase,'go',p,webbase,' style="color:green;"');
 for\(var i=0;i<a.length-1;i++\) {p+=a[i]+'/';s+=clnk(webbase+p,'go',p,a[i])+'/';}
 s='$head<style>a.m:link,a.m:visited{color:black;text-decoration:none;}</style></head><body>'+
 form('ff','<input name="item0" type="file" onchange="parent.ch(this)" size=50>'+s+' <font color=red>'+error+'</font>')+
 '<form name=f1 method=none><TABLE frame=below border=1 rules=cols width=100% cellspacing=0 cellpadding=1>'+
  '<tr bgcolor=lightgreen valign=baseline><th width=10>sel</th><th width=60>size</th><th width=20>mtime</th>';
  if(secure!=2) s+='<th width=20><pre>'+modes(0xffff,-1)+'</pre></th><th width=20>owner</th>';
  s+='<th>name</th></tr>';
 for\(i=0;i<dir.length;i++\){
  var j=4;
  s+='<tr valign=baseline bgcolor='+(i&1?'#EEEEEE':'white')+'><td width=10><input type=checkbox name=chk'+i+' alt="'+dir[i][0]+'" onchange="parent.cbox(this)"></td>';
  if(dir[i][3]&0x4000) dir[i][1]='[DIR]';
  d.setTime(dir[i][2]*1000);
  s+=td(dir[i][1])+td(d.toLocaleString());
  if(secure!=2) s+=td\(modes\(dir[i][3],i\)\)+td(dir[i][j++]);
  s+='<td align=left><pre>'+clnk(webbase+path+dir[i][0],'get',dir[i][0],unescape(dir[i][0]))+(isUndef(dir[i][j])?'':' -> '+unescape(dir[i][j]))+'</pre></tr>';
  j++;
 }
 s+='</form>'+
 form('f','')+
 '</body></html>';
 wr\(fm1,s\);
 calcsize();
}

function loaddir\(db,p,w\){
dir=db;
dir.sort();
path=p;
webbase=unescape(w);
linx0=linx=[];
for\(var i=0;i<dir.length;i++\) linx[i]=[];
drawdir\(\);
}


</SCRIPT>
<frameset cols="93,*" framespacing=0 frameborder=0>
<frame src="$iam?action=menu" name=fm0 scrolling=auto>
<frame src="$iam?action=ls" name=fm1 scrolling=auto>
</frameset>
<NOSCRIPT>Please turn ON JavaScript.</NOSCRIPT>
<BODY>Frames & JavaScript required</BODY>
</html>)
}

sub a_start(){
print $header,start();
}

sub wrfile(){
my $f=shift;
my $s=shift;
my $m=shift;
my %ss=('fm3.cgi\?action=menu'=>'fm3menu.htm');
for my $i (keys %ss) {$s=~s/$i/$ss{$i}/g}
open FF,">$f" or die $!;
print FF $s;
close(FF);
chmod $m,$f;
}

sub install(){
my $ss='',$c;
my $n=1;
my @st=stat($0);
open FF,"<$0" or die $!;
while (defined($c=$s=<FF>)){
 chomp($c);
 $ss.=$s if($n=$n?$c ne '### install ###':$c eq '### /install ###');
}
close(FF);
$iam='fm3.cgi';
&wrfile($iam,$ss,@st[2]);
&wrfile("fm3menu.htm",menu(),0444);
&wrfile("fm3.htm",start(),0444);
exit;
}

1;

=head1 NAME

fm.pl - FM/3, File Manager for WWW (uploader, etc).

=head1 DESCRIPTION

Manage your files (upload, delete, access rights and more) witheout telnet &
ftp client. JavaScript (client-side) required. For personal and root/multiuser
usage. Light security login in some modes.

=head1 README

FM/3 v.0.01m, (c) Denis Kaganovich AKA mahatma, 2004

There are free software with NO WARRANTIES.
Also see Perl and RSA lycenses before using this.
All "security" terms are not strong by default and only make abuse less easy
then witheout it.

FM/3 works in default and "installed" modes. Just configure single-script
and (if you want) run "./fm.pl install". You will get fm3.cgi, fm3.htm &
fm3menu.htm. There are just some faster.

Config are inside. Default - personal mode witheout login and security.
Use it for apache/.htaccess. Also you may find commented out example of
root/multiuser config with unsecure login. Secure auth work only when
system passwords stored unencrypted or in MD5, then you may use standard
MD5 digest-auth. Else use unsecure way to password transport.

There are only basic version of script. I think about more security and
functionality.

Used "own" both-side MD5, based on RFC 1321 and various examples. I am
suggest to change 2 lines in JS/MD5 to commented if you sure to  browser
compatibility.

PS To edit mode bits just click to mode bit letters... ;)

=head1 PREREQUISITES

Perl 5

=head1 COREQUISITES

Perl 5. MD5 for security (not required).

=pod OSNAMES

Linux, unix

=pod SCRIPT CATEGORIES

Web, Networking, UNIX : System_administration

=cut
