Index of $i

#!/usr/bin/perl -U # virtual hosting script v0.5.1 (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; # while too experimental! no gzipped, etc ### 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 $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?$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,'.'))); if($ExecCGI==1 && $ff ne '' && $cgi{$t}==1 && -x $ff){ $log.=" - &$ff" if($loglevel>0); my $q=''; open FH,"|$ff" or err(500,'cgi error'); if($meth eq 'POST'){ read(STDIN,$txt,$ENV{CONTENT_LENGTH}); print FH $txt; } print ; close(FH); lexit(0); } my $zz=0; if($enable_gzip==1 && $t eq '.gz'){ my $j=rindex($f,'.',$i-1); $t=lc(substr($f,$j,$i-$j)); $zz=1; } my $loc=$f; @fs=(@fs[9])?@fs:stat($ff); err(404,'not found') if(!@fs); $i=my $m=$mime{$t}||'*/*'; my $a=$ENV{HTTP_USER_AGENT}; $log.=" \"$a\"" if($loglevel>3); $a=substr($a,0,index($a,'/')); $log.=" $a" if($loglevel>0 && $loglevel<4); $m.="; codepage=$codepage" if($codepage ne '' && index($m,'text/')>=0); 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 } } $m.="\nContent-Encoding: gzip" if($t ne '.tar'); } } $m="Content-Type: $m\nContent-Location: $loc\nLast-Modified: ".localtime(@fs[9])."\n\n"; $log.=" - $ff" if($loglevel>0); if($txt ne '' && $ff eq ''){print 'Content-Length: ',length($txt),"\n",$m,($meth ne 'HEAD')?$txt:''} else{ mklink("$root$f$ndx",$linktype,length($root)) if($rs==404||$rs==403); $m="Content-Length: @fs[7]\n$m" if(index($ff,'|')<0); if($meth ne 'HEAD'){ open FH,$ff or err(403,'access denied'); binmode FH; if($cache==0 && $txt ne ''){print $m;print FH $txt} else{print $m,;close FH} }else{print $m} } lexit(0); ################################################# 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; print 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"; print FL "$log - $e\n"; close FL; } exit($e); } __END__ =head1 NAME vhscript-0.5.1.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.1 (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