#!/usr/local/bin/perl5
#
# 1998/03/29 Ver.0.07
# 1998/06/25 Ver.0.10 Lynx での動作を改善
# 1999/12/12 Ver.0.11
#
# (c) 1998,1999 がま <gama@mvg.biglobe.ne.jp>
#
$copyright = 'アクセス制限もどき Ver.0.11 Copyright 1998 gama';
# ---------------------------------------------------------------------
$date = '/bin/date'; # date コマンドのありか
$cat = '/bin/cat'; # cat コマンドのありか
$dflt_htmlf = 'welcome.htm'; # 省略時の nhhtml ファイル名
# $private_html = '/home4/gama/private_html/'; # 2001/09/20 変更
$private_html = './private_html/';
$ownname = 'private.cgi';
$passwd_file = 'passwd';
# ---------------------------------------------------------------------
$expire = gmtime(time+60*5); #cookie の期限を1分後に設定
# (60秒*5分)
# ---------------------------------------------------------------------
{
$ct = $ENV{"CONTENT_TYPE"};
$cl = $ENV{"CONTENT_LENGTH"};
# ---------------------------------------------------------------------
$|=1; # バッファリングを止める
# ---------------------------------------------------------------------
chdir("$private_html"); # ディレクトリを移動する。
if ( $ct eq "application/x-www-form-urlencoded") {
read(STDIN, $in, $cl);
($file,$user,$word,$submit) = split('&',$in);
$file = &str_decode_from_form($file);
$user = &str_decode_from_form($user);
$word = &str_decode_from_form($word);
$submit = &str_decode_from_form($submit);
if ($submit =~/OK/) {
unless (&check_pass) {
&html_getpass; # require UserID & Password
}
} else {
&html_401; # cancel
}
} else {
$file=$ENV{'QUERY_STRING'};
&get_cookie;
unless (&check_pass) {
&html_getpass; # require UserID & Password
}
}
unless($file) {
$file= $dflt_htmlf; # 省略時の指定
}
if ($file =~ /(.*?)\&(.*?)$/) {
$file =$1;
$q_str =$2; # query string
}
$file=~ s/\.\.+//g; # .. を削除
$file=~ s/\/\/+//g; # // を削除
$file=~ s/^\///; # 先頭の / を削除
if ($file =~ /(.*?)\.(.*?)$/) {
$ext =$2; # 拡張子
}
unless (-r $file) {
&html_notfound;
}
if ($ext =~ /htm|html/i ) {
&ssi;
} elsif ($ext =~ /gif/i ) {
print "Content-type: image/gif\n\n";
system("$cat <$file &");
} elsif ($ext =~ /jpg|jpeg/i ) {
print "Content-type: image/jpeg\n\n";
system("$cat <$file &");
} elsif ($ext =~ /cgi/i ) {
$ENV{'QUERY_STRING'}=$q_str;
system("./$file &");
} else {
&html_a_error;
}
exit;
}
# ---------------------------------------------------------------------
sub check_pass {
my($userid,$passwd);
open (FILE, $passwd_file); # 変換用データファイルを探す。
while (<FILE>) {
chomp; # 最後の改行文字を切り捨てる
($userid, $passwd) = split(/:/);
if ( $user eq $userid ) {
last; # ループを抜ける
}
}
close (FILE);
if ( $user eq $userid && $pass eq $passwd ) {
return 1; # OK!
}
$pass = crypt($word, $passwd);
if ( $user eq $userid && $pass eq $passwd ) {
&set_cookie; # 入力した時だけ set
return 1; # OK!
}
return 0; # NG
}
# Set-Cookie -----------------------------------------------------------
sub set_cookie {
my($enc_user,$enc_pass,$cookie);
$enc_user = &str_encode_for_cookie($user);
$enc_pass = &str_encode_for_cookie($pass);
# path は省略値
$cookie ="Set-Cookie: "
."private=$enc_user&$enc_pass; "
."expires=$expire; "
."\n";
print $cookie;
return;
}
# ---------------------------------------------------------------------
sub get_cookie {
my(@cookie) = split("; ", $ENV{'HTTP_COOKIE'});
foreach (@cookie) {
my($cname, $value) = split("=", $_);
if ($cname eq "private") {
($user,$pass) = split("&",$value); # フィールド毎に分割
last;
}
}
$user = &str_decode_cookie($user);
$pass = &str_decode_cookie($pass);
return;
}
# ---------------------------------------------------------------------
sub html_getpass {
print "Content-type: text/html\n\n";
print <<END;
<HTML>
<HEAD><TITLE>ユーザ名とパスワードの入力</TITLE></HEAD>
<BODY TEXT="#000000" BGCOLOR="#FFFFFF">
<BR>
<BR>
<CENTER>
<TABLE CELLSPACING=0 CELLPADDING=0 BORDER>
<FORM METHOD="POST" ACTION="./$ownname">
<INPUT TYPE="HIDDEN" NAME="file" VALUE="$file">
<TR><TD BGCOLOR="#000080" COLSPAN=3><FONT COLOR="#FFFFFF">ユーザ名とパスワードの入力</FONT></TD></TR>
<TR><TD BGCOLOR="#BFBFBF" COLSPAN=3><BR> 認証情報を入力してください。<BR> </TD></TR>
<TR><TD BGCOLOR="#BFBFBF" COLSPAN=1 > ユーザ名: </TD>
<TD BGCOLOR="#BFBFBF" COLSPAN=2 >
<INPUT NAME="userid" TYPE="TEXT" VALUE="$user" SIZE=40> </TD></TR><BR>
<TR><TD BGCOLOR="#BFBFBF" COLSPAN=1 > パスワード: </TD>
<TD BGCOLOR="#BFBFBF" COLSPAN=2 >
<INPUT NAME="password" TYPE="PASSWORD" VALUE="$word" SIZE=40> </TD></TR>
<TR><TD BGCOLOR="#BFBFBF" COLSPAN=1 WIDTH=25%><BR><BR> </TD>
<TD BGCOLOR="#BFBFBF" COLSPAN=1 ALIGN=CENTER VALIGN=MIDDLE>
<INPUT TYPE="SUBMIT" NAME="submit" VALUE=" OK ">
<INPUT TYPE="SUBMIT" NAME="submit" VALUE="Cancel"></TD>
<TD BGCOLOR="#BFBFBF" COLSPAN=1 WIDTH=25%><BR><BR> </TD></TR>
</FORM>
</TABLE>
</CENTER>
<DIV ALIGN=RIGHT>
<A HREF="http://www2d.biglobe.ne.jp/~gama/cgi/index.cgi"><FONT SIZE=-2>
$copyright</FONT></A>
</DIV>
</BODY>
</HTML>
END
exit;
}
# ---------------------------------------------------------------------
sub html_bad_pass {
print "Content-type: text/html\n\n";
print <<END;
<HTML>
<HEAD><TITLE>private</TITLE></HEAD>
<BODY TEXT="#000000" BGCOLOR="#FFFFFF">
<BR>
<BR>
<CENTER>
<TABLE CELLSPACING=0 CELLPADDING=0 BORDER>
<FORM METHOD="POST" ACTION="./$ownname">
<INPUT TYPE="HIDDEN" NAME="file" VALUE="$file">
<INPUT TYPE="HIDDEN" NAME="user" VALUE="$user">
<INPUT TYPE="HIDDEN" NAME="pass" VALUE="$pass">
<TR><TD BGCOLOR="#000080" ><FONT COLOR="#FFFFFF">private</FONT></TD></TR>
<TR><TD BGCOLOR="#BFBFBF" ALIGN=CENTER VALIGN=MIDDLE>
<BR>
認証に失敗しました。再入力しますか？ <BR>
<BR>
<BR>
<INPUT TYPE="SUBMIT" NAME="submit" VALUE=" OK ">
<INPUT TYPE="SUBMIT" NAME="submit" VALUE="Cancel">
<BR>
<BR>
</TD>
</TR>
</FORM>
</TABLE>
</CENTER>
</BODY>
</HTML>
END
exit;
}
# ---------------------------------------------------------------------
sub html_a_errorr {
print "Content-type: text/html\n\n";
print <<END;
<HTML>
<HEAD><TITLE>Aprication Error</TITLE>
<BODY><H1>Aprication Error</H1>
This aprication has encountered an internal error
which prevents it from fulfilling your request.
<BR><BR>This message from $ownname.<BR>
</BODY>
</HTML>
END
exit;
}
# ---------------------------------------------------------------------
sub html_s_errorr {
print "Content-type: text/html\n\n";
print <<END;
<HTML>
<HEAD><TITLE>Server Error</TITLE>
<BODY><H1>Server Error</H1>
This server has encountered an internal error
which prevents it from fulfilling your request.
<BR><BR>This message from $ownname.<BR>
</BODY>
</HTML>
END
exit;
}
# ---------------------------------------------------------------------
sub html_notfound {
print "Content-type: text/html\n\n";
print <<END;
<HTML>
<HEAD><TITLE>Not Found</TITLE>
<BODY><H1>Not Found</H1>
The requested object does not exist on this server.
The link you followed is either outdated, inaccurate,
or the server has been instructed not to let you have it.
<BR><BR>This message from $ownname.<BR>
</BODY>
</HTML>
END
exit;
}
# ---------------------------------------------------------------------
sub html_401 {
print "Content-type: text/html\n\n";
print <<END;
<HTML>
<HEAD><TITLE>Authorization Required</TITLE></HEAD>
<BODY><H1>Authorization Required</H1>
This server could not verify that you are authorized to access
the document you requested.
Either you supplied the bad credentials (e.g., bad password),
or your browser doesn't understand how to supply the credentials
required.
<BR><BR>This message from $ownname.<BR>
</BODY>
</HTML>
END
exit;
}
# ---------------------------------------------------------------------
sub str_decode_from_form {
my($str)=$_[0]; # サブルーチンの引数を
$str=~ s/^\w+=//; # = までを削除・・・
$str=~ s/\+/ /g; # + を space へ
$str=~ s/%(..)/pack("c",hex($1))/ge; # decode
$str=~ s/\r//g; # LF を削除
return($str);
}
# ---------------------------------------------------------------------
sub str_encode_for_cookie {
my($str)=$_[0]; # サブルーチンの引数を
$str=~ s/ /%20/g; # encode
$str=~ s/,/%2C/g; # encode
$str=~ s/;/%3B/g; # encode
$str=~ s/&/%26/g; # encode
return($str);
}
# ---------------------------------------------------------------------
sub str_decode_cookie {
my($str)=$_[0]; # サブルーチンの引数を
$str=~ s/^\w+=//; # = までを削除・・・
$str=~ s/%(..)/pack("c",hex($1))/ge; # decode
return($str);
}
# ---------------------------------------------------------------------
sub ssi {
$timefmt = ""; # timefmt の初期値
$|=1;
print "Content-type: text/html\n\n";
# <!--#exec cmd="./command&arg" --> という記述の処理
# <!--#echo var="REMOTE_HOST" --> という記述の処理
# <!--#config timefmt="%y/%m/%d %H:%M:%S" -->
# <!--# と --> が同じ行内にある場合しか考慮していない
open(FHTML,"<$file");
while (<FHTML>) {
while (/<!--#/) { # 1 line に複数記述に対応
print $`; # "<!--#" より前を出力
$_=$&.$'; # マッチした分とその後ろ
$ssicmd=$'; # 後ろだけ
$ssicmd=~ /\s/; # 空白文字を探してその後ろ
$ssicmd=$`; # exec or echo
if ( $ssicmd eq "exec" ) {
&exec_proc;
} elsif ( $ssicmd eq "echo" ) {
&echo_proc;
} elsif ( $ssicmd eq "config" ) {
&config_proc;
} else {
&error_proc;
}
}
#### <IMG SRC="./a.gif"> ==> <IMG SRC="$ownname?a.gif"> ###
#### <A HREF="./a.htm"> ==> <A HREF="privat.cgi?a.htm"> ###
s/(<.+?[src|href]=")\.\/(.+?".*?>)/$1$ownname\?$2/i;
#### <A HREF="privat.cgi?a.htm?para"> ###
s/(<.+?[src|href]="$ownname\?.+?)\?(.+?".*?>)/$1&$2/i;
print $_;
}
close(FHTML);
}
# /////////////////////////////////////////////////////////////////////////
sub exec_proc {
my($cgi)="";
my($tail)="";
if (/cmd=\"/ ) { # cmd="
$cgi=$'; # 後
} elsif (/cgi=\"/ ) { # cgi="
$cgi=$'; # 後
}
if ($cgi=~/\"/) { # " (閉じ)
$cgi=$`; # 前
$tail=$'; # 後
}
if ($tail=~/-->/) {
$_=$'; # 後
$cgi =~ s/\?/ /g; # ? をスペースへ
open(PROC,"$cgi|"); # 実行
while ($r = <PROC>) { # 結果を読み出す
print $r;
}
close(PROC);
} else {
&error_proc;
}
}
# /////////////////////////////////////////////////////////////////////////
sub config_proc {
if (/timefmt=\"/ ) { # timefmt="
$fmt=$'; # 後
$fmt=~/\"/; # " (閉じ)
$fmt=$`; # 前
$tail=$'; # 後
$timefmt="+\'$fmt\'";
}
if ($tail=~/-->/) {
$_=$'; # 後
} else {
&error_proc;
}
}
#/////////////////////////////////////////////////////////////////////////
sub echo_proc {
my($var)="";
my($tail)="";
if (/var=\"/ ) { # var="
$var=$'; # 後
}
if ($var=~/\"/) { # " (閉じ)
$var=$`; # 前
$tail=$'; # 後
}
if ($tail=~/-->/) {
$_=$'; # 後
if ($var eq "DATE_LOCAL") {
open(PROC,"$date $timefmt |");
while ($r = <PROC>) { # 結果を読み出す
chop($r);
print $r;
}
close(PROC);
} elsif ($var eq "DATE_GMT") {
open(PROC,"$date -u $timefmt |");
while ($r = <PROC>) { # 結果を読み出す
chop($r);
print $r;
}
close(PROC);
} elsif ($var eq "REMOTE_HOST" || $var eq "HTTP_X_FORWARDED_FOR") {
if ($var eq "REMOTE_HOST" ) {
$ENV{$var} = $ENV{'REMOTE_ADDR'};
}
unless ( $r = gethostbyaddr(pack('C4',split(/\./,$ENV{$var})),2)) {
$r = $ENV{$var};
}
print $r;
} else {
print $ENV{$var};
}
} else {
&error-proc;
}
}
#/////////////////////////////////////////////////////////////////////////
sub error_proc {
if (/-->/) {
print $`.$&; # "-->" までを出力
$_=$'; # "-->" の後
} else {
print $_; # 記述が理解できないので出力
$_=""; # 空にする
}
}