#!/usr/bin/perl -U
#
# v0.03i (c)mahatma, no warranty, 01/2005
#
# 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 Digest::MD5 qw(md5_hex); # 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 0077;
### config start
## $auth - password: 0-none/.htpasswd; 1:crypt; 2:unencrypted; 3:md5
## 1 - RSA encrypted login; 1,2,3 - md5 hashed;
my $auth=0;
my $auth_cache; # auth cache filename or undef ($auth!=0)
my @timeout=(12,86400); # login, cache ttl
## RSA login only ($auth==1 && $use_BigInt):
## 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:run as $suid=[uid,gid]; 2:1+deny chown/chmod
my $suid; # ["user","group"] or undef - new file ($secure=0) or script uid/gid
$maint=3; # login cache cleaning; >0 - smart way, <0 - hard (slow)
## 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 @timeout=(12,86400);
#my $auth_cache="/var/acache";
#my $pub_rsa_key=[148299941,57683965,5687041];
#my $priv_rsa_key=[[119141457,185046352,2676254],[40632295,2191],[122927507,2595]];
#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];
#$maint=3
##$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 $outtext='';
my %cache,%addinfo,$error,@item,$it;
my $header="Content-type: text/html\n\n";
my $head='';
my $path=param('path')||'';
my $action=param('action')||'start';
my $lastpath='';
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($ARGV[0] eq 'maint'){
dbmopen(%cache,$auth_cache,0600) or die "$! $auth_cache";
maint($ARGV[1]);
dbmclose(%cache);
exit;
}
if($action eq 'menu'){a_menu();ex(0)}
elsif($action eq 'start'){a_start();ex(0)}
### /$install ###
if(!login()){
$error.='Invalid login|password or timeout
' if($user ne '');
logoff();
}
$suid=guid($suid) if(defined($suid));
seq() if($secure);
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 'md5'){a_md5()}
elsif($action eq 'logoff'){a_logoff()}
else{zerr("Invalid command \"$action\"")}
ex(0);
sub login_get{
my $i=param('sig');
my @s=split(/,/,$i);
for($i=0;$i<=$#s;$i++){@s[$i]=unesc(@s[$i])}
@s[3]=(@s[3] ne '')?rsaDecode($priv_rsa_key,@s[3]):'' if($use_BigInt);
@s[1]=pack "H32",@s[1];
@s;
}
sub login_js{
my $s1,$s2,$t1,$t3;
my $t='p';
$t1=$t3="''";
$s1=$s2='';
### $auth ###
if($auth){#
$t="md5h($t)" if($auth==3);
$t="md5h($t+t+s)";
if($auth==1){
if($use_BigInt){$t3="rsaEncode(".a2js("%u",@$pub_rsa_e).",".a2js("%u",@$pub_rsa_key).",p)"}else{$t="''" if(!defined($auth_cache));$t3="p"};
}else{#
$t1="sig0";
}#
if(defined($auth_cache)){
$s1="sig[1]=md5h(sig0+sig[1],1);";
$s2="sig[3]='';";
$t1="''";
};
}
### /$auth ###
$t=qq(
var sig0='',sig='';
function setpass(p,t,s){
var tt=new Date();
t=tt.getTime()-t;
sig0=$t;
sig=[fm1.document.f.item0.value,$t1,t,$t3];
for(var i=0;i=0);
$t=RSA_js().$t if(index($t,'rsa',0)>=0);
$t;
}
sub newts{
@sig[0]=time.sprintf("%03u",rand(1000));
}
sub maint{
my $i=shift;
#my $t=(time-@timeout[1]).'000';
my $t=ph((time-@timeout[1]).'000');
while($i&&(my ($k,$v)=each %cache)){
$i-- if($i>0);
if($k gt $t){
delete $cache{$k};
$i++ if($i<0);
}
}
}
sub ph{
pack "h*",length($_[0])&1?"0$_[0]":$_[0];
}
sub m_5{
$_[0]=defined(&md5_hex)?pack "H32",md5_hex($_[0]):md5($_[0]);
}
sub login{
return 1 if($auth==0);
my $sid,$u,$p,$p0,$l;
if(defined($auth_cache)){
dbmopen(%cache,$auth_cache,0600) or die "$! $auth_cache";
#$sid="@sig[0]$session";
$l=$session;
$l=~s/([0-9]{1,3})\.([0-9]{1,3})\.([0-9]{1,3})\.([0-9]{1,3})/sprintf("%02x%02x%02x%02x",$1,$2,$3,$4)/eg;
$l=~s/([0-9A-Fa-f]{1,8})[\/:\. ]{0,1}/pack "h*",$1/eg;
$sid=ph(@sig[0]).$l;
if(defined($p=$cache{$sid})){
$p0=substr($p,0,16);
m_5($p);
return r(0) if($p ne $password);
$cache{$sid}="$p0$p";
return r(1);
}else{
return r(0) if((time-@timeout[0]).'000' gt @sig[0]);
maint($maint);
}
}
if(defined($passwd)){
open PF,"<$passwd" or return r(0);
while(defined($l=)){
($u,$p)=(split(/:/, $l))[0,1];
if($u eq $user){
$hpasswd{$u}=$p;
last;
}
}
close(PF);
}
return r(0) if(!defined($p=$hpasswd{$user}));
if($auth==1){
return r(0) if(crypt(@sig[1],$p) ne $p);
return r(1) if(!defined($auth_cache));
$p=@sig[1];
};
$p.="@sig[0]$session";
m_5($p);
if(defined($auth_cache)){
$p0=$p;
m_5($p)
}
if($password eq $p){
$cache{$sid}="$p0$p";
return r(1);
}
r(0);
sub r($){
if(defined($auth_cache)){
delete $cache{$sid} if($action eq 'logoff'&&$_[0]);
dbmclose(%cache);
};
$_[0];
}
}
sub logoff{
$error.='Not logged in!';
$user=$password='';
@sig=@item=();
a_ls();
ex(-2);
}
# md5($text[,$middle,\@h]); if $middle - $text length must be 64*x
sub md5{
my ($s,$mid,$e)=(@_);
my ($a,$b,$c,$d,$cn)=defined($e)?unpack "LLLLL",$e:(0x67452301,0xefcdab89,0x98badcfe,0x10325476,0);
my ($n,$xx)=(length($s),0xffffffff);
$xx++;
my $i,$j,$l,$r,@x;
$cn+=$n;
if($mid){
$r=5;
}else{
$r=4;
$s=pack "a".(($n=((($n+8)>>6)+1)<<6)-8)."LL","$s\x80",$cn<<3,0;
};
for($i=0;$i<$n;$i+=64){
@x=unpack "L[16]",substr($s,$i,64);
my ($a1,$b1,$c1,$d1)=($a,$b,$c,$d);
for $j(0..63){
$e=(((($a=($a+@md5_t[$j]+@x[@md5_i[$j]]+(($e=$j>>4)==0?($b&$c)|($d&~$b):$e==1?($b&$d)|($c&~$d):$e==2?$b^$c^$d:$c^($b|~$d))%$xx)%$xx)<<($l=@md5_s[$e<<2|($j&3)]))|($a>>(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;
}
pack "L[$r]",$a,$b,$c,$d,$cn;
}
##################################################################
### $use_BigInt ###
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
}
### /$use_BigInt ###
sub err_{
my $e=shift;
"$!; $action \"$e\" ";
}
sub ex{
exit shift;
}
sub guid{
my ($u,$d)=(@_);
my $x;
for my $i(0..1){
zerr("Invalid uid or gid") if(!defined($u->[$i]=defined($x=$u->[$i])&&$x ne ''?($i?getgrnam($x):getpwnam($x)):$d));
}
$u;
}
sub seq{
my ($u,$g)=@$suid;
if(defined($suid)&&$u!=-1&&$g!=-1){
undef $suid;
$)="$g $g"; $(=$g; $<=$>=$u;
return if($) eq "$g $g" && $(==$g && $<==$u && $>==$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;
$n;
}
sub a_logoff{
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 @$suid,$f or err($it,rm()) if(defined($suid));
# 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;
}
}
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){
my $f=$base.&chk("$path$it");
mkdir($f,0777) or err($it);
chown @$suid,$f or err($it,rmdir($f)) if(defined($suid));
}
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_md5{
for my $its(@item){for my $it(split(/,/,$its)){
my $n=$base.&chk("$path$it");
if(!-d $n){
my $x,$m;
sysopen FH,$n,O_RDONLY or err($it);
my $e=0;
$m=Digest::MD5->new if(defined(&md5_hex));
while(!$e){
$s='';
$e=(!sysread(FH,$s,1024))||(length($s)!=1024);
$m->add($s) if(defined(&md5_hex));
$x=md5($s,!$e,$x) if(!defined(&md5_hex));
}
close(FH);
$addinfo{$it}=defined(&md5_hex)?$m->hexdigest:unpack "H32",$x;
};
}};
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]);
@it1[0]=oct(@it1[0]);
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=guid([split(/:/,pop(@its1),2)],-1);
for my $it(@its1){
chown @$u,$base.&chk("$path$it") or err($it);
}
}
a_lsd();
}
##################################################################
sub err{
$error.=err_(shift||'');
a_lsd();
ex(-1);
}
sub a_lsd{
@item=$secure&&defined($suid)?():('');
a_ls();
}
sub esc{
my $x=shift;
$x=~s/([\x00-\x1f,:\"\'\\])/sprintf('%%%02X',ord($1))/eg;
$x;
}
sub unesc{
my $x=shift;
$x=~s/%([0-9A-Fa-f]{2})/chr(hex($1))/eg;
$x;
}
sub a_ls{
my $e='';
my $err,@aa;
my $t=qq($header$head
Login: