#!/usr/bin/perl -U
#
# v0.02 (c)mahatma, no warranty, 12/2004
#
# RSA code (c) John Hanna 2004, GPL, http://shop-js.sf.net, 10/13/2004
use CGI qw(:standard);
use CGI::Carp qw(fatalsToBrowser);
# optional:
#use MD5; my $use_MD5=1; # uncomment to use faster MD5 lib
use Math::BigInt; my $use_BigInt=1; # comment to no RSA (for $auth==1)
my $cgi = new CGI;
my $session="$ENV{REMOTE_ADDR} $ENV{HTTP_X_FORWARDED_FOR}";
my %b64;
my $b64s='abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789_"';
{my $n=0; for (split(//,$b64s)) {$b64{$_}=$n++}}
umask 0177;
### config start
## $auth - password: 0-none/.htpasswd; 1:crypt; 2:unencrypted; 3:md5
## 1 - RSA encrypted login; 2,3 - md5 hashed;
my $auth=0;
## RSA login only ($auth==1 && $use_BigInt==1):
## NOW you MUST generate own keys: http://shop-js.sf.net/crypto2.htm
## other ways may be in new version
my @pub_rsa_key=(136867779,84822705,160);
my $priv_rsa_key=[[14636137,3346344,66],[230684127,11],[139074205,13]];
my $pub_rsa_e=17;
## 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 @pub_rsa_key=(136867779,84822705,160);
#my $priv_rsa_key=[[14636137,3346344,66],[230684127,11],[139074205,13]];
#my $pub_rsa_e=17;
#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='';
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 ' 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{
my $i=param('sig');
$i=rsaDecode($priv_rsa_key,$i) if($auth==1&&$use_BigInt&&$i ne '');
my @s=split(/:/,$i);
for($i=0;$i<=$#s;$i++){@s[$i]=unesc(@s[$i])}
return @s;
}
sub login_js{
my $t='p';
$t="md5h($t)" if($auth==3);
$t="md5h($t+t+s)" if($auth>1);
$t="escape(fm1.document.f.item0.value)+':'+escape($t)+':'+escape(t)";
$t.="+':'+escape(s)" if($auth==1);
$t="rsaEncode([$pub_rsa_e],".a2js("%u",@pub_rsa_key).",$t)" if ($auth==1&&$use_BigInt);
$t=qq(
var sig='';
function setpass(p,t,s){sig=$t}
function sign(f){f.sig.value=sig}
function logoff(){sig=''}
);
$t=md5h_js().$t if(index($t,'md5h',0)>=0);
$t=RSA_js().$t if(index($t,'rsa',0)>=0);
return $t;
}
sub login{
return 1 if($auth==0);
my $u,$p,$l;
if(defined($passwd)){
open PF,"<$passwd" or return 0;
while(defined($l=)){
($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){
return 0 if(@sig[1] ne $session);
$password=crypt($password,$p)
}else{
$p=md5h("$p@sig[0]$session");
}
return ($password eq $p);
}
sub logoff{
@sig=[];
$user=$password='';
}
### /login ###
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;
}
##################################################################
### rsa ###
sub rc4 {
my ($key, $string)=@_;
#"""Return string rc4 (de/en)crypted with RC4."""
my($i,$j,$klen,@s)=(0,0,length($key),0 .. 255);
for(0 .. 1) {
for $i (0 .. 255) {
$j=(ord(substr($key,$i%$klen,1))+$s[$i]+$j)%256;
($s[$i],$s[$j])=($s[$j],$s[$i])
}
}
my $r='';
for $i (0 .. length($string)-1) {
my $i2=$i % 256;
$j=($s[$i2]+$j)%256;
($s[$i2],$s[$j])=($s[$j],$s[$i2]);
$r.=chr(ord(substr($string,$i,1))^$s[($s[$i2]+$s[$j])%256]);
}
return $r;
}
sub crt_RSA {
my ($m, $d, $p, $q)=@_;
#""" Compute m**d mod p*q for RSA private key operations."""
return $m->bmodpow($d,$p*$q);
}
sub base64ToText {
my $text=shift;
my ($r,$m,$a,$c)=('',0,0,0);
for $i (0 .. length($text)-1) {
$c=$b64{substr($text,$i,1)};
#print substr($text,$i,1),"=$i=$c|\n";
if(defined $c) {
$r .= chr(($c << (8-$m))& 255 | $a) if $m;
$a = $c >> $m;
$m=($m+2) % 8;
}
}
return $r;
}
sub t2b { my $s=shift;
my $r=Math::BigInt->bzero();
my $m=Math::BigInt->bone();
for $i (0 .. length($s)-1) {
$r+=$m*ord(substr($s,$i,1));
$m*=256;
}
return $r
}
sub b2t { my $b=shift;
my $r='';
while($b) {
$r.=chr($b % 256);
$b/=256;
}
return $r;
}
sub fix { my $a=shift;
my $r=Math::BigInt->bzero();
my $s=0;
for $i (@$a) {
$r+=Math::BigInt->new($i) << $s;
$s+=28;
}
return $r;
}
sub rsaDecode { my ($key,$text)=@_;
#""" decode the text based on the given rsa key. """
# separate the session key from the text
$text=base64ToText($text);
my $sessionKeyLength=ord(substr($text,0,1));
my $sessionKeyEncryptedText=substr($text,1,$sessionKeyLength);
$text=substr($text,$sessionKeyLength+1);
my $sessionKeyEncrypted=t2b($sessionKeyEncryptedText);
# un-rsa the session key
my $sessionkey=crt_RSA($sessionKeyEncrypted,fix($key->[0]),fix($key->[1]),fix($key->[2]));
$sessionkey=b2t($sessionkey);
$text=rc4($sessionkey,$text);
return $text
}
### /rsa ###
sub err_{
my $e=shift;
return "$!; $action \"$e\" ";
}
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){
print "$header Security error (set uid/gid)";
&ex(-3);
}
}
sub seq2{
&zerr('Denyed') if($secure==2);
}
sub chk{
my $n=unesc(shift);
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", 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 ";
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 unesc{
my $x=shift;
$x=~s/%([0-9A-Fa-f]{2})/chr(hex($1))/eg;
return $x;
}
sub a_ls{
my $e='';
my $err;
my $t=qq($header$head
$session Login: