Index of $i

#!/usr/bin/perl -U # virtual hosting script v0.5.x (c) Denis Kaganovich AKA mahatma # redirect & compress by gzip on-the-fly multiple vhosts witheout real # virtual hosts support on site. very simple! ### config begin my $root=$ENV{DOCUMENT_ROOT}||'.'; my $mode=1; # 0-single, 1-www.doe.com-"doe/", 2-"www.doe.com/" my $index=['index.htm','index.html']; my $linkindex='index.cgi'; # indexfile link for $linktype=1 my $codepage='koi8-r'; # codepage ID to send with HTTP header with "text/*" types. my $enable_gzip=1; my $vbase="$root/"; # base path to real vhosts repository my $logs="$root/log/"; # path to logs my $loglevel=1; # 0-4 (0-off) my $linktype=0; # 0-symlink; 1-dir; 2,3-internal (don't touch); for 1 must be absolute $vbase my $cache=1; # cache .gz? my $zbase="$root/cache/"; # path to gzip cache my $gzip='/usr/bin/gzip'; # gzip my $mkdir_mode=0770; # for $linktype=1 my $ExecCGI=1; # 0-no; 1-yes/auto; 2-force gz/nocached; 3-force gz/cache (bad, experemental) my $suexec=0; # exec CGI under file UID/GID? (untested) ### config end my %mime=( '.html'=>'text/html', '.htm'=>'text/html', '.txt'=>'text/plain', '.cgi'=>'text/plain', '.js'=>'text/javascript', #'js'=>'application/x-javascript', '.gif'=>'image/gif', '.jpg'=>'image/jpeg', '.gz'=>'application/x-gzip' ); my %mime_gz=( # -1 'Lynx'=>{ 'text/html'=>2, 'text/plain'=>2, '*'=>1 }, # for Lynx gzip only text/html & text/plain '*'=>{ 'image/jpeg'=>1, '*'=>2 } # for others compress all exclude jpeg ); my %cgi=( '.cgi'=>1, '.pl'=>1, '.php3'=>1, '.php'=>1 ); $enable_gzip=index($ENV{HTTP_ACCEPT_ENCODING},'gzip',0)>=0?$enable_gzip:0; my $hthead=''; my $iam=$ENV{SCRIPT_FILENAME}; my $i; my $ndx=''; my $txt=''; my $cnt=0; my $p=$mode==0?'':lc($ENV{HTTP_HOST}); if($mode==1){ $p=substr($p,4) if(index($p,'www.')==0); $p=substr($p,0,index($p,'.')); }elsif($mode==0){chop($vbase) if(substr($vbase,-1) eq '/')}; my $rs=$ENV{REDIRECT_STATUS}+0; my $f=$ENV{REQUEST_URI}; my $meth=$ENV{REQUEST_METHOD}||"?"; my $log=$loglevel>0?localtime(time)." - $ENV{REMOTE_ADDR}:$ENV{REMOTE_PORT}".($loglevel>1?log2($ENV{HTTP_X_FORWARDED_FOR}):'')." $meth $ENV{HTTP_HOST}$f".($loglevel>2?' '.($ENV{HTTP_REFERER}||'?'):''):''; my @fs; $i=index($f,'?'); $f=substr($f,0,$i) if($i>0); my $ff="$vbase$p$f"; my $t; if($rs==404&&substr($f,-1) ne '/'&&-d $ff){$ff.='/';$f.='/'} if(substr($f,-1) eq '/'){ for ($i=0;$i1); $txt.="$hthead\nIndex of $i"; opendir DH,$ff or err(404,"path not found"); my @dir=readdir(DH); @fs=stat($ff); my @stat; for $i (@dir){ @stat=stat("$ff$i"); @fs[9]=@stat[9] if(@fs[9]<@stat[9]); $txt.="\n" } closedir DH; $txt.='

Name	Size	Date	Description
$i	@stat[7]	".localtime(@stat[9])."

'; $ff=''; } } $t=$t||lc(substr($f,$i=rindex($f,'.'))); my $zz=0; my $loc=$f; @fs=(@fs[9])?@fs:stat($ff); err(404,'not found') if(!@fs); my $a=$ENV{HTTP_USER_AGENT}; $log.=" \"$a\"" if($loglevel>3); $a=substr($a,0,index($a,'/')); $log.=" $a" if($loglevel>0 && $loglevel<4); my $m; my $h=''; my $hdr=sub {$h.="$_[0]$_[1]\n";}; if($ExecCGI>0 && $ff ne '' && $cgi{$t}==1 && -x $ff){ $hdr=sub { my $t=shift; my $x=shift; my $i=index(lc($h),lc($t)); if($i<0){$h.="$t$x\n" if($x); return;} $i+=length($t); return substr($h,$i,index($h,"\n",$i)-$i,$x) if($x); return substr($h,$i,index($h,"\n",$i)-$i); }; $log.=" - &$ff" if($loglevel>0); $t='.txt'; my $q=''; if($suexec){ $)="@fs[5] @fs[5]"; $(=@fs[5]; $<=$>=@fs[4]; err(500,'cgi security error') if($) ne "@fs[5] @fs[5]" or $(!=@fs[5] or $!=@fs[4]); } open FH,"$ff|" or err(500,'cgi error'); binmode FH; $txt.= while(!eof(FH)); close(FH); if($enable_gzip==0||$ExecCGI==1){ pr($txt); lexit(0); } $h=substr($txt,0,index($txt,"\n\n")+2,''); chomp($h); $m=&$hdr('Content-type: ')||'*/*'; if(($i=index($i,";"))<0){ $i=$m; $m.="; codepage=$codepage" if($codepage ne '' && index($m,'text/')>=0); }else{$i=substr($m,0,$i);}; my $e=&$hdr('Content-encoding: '); if($e eq 'gzip'){ pr($h,"\n",$txt); lexit(0); } $enable_gzip=0 if($ExecCGI==1 && $cache==1); $cache=0 if($ExecCGI<3); }else{ if($enable_gzip==1 && $t eq '.gz'){ my $j=rindex($f,'.',$i-1); $t=lc(substr($f,$j,$i-$j)); $zz=1; } $i=$m=$mime{$t}||'*/*'; $m.="; codepage=$codepage" if($codepage ne '' && index($m,'text/')>=0); }; &$hdr('Content-Type: ',$m); if($enable_gzip==1){ my $fz="$zbase$p$f.gz"; my $z=$mime_gz{$a}||$mime_gz{'*'}||{'*'=>2}; $z=($z->{$i}||$z->{'*'}||2)-1; if($z==1||$zz==1){ if($zz==0){ $loc.='.gz'; if($cache==0){$ff=$txt eq ''?"$gzip -cfn9 $ff |":"|$gzip -cfn9"} else{ my @fzs=stat($fz); if((@fzs[9]||-1)<@fs[9]){ mklink($fz,4,length($zbase)); if($txt eq ''){`$gzip -cfn9 $ff >$fz`} else{ open FH, "|$gzip -cfn9 >$fz"; print FH $txt; close(FH); $txt='' } @fzs=stat($fz) } @fs[7]=@fzs[7]; $ff=$fz } } &$hdr('Content-Encoding: ','gzip') if($t ne '.tar'); } } &$hdr('Content-Location: ',$loc); &$hdr('Last-Modified: ',localtime(@fs[9])); $log.=log2($ff) if($loglevel>0); if($txt ne '' && $ff eq ''){&$hdr('Content-Length: ',length($txt));pr($h,"\n",($meth ne 'HEAD')?$txt:'')} else{ mklink("$root$f$ndx",$linktype,length($root)) if($rs==404||$rs==403); &$hdr('Content-Length: '.@fs[7]) if(index($ff,'|')<0); pr($h,"\n"); if($meth ne 'HEAD'){ open FH,$ff or err(403,'access denied'); binmode FH; if($cache==0 && $txt ne ''){print FH $txt;$cnt='?'}; pr(); close(FH); }; } lexit(0); ################################################# sub log2{ my $l=''; while(my $i=shift){ $i="\"$i\"" if(index($i,' ')>=0); $i="-" if($i eq ''); $l.=" $i"; } return $l; } sub pr{ while(my $i=shift){$cnt+=length($i);print $i} }; sub mklink{ my $r=shift||return 1; my $lnk=shift; # 0-symlink; 1-dir; 2-dir w/o last; 3-experimental, not work now my $i0=shift||0; my ($i,$i1)=(0,0); my $l=length($r); my $rr; while($i0<=$l){ $i=index($r,'/',$i0); $i1=$i<0?$l:$i; $rr=substr($r,0,$i1); if($lnk==3||($lnk==0 && $i>=0)){symlink('.',$rr)} elsif($lnk==1 && $i<0 && substr($r,-1) eq '/'){symlink($iam,"$r$linkindex")} elsif($lnk==0||($lnk==1 && $i<0)){symlink($iam,$rr)} elsif($lnk>0 && $i>=0){mkdir($rr,$mkdir_mode)} $i0=$i1+1; } } sub err{ my $e=shift; my $t=shift; pr(qq(Content-Type: text/html Pragma: no-cache Content-Location: /error/$e.html $hthead $e - $t Error $e
$ENV{REQUEST_URI}
$t )); lexit($e); } sub lexit{ my $e=shift; if($loglevel>0){ open FL, ">>$logs$p.log" or die "log error"; if($loglevel>1){ my ($t1,$t2,$t3,$t4)=times; $log.=" $cnt $t1/$t2/$t3/$t4"; } print FL "$log - $e\n"; close FL; } exit($e); } __END__ =head1 NAME vhscript-0.5.3.pl (AKA index.cgi) - Virtual Hosting Script (+accelerator/gzip). =head1 DESCRIPTION Allow alternative ways to: 1) virtual hosting; 2) transparently compress (accelerate) traffic by gzip. =head1 README Virtual Hosting Script v0.5.3 (c) Denis Kaganovich AKA mahatma There are simple script, that allow to alternative ways to: 1) virtual hosting; 2) transparently compress (accelerate) traffic by gzip. (c)opyleft. Free. You MUST change code to tune. WARNING: slotly tested, I have not security ideas. May be there are simple large gap to your system, may be not. Try if sure. I am use it. Please, don't write me nothing about changes, just do it self. Installation: Select ways to host. There are 3 modes ($mode): 0. Single virtual host. 1. Default: every vhost last level name lowercase witheout "www". Examples: "www.doe.com" - "doe", "doe.com" - "doe". 2. Full host name lowercase. Recommended name of script are "index.cgi". Change "$enable_gzip" to "0" to turn off compression (default - ON if supported by client). Move all your [compressible] files and subdirectories into preferred directory. Change ".htaccess" file something like this: --- Options ExecCGI FollowSymLinks ErrorDocument 403 /index.cgi ErrorDocument 404 /index.cgi AddHandler cgi-script .html .cgi .txt .jpg .htm .gif .js .bbs .rar .zip .tgz .exe .doc .pdf --- Create writable cache (default - ".gz" ) directory if gzip & cache enabled. a) If your hoster supported for "ErrorDocument" in .htaccess - just try to access your files. First request will be "404", but file will sended. Every next request will be clean. b) If your hoster are not support "ErrorDocument" - create: dirtype=0 - symlinks in root: for every your directory, linked to ".", for every file - linked to script. dirtype=1 - full directory structure and symlinks for files, linked to script. Make "AddHandler cgi-script ..." to all file types and script type (now ".cgi"). Edit config section. Tested with Perl 5.8.0 & Apache/1.3.28. Some with older Perl/Apache. No perl modules usage. =head1 PREREQUISITES Perl 5.6.0 (last tested with 5.8.0, but IMHO stay compatible). =head1 COREQUISITES Perl 5, no modules =pod OSNAMES All =pod SCRIPT CATEGORIES Web, CGI =cut