#!/usr/local/bin/perl
# KOI.pl - CGI-Script (v0.1.1) by Maksim Moshkow, converts TXT-documents
# to HTML 'on the fly'. Feel free to modify and use it.
#
# мАЛЕНЬКОЕ ПРЕДУПРЕЖДЕНИЕ. сКРИПТ РАСЧИТАН ДЛЯ РАБОТЫ С ТЕКСТОВЫМИ ФАЙЛАМИ
# ПОДГОТОВЛЕННЫМИ В РЕДАКТОРЕ рК НА РАБОЧЕЙ СТАНЦИИ бЕСТА-88.
# пОЭТОМУ БУКОВКИ С ЕГО ПОДАЧИ ВАМ ПОКАЖУТТСЯ ПЕРЕВЕРНУТЫМИ.
# нЕ ПОЛЕНИТЕСЬ ИСПРАВИТЬ ТАБЛИЧКИ ПЕРЕКОДИРОВКИ В ФУНКЦИИ KOI
#
$ALARM_TIME=2400; # ЛИМИТ ВРЕМЕНИ 40 МИНУТ - ЗАТЕМ - САМОУНИЧТОЖЕНИЕ
$SIG{'ALRM'} = 'timeout';
alarm $ALARM_TIME;
if ($0 =~ /-KOI/) {$PEREKODER='-k';$KNAMKODER='-K';}
elsif ($0 =~ /-windows/) {$PEREKODER='-w';$KNAMKODER='-W';}
elsif ($0 =~ /-alt/) {$PEREKODER='-a';$KNAMKODER='-A';}
elsif ($0 =~ /-iso_8859_5/) {$PEREKODER='-i';$KNAMKODER='-I';}
elsif ($0 =~ /-volapuk/) {$PEREKODER='-l';$KNAMKODER='-L';}
;
@kodirowki=('volapuk','windows','iso_8859_5','alt','KOI');
$ROOT_DIR = '/home/www/docs/book';
$ROOT_WWW = '/book';
# бУДЕМ ДАВАТЬ ФАЙЛЫ КУСОЧКАМИ ПО 80 КБ
$piece_size=81920;
$what_s_new="<form \n action=What-s-new method=POST><input type=submit value=What_is_new></form>";
@mesq=('Jan','Feb','Mar','Apr','May','Jun','Jul','Aug','Sep','Oct','Nov','Dec');
@nedelq=('Sun','Mon','Tue','Wed','Thu','Fri','Sat'); # НЕДЕЛЯ НАЧИНАЕТСЯ С ВОСКРЕСЕНЬЯ
# $|=1; # Try uncommenting this line if the script stays in memory
$filename = $ROOT_DIR . $ENV{PATH_INFO};
$filename =~ s/\.\.//g ; # there is a '..' - someone tries to break in?
if ($filename =~ /\/What-s-new$/) { &Directory("What-s-new") ; }
if ($filename =~ /\/Contents$/) { &Contents ; }
if ($filename =~ /\/with-big-pictures\.html$/) { &With_big_pictures ; }
if ($filename =~ /\/with-icons\.html$/) { &With_icons ; }
if ($filename =~ /\/Piece[0-9]*\.[0-9]*$/) { &Piece ; }
if (-d $filename) {
if ($filename =~ /\/$/) {} # there is a '/' at the end - Ok.
else {print "Location: http:$ENV{SCRIPT_NAME}$PATH_INFO/\n\n"; exit 0 ;}
if(-f $filename.'index.html'){$filename.='index.html';}
elsif(-f $filename. '.dir'){$filename.= '.dir';}
elsif(-f $filename. 'mim.dir'){$filename.= 'mim.dir';}
elsif(-f $filename. 'index.htm'){$filename.= 'index.htm';}
else { &Directory ;}
}
open(DOCUMENT, $filename) || &file_not_found("Can't open $filename");
if ($ENV{REMOTE_HOST} =~ /localhost/) { } else {
$Additional_header="Last-modified: ". &Last_Modified($filename,'Full')."\n";}
if ($filename =~ /\.html?$/i) {
print "Content-type: text/html\n$Additional_header\n";
while (read(DOCUMENT,$bufer,100000)){print &KOI ($PEREKODER, $bufer) ;}
}elsif ($filename =~ /\.dir$/) {
print "Content-type: text/html\n$Additional_header\n";
&rkdir2html () ;
}elsif ($filename =~ /\.txt$|\.doc$/) {
print "Content-type: text/html\n$Additional_header\n<pre>\n";
&txt2html();
}elsif ($filename =~ /\.lbl$|\.hlp$|\.[0-9]*$/) {
print "Content-type: text/plain\n$Additional_header\n";
while (read(DOCUMENT,$bufer,100000)) {print &KOI($PEREKODER, $bufer);}
}elsif ($filename =~ /\.game$/) {
print "Location: http:/cgi-bin/moshkow/Game-KOI.sh$ENV{PATH_INFO}/1\n\n";
exit 0 ;
}else { # ЕСЛИ НЕ НАШЕ РАСШИРЕНИЕ, ТО ОТДАТЬ ЕГО НА ОТКУП httpd
print "Location: http:$ROOT_WWW$ENV{PATH_INFO}\n\n";
exit 0 ;
}
close(DOCUMENT);
close(STDOUT);
exit(0);
sub file_not_found # ВЫРУГАТЬСЯ И exit
{
print "Content-type: text/html\n\n",
"<HEAD><TITLE>404 Not Found</TITLE></HEAD>",
"<BODY><H1>404 Not Found</H1>",
"The requested URL $ENV{PATH_INFO} was not found on this server.<P>",
"You can mail all problems about this library to <a href=mailto:moshkow\@ipsun.ras.ru>moshkow\@ipsun.ras.ru</a>",
"</BODY>";
die @_[0];
}
sub timeout {
$SIG{'ALRM'} = 'finaltimeout';
alarm 10; # пОДОЗРЕВАЮ, ЧТО НА printe МЫ ОПЯТЬ МОЖЕМ ПОВИСНУТЬ. дАЕМ ЕМУ 10 СЕК
print "\n</pre><blink><b>Timeout $ALARM_TIME while printing $filename </b></blink><pre>";
exit 1;
}
sub finaltimeout {
exit 1;
die "Final timeout. Aborting $filename";
}
sub txt2html { # пРЕВРАЩАЕТ рк-ШНУЮ РАСКРАСКУ В HTML-ТЕГИ
$_=<DOCUMENT>; # НЕТ ЛИ В ПЕРВОЙ СТРОКЕ ЗАГЛАВИЯ?
/^ \024(.*)\025/ && print &KOI($PEREKODER, "<title>$1</title>" );
open(DOCUMENT, $filename) ;
$zagolowok=0;
while (<DOCUMENT>){
/^ \024(.*)\025(.*)/ && do { $_="<ul><h2><a name=$zagolowok>$1</a>$2</h2></ul>\n" ; $zagolowok++;};
/^( *)(.*[^ ]) *╬ *([^ \n]*)/ && do { $_="$1<a href=$3>$2</a>\n" ;};
s/\024/<b>/g;
s/\025/<\/b>/g;
s/\036D/<b><i>/g;
s/\036E/<\/b><\/i>/g;
s/^----*$/<hr>/g ;
print &KOI($PEREKODER, $_ );
};
}
sub KOI # а ТЫ ЗНАЕШЬ, ЧТО ОН КАЛЕЧИТ сами АРГУМЕНТЫ ????????
{
if ( @_[0] eq '-K' ) { @_[1] =~ tr/АБВГДЕЖЗИЙКЛМНОПРСТУФХЦЧШЩ\377ЫЬЭЮЯабвгдежзийклмнопрстуфхцчшщъыьэюя╬/абвгдежзийклмнопрстуфхцчшщ┐ыьэюяАБВГДЕЖЗИЙКЛМНОПРСТУФХЦЧШЩRЫЬЭЮЯ╬/; }
elsif ( @_[0] eq '-k' ) { @_[1] =~ tr/абвгдежзийклмнопрстуфхцчшщ┐ыьэюяАБВГДЕЖЗИЙКЛМНОПРСТУФХЦЧШЩRЫЬЭЮЯ╬/АБВГДЕЖЗИЙКЛМНОПРСТУФХЦЧШЩ\377ЫЬЭЮЯабвгдежзийклмнопрстуфхцчшщъыьэюя╬/; }
elsif ( @_[0] eq '-w' ) { @_[1] =~ tr/абвгдежзийклмнопрстуфхцчшщ┐ыьэюяАБВГДЕЖЗИЙКЛМНОПРСТУФХЦЧШЩRЫЬЭЮЯ╬/юабцдефгхийклмнопярстужвьызшэщчъЮАБЦДЕФГХИЙКЛМНОПЯРСТУЖВЬЫЗШЭЩЧ\377╬/; }
elsif ( @_[0] eq '-i' ) { @_[1] =~ tr/абвгдежзийклмнопрстуфхцчшщ┐ыьэюяАБВГДЕЖЗИЙКЛМНОПРСТУФХЦЧШЩRЫЬЭЮЯ╬/°+╤Ё╜ч·ё?╓'???╖юабцдефгхийклмнопярстужвьызшэщчъЮАБЦДЕФГХИЙКЛМНО╬/; }
elsif ( @_[0] eq '-I' ) { @_[1] =~ tr/°+╤Ё╜ч·ё?╓'???╖юабцдефгхийклмнопярстужвьызшэщчъЮАБЦДЕФГХИЙКЛМНО╬/абвгдежзийклмнопрстуфхцчшщ┐ыьэюяАБВГДЕЖЗИЙКЛМНОПРСТУФХЦЧШЩRЫЬЭЮЯ╬/; }
elsif ( @_[0] eq '-W' ) { @_[1] =~ tr/юабцдефгхийклмнопярстужвьызшэщчъЮАБЦДЕФГХИЙКЛМНОПЯРСТУЖВЬЫЗШЭЩЧ\377╬/абвгдежзийклмнопрстуфхцчшщ┐ыьэюяАБВГДЕЖЗИЙКЛМНОПРСТУФХЦЧШЩRЫЬЭЮЯ╬/; }
elsif ( @_[0] eq '-a' ) { @_[1] =~ tr/абвгдежзийклмнопрстуфхцчшщ┐ыьэюяАБВГДЕЖЗИЙКЛМНОПРСТУФХЦЧШЩRЫЬЭЮЯ╬/\200\201\202\203\204\205\206\207\210\211\212\213\214\215\216\217\220\221\222\223\224\225\226\227\230\231\232\233\234\235\236\237\240\241\242\243\244\245\246\247\250\251\252\253\254\255\256\257\340\341\342\343\344\345\346\347\350\351\352\353\354\355\356\357Ё/;@_[1] =~ s/\015*\n/\015\n/g; }
elsif ( @_[0] eq '-A' ) { @_[1] =~ tr/\200\201\202\203\204\205\206\207\210\211\212\213\214\215\216\217\220\221\222\223\224\225\226\227\230\231\232\233\234\235\236\237\240\241\242\243\244\245\246\247\250\251\252\253\254\255\256\257\340\341\342\343\344\345\346\347\350\351\352\353\354\355\356\357Ё/абвгдежзийклмнопрстуфхцчшщ┐ыьэюяАБВГДЕЖЗИЙКЛМНОПРСТУФХЦЧШЩRЫЬЭЮЯ╬/; @_[1] =~ s/\015*\n/\n/g; }
elsif ( @_[0] eq '-l' ) {@_[1] =~ tr/абвгдежзийклмнопрстуфхцчшщ┐ыьэюяАБВГДЕЖЗИЙКЛМНОПРСТУФХЦЧШЩRЫЬЭЮЯ╬/ABWGDEVZIJKLMNOPRSTUFHC+{}┐YX|~Qabwgdevzijklmnoprstufhc=\133\135Ryxe`q╬/; }
elsif ( @_[0] eq '-L' ) {@_[1] =~ tr/ABWGDEVZIJKLMNOPRSTUFHC+{}┐YX|~Qabwgdevzijklmnoprstufhc=\133\135Ryxe`q╬/абвгдежзийклмнопрстуфхцчшщ┐ыьэюяАБВГДЕЖЗИЙКЛМНОПРСТУФХЦЧШЩRЫЬЭЮЯ╬/; }
@_[1];
}
sub rkdir2html
{
# НЕТ ЛИ В ПЕРВОЙ СТРОКЕ ЗАГЛАВИЯ?
$_=<DOCUMENT>; if ($_ =~ /^ (.*)/) {
$_="<title>$1</title>\n<pre><center><h2>$1</h2>$what_s_new$search_form</center>";
# @kodirowki=("volapuk","windows","iso_8859_5","alt","KOI"); form
for $i (@kodirowki)
{$encoding.="[<a \n href=/cgi-bin/html-$i$ENV{PATH_INFO} >$i</a>]";}
$_.="<li><b>Choose ".$encoding." encoding</b></ul>";
print &KOI($PEREKODER, $_ );
} else {open(DOCUMENT, $filename) ;}
print "<pre><font size=+1>\n";
while (<DOCUMENT>) {
s/^----*$/<hr>/ ;
s/(.*[^ ]) *╬ *([^ \n]*)/<li><A HREF=$2\/Contents>*<IMG ALIGN=absbottom BORDER=0 SRC=internal-gopher-unknown> <\/A><A HREF=$2><b><i>$1<\/i><\/b><\/A>/ ;
print &KOI($PEREKODER, $_ );
}
}
sub Last_Modified
{ # 1 АРГУМЕНТ - ИМЯ ФАЙЛ, ВОЗВРАЩАЕМ СИМВОЛЬНУЮ СТРОКУ ВРЕМЯ МОДИФИКАЦИИ
# 2 АРГУМЕНТ "Full | Brief" - ЗАДАЕТ ФОРМАТ ТЕКСТОВОЙ СТРОКИ С ДАТОЙ
($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst)=gmtime((stat(@_[0]))[9]);
if (@_[1]=~'Brief'){sprintf("%2d-%s-%d",
# 29-Dec-95
$mday,@mesq[$mon],$year);}
elsif(@_[1]=~'Full'){sprintf("%s, %2d-%s-%d %02d:%02d:%02d GMT",
# Fri, 29-Dec-95 22:50:47 GMT
@nedelq[$wday], $mday,@mesq[$mon],$year,$hour,$min,$sec);}
else {sprintf("%s, %2d-%s-%d %02d:%02d:%02d GMT",
@nedelq[$wday], $mday,@mesq[$mon],$year,$hour,$min,$sec);}
}
sub Contents
{
$filename =~ s/\/Contents// ;
$ENV{PATH_INFO} =~ s/\/Contents// ;
$name_link = $ENV{PATH_INFO} ;
$name_link =~ s/.*\/// ; # эТО БУДЕТ ПРОСТОЕ ИМЯ ФАЙЛА
if ( -d $filename ) # еСЛИ Contents ЖМУТ НА КАТАЛОГЕ, ТО ВОЙТИ В НЕГО
{ print "Location: http:$ENV{SCRIPT_NAME}$ENV{PATH_INFO}\n\n" ; exit 0 }
if ($ENV{REMOTE_HOST} =~ /localhost/) { } else {
$Additional_header="Last-modified: ". &Last_Modified($filename,'Full')."\n";}
# бУДЕМ ДАВАТЬ ФАЙЛЫ КУСОЧКАМИ ПО 80 КБ
# $piece_size=81920; # СМ. ВЫШЕ
$filesize=(stat($filename) )[7];
if ( $filesize > $piece_size ) {
$pieces="</font></pre><hr><b><font size=+2>Size $filesize bytes. If you permanently fail getting whole file, download it in 80Kb pieces:\n";
for ($i=1; $i-1 <= ($filesize / $piece_size) ; $i++ )
{$pieces.=sprintf ("<a href=../$name_link/Piece80.%02d>[%d]</a>\n",$i,$i);};
$pieces.="</font></b><hr>";
}
print "Content-type: text/html\n$Additional_header\n".
"<TITLE>$ENV{PATH_INFO}/Contents</TITLE>\n".
"<H1><a href=http:$ENV{SCRIPT_NAME}$ENV{PATH_INFO}>$ENV{PATH_INFO}</a>/Contents</H1>\n".
"<pre><font size=+1><b>\n";
$zagolowok=0;
open(DOCUMENT, $filename) || &file_not_found("Can't open $filename");
while (<DOCUMENT>){
/^ \024(.*)\025(.*)/ && do {
if ($1 =~ /[*]/){
$_="\n<h2><ul><i><a href=../$name_link#$zagolowok>$1</a>$2</i></ul></h3>\n";
}else{
$_="<li><a href=../$name_link#$zagolowok>$1</a>$2\n" ;
}
$zagolowok++;print &KOI($PEREKODER,$_);
};
}
print "</b>";
print $pieces;
exit(0);
}
sub With_big_pictures
{
$filename =~ s/\/with-big-pictures\.html// ;
if ($ENV{REMOTE_HOST} =~ /localhost/) { } else {
$Additional_header="Last-modified: ". &Last_Modified($filename,'Full')."\n";}
print "Content-type: text/html\n$Additional_header\n<pre>";
open(DOCUMENT, $filename) || &file_not_found("Can't open $filename");
while (<DOCUMENT>){
s/\024/<b>/g;
s/\025/<\/b>/g;
s/\036D/<b><i>/g;
s/\036E/<\/b><\/i>/g;
s/^----*$/<hr>/g ;
/^( *)(.*[^ ]) *╬ *([^ \n]*)\.jpg portret/ && do { $url=$3.".jpg" ;
$_="<a href=../$url><img width=280 height=420 src=../$url></a><br>$1$2\n" ;};
/^( *)(.*[^ ]) *╬ *([^ \n]*)\.jpg/ && do { $url=$3.".jpg" ;
$_="<a href=../$url><img width=420 height=280 src=../$url></a><br>$1$2\n" ;};
/^( *)(.*[^ ]) *╬ *([^ \n]*)/ && do { $url=$3 ;
if ($url=~ /^mailto:|^http:|^ftp:|^\//) {$_="$1<A HREF=$url>$2</A>\n" ;}
else {$_="$1<a href=../$url>$2</a>\n" ;}
};
print &KOI($PEREKODER, $_ );
}
exit(0);
}
sub With_icons
{
$filename =~ s/\/with-icons\.html// ;
if ($ENV{REMOTE_HOST} =~ /localhost/) { } else {
$Additional_header="Last-modified: ". &Last_Modified($filename,'Full')."\n";}
print "Content-type: text/html\n$Additional_header\n<pre>";
$zagolowok=0;
open(DOCUMENT, $filename) || &file_not_found("Can't open $filename");
while (<DOCUMENT>){
/^ \024(.*)\025(.*)/ && do { $_="<ul><h2><a name=$zagolowok>$1</a>$2</h2></ul>" ; $zagolowok++;};
s/\024/<b>/g;
s/\025/<\/b>/g;
s/\036D/<b><i>/g;
s/\036E/<\/b><\/i>/g;
s/^----*$/<hr>/g ;
/^( *)(.*[^ ]) *╬ *([^ \n]*)\.jpg portret/ && do { $url=$3.".jpg" ;
$_="<a href=../$url><img width=70 height=105 src=../$3.gif></a><br>$1$2\n";};
/^( *)(.*[^ ]) *╬ *([^ \n]*)\.jpg/ && do { $url=$3.".jpg" ;
$_="<a href=../$url><img width=105 height=70 src=../$3.gif></a><br>$1$2\n";};
/^( *)(.*[^ ]) *╬ *([^ \n]*)/ && do { $url=$3 ;
if ($url=~ /^mailto:|^http:|^ftp:|^\//) {$_="$1<A HREF=$url>$2</A>\n" ;}
else {$_="$1<a href=../$url>$2</a>\n" ;}
};
print &KOI($PEREKODER, $_ );
}
exit(0);
}
sub Directory
{ # БЕЗ АРГУМЕНТОВ ДАДИМ ПОЛНЫЙ СПИСОК ФАЙЛОВ КАТАЛОГА
if (@_[0] eq 'What-s-new'){$Ne_Tolxko_new=0;}else{$Ne_Tolxko_new=1;}
# 'What-s-new' - ТОГДА ДАЕМ ТОЛЬКО ФАЙЛЫ С МОДИФИКАЦИЕЙ < 31 ДНЕЙ
$filename =~ s/\/What-s-new/\// ;
if ($ENV{REMOTE_HOST} =~ /localhost/) { } else {
$Additional_header="Last-modified: ". &Last_Modified($filename,'Full')."\n";}
print "Content-type: text/html\n$Additional_header\n".
"<TITLE>$ENV{PATH_INFO}</TITLE>\n<H1>$ENV{PATH_INFO}</H1>\n".
"<pre>".
" Name Size Last modified\n<hr>";
opendir(dirhandle, $filename)|| &file_not_found("Can't open dir $filename");
while ($fname=readdir(dirhandle)){@dir = ( @dir, $fname );}
foreach $fname (sort @dir) { # ДИРЕКТОРИЮ ЗАЧИТАЛИ В МАССИВ И ОТСОРТИРОВАЛИ
($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
$atime,$mtime,$ctime,$blksize,$blocks) = stat($filename.$fname);
if (-d _ ) {$fname.="/";$image="menu";}else{$image="unknown";}
if (!($fname =~ /^\./ ) && ( $Ne_Tolxko_new || (time()-$mtime < 2678400)) ) {
printf (" <a href=%s><IMG ALIGN=absbottom BORDER=0 SRC=internal-gopher-%s>%-28.28s %9d \t %s \n",$fname,$image,substr($fname,0,24)."</a>", $size, &Last_Modified($filename.$fname,'Brief') );
}
}
exit(0);
}
sub Piece
{ # оТРЕЗАЕМ КУСОЧЕК ЗАПРОШЕННОГО ФАЙЛА/Piece80.02
$ENV{PATH_INFO} =~ s/\/Piece.*// ;
$filename =~ s/\/Piece([0-9]*).([0-9]*)// ;
$piece_size=80*1024;
$piece_number=$2;
$poziciq=$piece_size*($piece_number-1);
$filesize=(stat($filename) )[7];
if ($ENV{REMOTE_HOST} =~ /localhost/) { } else {
$Additional_header="Last-modified: ". &Last_Modified($filename,'Full')."\n";}
#"<TITLE>$ENV{PATH_INFO}/Piece $piece_size beginning at $poziciq</TITLE><pre>\n";
print "Content-type: text/plain\n$Additional_header\n";
if ($filesize < $poziciq ) {
print "You miss - file is shoter, than you request";
exit 1;
}
open(DOCUMENT, $filename) || &file_not_found("Can't open $filename");
seek(DOCUMENT,$poziciq,0) || &file_not_found("Can't seek $pozition $filename");
read(DOCUMENT,$bufer,$piece_size) ;
if ($filename =~ /\.html?$|\.txt$|\.doc$|\.lbl$|\.hlp$|\.[0-9]*$/ )
{ print &KOI ($PEREKODER, $bufer) }
else { print $bufer; }
close (DOCUMENT);
exit (0);
}