#! /usr/bin/perl # - DIRECTORY GATE ver 2.10 / Last updated on Mar 2, 2007 # - (C)2007 WEB POWER. All Rights Reserved. use strict; use vars qw( @EXE_SUFFIX @SSI_SUFFIX @DEFAULT_INDEX $HIDDEN %INI %SYS %CGI %SIO $JCODE $JCODE2 $CHARSET $VERSION $PATH_INFO $SESSION_FILE $SESSION_ID $USER_FILE $USER_AGENT $MODE $UTN ); #━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━┓ # ↓ 初期設定はここからです ┃ #━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━┛ # ≪注意事項≫ # ※ ▼の項目は必ず設定してください。▽の項目は必要に応じて設定してください。 # ※ 基本的に数字以外は''内に記述します。'を入れたい場合、中の'は \'にします。 # (例) × $var = value; → ○ $var = 'value'; # (例) × $var = 'I can't'; → ○ $var = 'I can\'t'; # ※ $ # ; ' などの記号類は間違って消さないように注意してください。 # ※ 1文字のミスでもプログラムは動きません。設定・編集は慎重にしましょう。 # ※ 行の頭に"#"を付けると、その行は無効となります。(コメントアウト) # ※ 値を設定しない場合は、''にするかコメントアウトしてください。 # (例) × $var = ; → ○ $var = ''; # ※ 詳しくはサイトの解説を参照してください。 # ○ タイトル (TITLE要素等で表示) $INI{'TITLE'} = '東京大学洋弓部現役部員ログインページ'; # ● サインアウト後の戻り先URL (仮想パスかURLで指定します) $INI{'BACK_URL'} = 'http://www.ut-archery.jp/'; # ○ BODY要素の属性 (の***の部分) $INI{'BODY'} = 'text="#000000" link="#0000FF"'; # ○ アクセスログ (0:取らない／1:月毎に取る／2:週毎に取る／3:日毎に取る) # * アクセス数に応じて 月毎 < 週毎 < 日毎 を推奨します。 $INI{'LOG'} = 1; # ○ ユーザー名入力方式 (0:直接入力／1:セレクトメニュー選択) # * 登録ユーザー数が多い場合やユーザー名を第三者に見られては困る場合は0にします。 $INI{'SELECT'} = 0; # ○ サインインページのフッターに表示するHTML $INI{'FOOTER'} = <<'__HTML__';

点数プロットページはこちらからどうぞ。

__HTML__ #---<登録設定>------------------------------------------------------------------ # # * このソフトを有料コンテンツに使用される場合のみライセンス登録が必要です。 # (詳細は付属のマニュアルを参照してください) # * 登録済みの場合、ライセンスコードとライセンス数を設定してください。 # * 設定した場合は、行頭の"$"の前のシャープ"#"は取り除いてください。 # # ◎ ライセンスコード (半角) #$INI{'LICENSE_CODE'} = '????-S6????'; #---<挿入設定>------------------------------------------------------------------ # # * 各ページのヘッダー部やフッター部にHTMLを挿入できます。 # * 各ページに共通のタイトルロゴやクレジットを入れたい場合に有用です。 # # ○ CGIで出力されたページにも以下の挿入設定を有効に (1:する／0:しない) # * この設定が有効になっていると、Content-Lengthヘッダーを出力しているCGI(ほ # とんど無いと思いますが)が正常に表示されない場合があります。 $INI{'CGI_INSERT'} = 0; # ○ 各ページのヘッダー部に挿入するHTML (${USERNAME}はユーザー名に置換) $INI{'INS_HEADER'} = <<'__HTML__'; __HTML__ # ○ 各ページのフッター部に挿入するHTML (${USERNAME}はユーザー名に置換) $INI{'INS_FOOTER'} = <<'__HTML__'; __HTML__ # ○ 各ページのBODY要素に挿入するBODY要素の属性 (の***の部分) #INI{'INS_BODY'} = ''; #---<パス/URLの設定>------------------------------------------------------------ # # * パス、URLはすべて半角で指定してください。(全角は一切使えません) # * [パス]とはサーバー内での場所です。http://で始まるURLとは違うものです。 # * 相対パスとはスクリプトの場所を基準としたパスの指定です。 # ../ => 1つ上のディレクトリ ./ => 同じディレクトリ # * 絶対パスとはサーバー内の一番上のディレクトリを基準としたパスの指定です。 # /usr/lib/sendmail /home/foo/public_html/cgi-bin/script.cgi # * 仮想アドレスとはURLの一部分(ドメイン名以降)を指します。 # http://www.domain.com/~foo/cgi-bin/script.cgi # ^ ドメイン名の後のスラッシュ"/"以降の部分 # (/~foo/cgi-bin/script.cgi のこと) # ● アクセス制限するファイルを置くディレクトリのパス (http://では指定不可) # * 絶対パスか相対パスで指定します。(絶対パスが分かる場合はそちらを推奨) # * 外部から直接アクセスできない場所(public_htmlの外)を指定します。できない場 # 合は、ディレクトリ名を複雑なものにしてください。 $SYS{'BASE_DIR'} = '/virtual/www/archer/1qazxdr5/'; # ● ユーザーファイルがあるディレクトリの絶対パス (http://では指定不可) # * 絶対パスか相対パスで指定します。(絶対パスが分かる場合はそちらを推奨) # * ユーザー・マネージャーのデータディレクトリのパスを指定します。 # * このディレクトリのパーミッションは777(書き込み属性)にしてください。 # * 上の $SYS{'BASE_DIR'} とは必ず別ディレクトリにしてください。 $SYS{'DATA_DIR'} = 'gatedata/'; # ○ ユーザーファイルの名前 (拡張子は付けない) # * 拡張子".usr"は自動的に付けられるため不要です。 $SYS{'FILE_NAME'} = 'user'; #---<応用設定>------------------------------------------------------------------ # # * これより下の項目は必要に応じて設定してください。 # * 通常は初期状態のままでも問題なく動作します。 # # ○ ファイルロック (1:使う／0使わない) $SYS{'USE_LOCK'} = 1; # ○ パスワード不一致許容回数 (0:無制限／1〜:) # * パスワードをここで指定した回数間違えると一定時間認証を拒否します。 $INI{'LIMIT'} = 5; # ○ ブラウザキャッシュを (0:許可する／1:許可しない) # * キャッシュを許可しない設定にした場合、ブラウザへコンテンツがキャッシュさ # れなくなるため、セキュリティーは高くなりますが、サーバーへの負荷が非常に # 大きくなります。 $INI{'NO_CACHE'} = 0; # ○ セッション有効時間[分] (1〜) # * ここで指定した時間(分)の無通信状態が続くとタイムアウトとなります。 $INI{'EXPIRES'} = 360; # ○ タイムゾーン (GMT=英国ロンドンとの時差) *日本は9時間 $INI{'TIME_ZONE'} = 9; # ○ CGIとして実行するファイルの拡張子 @EXE_SUFFIX = ('.cgi', '.php'); # ○ SSIとして実行するファイルの拡張子 @SSI_SUFFIX = ('.shtml', '.stm'); # ○ デフォルトインデックス (ファイル名を省略した場合に参照するファイル名) @DEFAULT_INDEX = ('index.html', 'index.htm', 'index.shtml', 'index.cgi'); # ○ クッキーの名前 *オプション # * 省略時はユーザーファイル名から自動生成されます。 $INI{'COOKIE_NAME'} = ''; # ○ クッキーの有効範囲 (仮想パス) *オプション #$INI{'COOKIE_PATH'} = "/"; # ○ クッキーの暗号化に使うキー (適当な英数字10文字で) # * パスワードではないので、メモしたり覚えたりする必要はありません。 $INI{'COOKIE_PASS'} = 'tBcDqXtx4v'; #━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━ # # ▽ サーバー名を指定してください。 (通常は設定不要) # * "www.hostname.jp"と"hostname.jp"のようにアクセスできるホスト名が複数ある # 場合、標準として使うホスト名を指定します。 # * スキーム"http://"やスラッシュ"/"は含めないでください。 # * 設定した場合は、行頭の"$"の前のシャープ"#"は取り除いてください。 #$ENV{'SERVER_NAME'} = 'hostname.jp'; # ▽ このCGIの仮想パスを指定してください。 (通常は設定不要) # * パス情報(PATH_INFO)が正しく取得できない場合は設定してください。 # * ホスト名の"/"以降の部分が仮想パスです。 # * 必ずスラッシュ"/"から指定してください。 # * 設定した場合は、行頭の"$"の前のシャープ"#"は取り除いてください。 #$ENV{'SCRIPT_NAME'} = '/~foo/bar/filename.cgi'; #━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━┓ # ↑ 初期設定はここまでです ┃ #━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━┛ #main { # ! 局所変数宣言 my($err_msg, %cookie); #binmode STDOUT; # Windows系OSの場合はこの行のコメントを解除 $VERSION = q$DIRECTORY_GATE/2.10$; # バージョン情報(編集禁止) $SYS{'REQ_METHOD'} = 'POST'; # リクエストメソッド(GET/POST) require 'stdio.pl'; # ソースコードの文字コード認識 if (ord "漢" == 0xb4 || ord "漢" == -76) { $JCODE = "euc"; $JCODE2 = "EUC-JP"; $CHARSET = "; charset=EUC-JP"; } elsif (ord "漢" == 0x8a || ord "漢" == -118) { $JCODE = "sjis"; $JCODE2 = "Shift_JIS"; $CHARSET = "; charset=Shift_JIS"; } elsif (ord "漢" == 0x1b) { $JCODE = "jis"; $JCODE2 = "ISO-2022-JP"; $CHARSET = "; charset=ISO-2022-JP"; } elsif (ord "漢" == 0xe6) { $JCODE = "uft8"; $JCODE2 = "UTF-8"; $CHARSET = "; charset=UTF-8"; } # 環境変数 / 標準入力データ設定 %CGI = %SIO = (); $SYS{'PROTOCOL'} = $ENV{'HTTPS'} eq "on" ? "https" : "http"; $ENV{'PATH_INFO'} =~ s/^$ENV{'SCRIPT_NAME'}// if ($ENV{'PATH_INFO'} eq $ENV{'SCRIPT_NAME'}); $CGI{'HTTP_REFERER'} = substr($ENV{'HTTP_REFERER'}, 0, 256); $CGI{'HTTP_REFERER'} =~ s/%7E/~/gi; $CGI{'HTTP_USER_AGENT'} = substr($ENV{'HTTP_USER_AGENT'}, 0, 256); $CGI{'HTTP_USER_AGENT'} =~ tr/<>"&/()'-/; if ($ENV{'PATH_INFO'} eq "" && $ENV{'REQUEST_URI'} ne $ENV{'SCRIPT_NAME'}) { $ENV{'PATH_INFO'} = $ENV{'REQUEST_URI'}; $ENV{'PATH_INFO'} =~ s/^$ENV{'SCRIPT_NAME'}//; $ENV{'PATH_INFO'} =~ s/\?.*$//; } elsif ($ENV{'PATH_INFO'} eq $ENV{'REQUEST_URI'}) { $ENV{'PATH_INFO'} =~ s/^$ENV{'SCRIPT_NAME'}//; } if ($CGI{'SCRIPT_URI'}) { ($CGI{'SERVER_NAME'}, $CGI{'SCRIPT_PATH'}) = (split /\//, $CGI{'SCRIPT_URI'}, 4)[2,3]; $CGI{'SCRIPT_PATH'} = "/$CGI{'SCRIPT_PATH'}"; } else { $CGI{'SCRIPT_PATH'} = $ENV{'SCRIPT_NAME'} if (!$CGI{'SCRIPT_PATH'}); $CGI{'SERVER_NAME'} = $ENV{'SERVER_NAME'} if (!$CGI{'SERVER_NAME'}); $CGI{'SCRIPT_URI'} = "$SYS{'PROTOCOL'}://$CGI{'SERVER_NAME'}$CGI{'SCRIPT_PATH'}"; } $CGI{'SCRIPT_NAME'} = $1 if ($ENV{'SCRIPT_NAME'} =~ /([^\\\/]+$)/); $ENV{'REMOTE_ADDR'} = $ENV{'REMOTE_ADDR'}; if ($ENV{'REMOTE_HOST'} eq $ENV{'REMOTE_ADDR'} || !$ENV{'REMOTE_HOST'}) { $ENV{'REMOTE_HOST'} = gethostbyaddr(pack('C4',split(/\./, $ENV{'REMOTE_ADDR'})),2); $ENV{'REMOTE_HOST'} = $ENV{'REMOTE_ADDR'} if (!$ENV{'REMOTE_HOST'}); } # クッキー名を取得 (ユーザーファイル名を暗号化したもの) if ($INI{'COOKIE_NAME'} eq "") { $INI{'COOKIE_NAME'} = crypt $SYS{'FILE_NAME'}, substr($SYS{'FILE_NAME'}, -2, 2); $INI{'COOKIE_NAME'} = $INI{'COOKIE_NAME'} =~ /^\$1\$/ ? substr $INI{'COOKIE_NAME'}, 6 : substr $INI{'COOKIE_NAME'}, 2; $INI{'COOKIE_NAME'} =~ tr/\.\//-_/; } $INI{'COOKIE_PATH'} = $CGI{'SCRIPT_PATH'} if ($INI{'COOKIE_PATH'} eq ""); # ファイル名の設定 if ($SYS{'BASE_DIR'} !~ /^(\w:|\/)/) { my($full) = $ENV{'SCRIPT_FILENAME'}; $full =~ s/[^\/]*$//; foreach (split /\//, $SYS{'BASE_DIR'}) { next if ($_ eq "."); if ($_ eq "..") { $full =~ s/[^\/]*\/$//; } else { $full .= "$_/"; } } $SYS{'BASE_DIR'} = $full; } if ($SYS{'DATA_DIR'} !~ /^(\w:|\/)/) { my($full) = $ENV{'SCRIPT_FILENAME'}; $full =~ s/[^\/]*$//; foreach (split /\//, $SYS{'DATA_DIR'}) { next if ($_ eq "."); if ($_ eq "..") { $full =~ s/[^\/]*\/$//; } else { $full .= "$_/"; } } $SYS{'DATA_DIR'} = $full; } $USER_FILE = "$SYS{'DATA_DIR'}$SYS{'FILE_NAME'}.usr"; $SESSION_FILE = "$SYS{'DATA_DIR'}$SYS{'FILE_NAME'}.ses"; # キャリア判別と個体識別情報の取得 if (index($ENV{'HTTP_USER_AGENT'}, "DoCoMo") != -1 && ($::SYS{'MOBILE_NOCHECK'} || index($ENV{'REMOTE_ADDR'}, "210.153.84") == 0 || index($ENV{'REMOTE_ADDR'}, "210.136.161") == 0)) { $::UTN = $1 if ($ENV{'HTTP_USER_AGENT'} =~ /(ser\w{11,15})/); $::USER_AGENT = "i"; } elsif ((index($ENV{'HTTP_USER_AGENT'}, "J-PHONE") != -1 || index($ENV{'HTTP_USER_AGENT'}, "Vodafone") != -1 || index($ENV{'HTTP_USER_AGENT'}, "SoftBank") != -1) && ($::SYS{'MOBILE_NOCHECK'} || checkIPaddr(qw(202.179.204.0/24 202.253.96.248/29 210.146.7.192/26 210.146.60.192/26 210.151.9.128/26 210.169.130.112/29 210.169.130.120/29 210.169.176.0/24 210.175.1.128/25 210.228.189.0/24 211.8.159.128/25)))) { $::UTN = $1 if ($ENV{'HTTP_USER_AGENT'} =~ /\/(SN[^ ]+) /); $::USER_AGENT = "s"; } elsif ((index($ENV{'HTTP_USER_AGENT'}, "KDDI") != -1 || index($ENV{'HTTP_USER_AGENT'}, "UP.Browser") != -1) && ($::SYS{'MOBILE_NOCHECK'} || checkIPaddr(qw(210.169.40.0/24 210.196.3.192/26 210.196.5.192/26 210.230.128.0/24 210.230.141.192/26 210.234.105.32/29 210.234.108.64/26 210.251.1.192/26 210.251.2.0/27 211.5.1.0/24 211.5.2.128/25 211.5.7.0/24 218.222.1.0/24 61.117.0.0/24 61.117.1.0/24 61.117.2.0/26 61.202.3.0/24 219.108.158.0/26 219.125.148.0/24 222.5.63.0/24 222.7.56.0/24)))) { $::UTN = $ENV{'HTTP_X_UP_SUBNO'}; $::USER_AGENT = "e"; } else { $::USER_AGENT = "OTHER"; } #$::USER_AGENT = "iMODE"; $ENV{'HTTP_USER_AGENT'} = 'DoCoMo/2.0 P900i(c100;TB;W20H09)'; # モードの取得とファイル名の設定 if ($ENV{'PATH_INFO'} =~ s/\/DIRGATE=([-\w]*)//) { $MODE = $1; } $PATH_INFO = substr $ENV{'PATH_INFO'}, 1; # サインイン前の条件分岐 if ($MODE eq "LOGIN") { &Login; # サインイン } elsif ($MODE eq "COOKIE_ERROR") { &Show_CookieError; # クッキーエラーページ表示 } elsif ($MODE eq "SOFTWARE_KEYBOARD") { &Show_SoftwareKeyboard; # ソフトウェアキーボード表示 } elsif ($MODE eq "QUICK_LOGIN" && $USER_AGENT ne "OTHER") { Show_LoginPage('quick_login'); # クイックサインイン設定ページ表示 } # セッションIDの取得 if ($USER_AGENT ne "OTHER") { $SESSION_ID = $1 if ($PATH_INFO =~ /^([A-Za-z0-9]{16})/); } elsif (stdio::getCookie(\%cookie, $INI{'COOKIE_NAME'})) { $SESSION_ID = $cookie{'SID'} if ($cookie{'SID'} =~ /^[A-Za-z0-9]{16}$/); } # <セッションIDが取得できれば> if ($SESSION_ID) { # セッション情報取得に成功 => セッション有効期限を指定分延長 if (stdio::getSession($SESSION_FILE, \%cookie, $SESSION_ID, $INI{'EXPIRES'}*60)) { # IPチェック・認証時のIPと異なっている場合 (for PC) if ($USER_AGENT eq "OTHER" && $cookie{'IP'} ne $ENV{'REMOTE_ADDR'}) { $err_msg = qq|

　認証IPアドレス不一致のため再サインインしてください。
\n| . qq|　認証時のIPアドレス($cookie{'IP'})と現在のIPアドレス($ENV{'REMOTE_ADDR'})が異なっています。

|; # UAチェック・認証時のUAと異なっている場合 (for ケータイ) } elsif ($USER_AGENT ne "OTHER" && $cookie{'UA'} ne $CGI{'HTTP_USER_AGENT'}) { $err_msg = qq|

　認証端末不一致のため再サインインしてください。
\n| . qq|　認証時の端末($cookie{'UA'})と現在の端末($CGI{'HTTP_USER_AGENT'})が異なっています。

|; # 有効期限切れ } elsif ($cookie{'EX'} && $cookie{'EX'} < time) { $err_msg = qq|

　有効期限が切れました。
\n| . qq|　セッションもしくはアカウントの有効期限が切れたためサインアウトしました。

|; } else { # ★ この時点で認証成功 ---------------------------------- # サインアウト? => セッション解放 if ($MODE eq "LOGOUT") { &Logout($cookie{'ID'}, $cookie{'SID'}, $cookie{'IN'}); } &Show_Document($cookie{'ID'}); } # タイムアウト } else { $err_msg = qq|

　セッションタイムアウトのため再サインインしてください
\n| . qq|　無通信状態が$INI{'EXPIRES'}分以上続いたため、セッションがタイムアウトになりました。

|; } } # $ENV{'PATH_INFO'} =~ s/\/[A-Za-z0-9]{16}// if ($USER_AGENT ne "OTHER"); # サインインページ表示(デフォルト) &Show_LoginPage($err_msg); exit; }# #──────────────────────────────────────── # ■ サインインページ(フォーム)を表示する # # 呼出元 : main # 引 数 : (冒頭に表示するメッセージ) # 戻り値 : (終了) #──────────────────────────────────────── sub Show_LoginPage #($header_msg) { # →仮引数 my($header_msg) = @_; # ! 局所変数宣言 my(%value, %cookie, $argv, $userform, $onload, $license); if ($header_msg eq "") { if ($USER_AGENT eq "OTHER") { $header_msg = "

　これより先のページはユーザー認証が必要です。
\n" . "　ユーザー名とパスワードを入力して認証してください。

"; } else { $header_msg = "

これより先のﾍﾟｰｼﾞはｻｲﾝｲﾝが必要です｡

\n" } } $license = " (ライセンス番号 : $INI{'LICENSE_CODE'})" if ($INI{'LICENSE_CODE'} =~ /^\d{4}-[A-Z]\d{5}/); # フォームの初期値の設定 if ($MODE eq "LOGIN") { $value{'DIRGATE_username'} = $SIO{'DIRGATE_username'}; $value{'DIRGATE_save'} = ' checked="checked"' if ($SIO{'DIRGATE_save'}); } elsif (stdio::getCookie(\%cookie, "$INI{'COOKIE_NAME'}.2", $INI{'COOKIE_PASS'})) { $value{'DIRGATE_username'} = $cookie{'USER'}; $value{'DIRGATE_password'} = $cookie{'PASS'}; $value{'DIRGATE_save'} = ' checked="checked"' if ($cookie{'USER'}); } # クエリー文字列の設定 if (@ARGV) { $argv = join "+", @ARGV; $argv =~ tr/\t\a\b\e\f\0//d; $argv =~ s/&/&/g; $argv =~ s/"/"/g; $argv =~ s//>/g; $argv =~ s/\x0D\x0A|\x0D|\x0A/ /g; } if (!%SIO) { my($buffer); if ($ENV{'REQUEST_METHOD'} eq 'POST') { read STDIN, $buffer, $ENV{'CONTENT_LENGTH'}; } else { $buffer = $ENV{'QUERY_STRING'}; } foreach (split /[&;]/o, $buffer) { my($key, $val) = split /=/, $_, 2; stdio::urldecode(\$key); $key =~ tr/\t\a\b\e\f\0//d; $key =~ s/\x0D\x0A|\x0D|\x0A/\n/g; $key =~ s/&/&/g; $key =~ s/"/"/g; $key =~ s//>/g; $key =~ s/\n/ /g; stdio::urldecode(\$val); $val =~ tr/\t\a\b\e\f\0//d; $val =~ s/\x0D\x0A|\x0D|\x0A/\n/g; $val =~ s/&/&/g; $val =~ s/"/"/g; $val =~ s//>/g; $val =~ s/\n/ /g; if ($key !~ /^DIRGATE_/) { $HIDDEN .= qq| \n|; } $SIO{$key} = $val; } } # ユーザー名選択方式 if ($INI{'SELECT'}) { if (open IN, $USER_FILE) { my(@user); while () { push @user, (split /\t/, $_, 2)[0]; } close OUT; @user = sort @user; $userform = qq| \n|; $onload = ""; } } elsif ($USER_AGENT eq "OTHER") { $userform = qq||; $onload = ' onLoad="document.loginForm.DIRGATE_username.focus()"'; } else { $userform = qq||; } # HTML表示開始 print "Content-Type: text/html", $CHARSET, "\n" . "Cache-Control: no-cache\n" . "Pragma: no-cache\n" . "\n"; if ($USER_AGENT eq "OTHER") { print <<__HTML__; } elsif ($header_msg eq 'quick_login') { print <<__HTML2__; } else { print <<_EOF3_; } $INI{'TITLE'} [ユーザー認証]

ユーザー認証

$header_msg
$HIDDEN
ユーザー名 : $userform
パスワード :
オプション : ユーザー名とパスワードを保存
　
$INI{'FOOTER'}
$::VERSION
Powered by WEBPOWER
__HTML__ $INI{'TITLE'} [ｸｲｯｸｻｲﾝｲﾝ]

ｸｲｯｸｻｲﾝｲﾝ

$HIDDEN

■ﾕｰｻﾞｰ名
$SIO{'DIRGATE_username'}

■ﾊﾟｽﾜｰﾄﾞ
(非表\示)

※このﾍﾟｰｼﾞを画面ﾒﾓ･ﾏｲﾘﾝｸに登録してください｡

__HTML2__ $INI{'TITLE'} [ﾕｰｻﾞｰ認証]

ﾕｰｻﾞｰ認証

$header_msg
$HIDDEN

■ﾕｰｻﾞｰ名
$userform

■ﾊﾟｽﾜｰﾄﾞ

WEBPOWER

_EOF3_ exit; }# #──────────────────────────────────────── # ■ サインイン # # 呼出元 : main # 引 数 : (なし) # 戻り値 : (終了) #──────────────────────────────────────── sub Login #(void) { # ! 局所変数宣言 my(%session, @field, @err_msg, $result, $session_id, $count, $argv, $expires, $username, $last_login); { my($buffer); if ($ENV{'REQUEST_METHOD'} eq 'POST') { read STDIN, $buffer, $ENV{'CONTENT_LENGTH'}; } else { $buffer = $ENV{'QUERY_STRING'}; } foreach (split /[&;]/o, $buffer) { my($key, $val) = split /=/, $_, 2; stdio::urldecode(\$key); $key =~ tr/\t\a\b\e\f\0//d; $key =~ s/\x0D\x0A|\x0D|\x0A/\n/g; $key =~ s/&/&/g; $key =~ s/"/"/g; $key =~ s//>/g; $key =~ s/\n/ /g; stdio::urldecode(\$val); $val =~ tr/\t\a\b\e\f\0//d; $val =~ s/\x0D\x0A|\x0D|\x0A/\n/g; $val =~ s/&/&/g; $val =~ s/"/"/g; $val =~ s//>/g; $val =~ s/\n/ /g; if ($key !~ /^DIRGATE_/) { $HIDDEN .= qq| \n|; } $SIO{$key} = $val; } } if ($SIO{'DIRGATE_username'} eq "") { push @err_msg, "ユーザー名を入力してください。"; } if ($SIO{'DIRGATE_password'} eq "") { push @err_msg, "パスワードを入力してください。"; } # リトライリミットチェック if (!@err_msg) { if ($INI{'LIMIT'}) { $session_id = "<$SIO{'DIRGATE_username'}" . sprintf("%02X%02x%02X%02x", split(/\./, $ENV{'REMOTE_ADDR'})) . ">"; # ↓行をコメント解除／↑行をコメントアウトするとIPアドレスに関係なく認証失敗がリミットに達するとID一時凍結 #$session_id = "<$SIO{'DIRGATE_username'}>"; if (stdio::getSession($SESSION_FILE, \%session, $session_id)) { $count = $session{'COUNT'}; if ($count && $count >= $INI{'LIMIT'}) { push @err_msg, qq|ユーザー名[$SIO{'DIRGATE_username'}]はセキュリティーロック中です
\n| . '→認証失敗回数が一定回数に達したためセキュリティーロックが掛かっています。時間をおいて再試行してください。'; } } } } # 認証 if (!@err_msg) { ($result, @field) = authorize_User($USER_FILE, $SIO{'DIRGATE_username'}, $SIO{'DIRGATE_password'}); if ($result == -2) { show_ErrorPage('[00]ファイル書込エラー', 'テンポラリファイルへの書き込みに失敗しました', "

　テンポラリファイルの上書きオープンに失敗しました。
\n" . "　ユーザーファイルがあるディレクトリのパス(場所)の指定は正しいか、指定されたパスにディレクトリが存在するか、パーミッション(読み書き権)は正しく設定されているを確認してください。

"); } elsif ($result == -3) { show_ErrorPage('[01]ファイル読込エラー', 'ユーザーファイルの読み込みに失敗しました', "

　ユーザーファイルを読み込みオープンに失敗しました。
\n" . "　ユーザーファイルがあるディレクトリのパス(場所)の指定は正しいか、指定されたパスにディレクトリが存在するか、パーミッション(読み書き権)は正しく設定されているを確認してください。

"); } elsif ($result == -4) { show_ErrorPage('[02]排他制御中', 'ただいま混み合っています', "

　ただいまシステムへのアクセスが集中しており、あなたがご使用の端末からのリクエスト処理を保留しています。恐れ入りますが、しばらく待ってから再試行してください。繰り返しこの画面が表\示される場合、時間をずらして再試行してください。(リロードすることで再試行できます)

"); } elsif ($result == -1) { # ユーザー名該当無し push @err_msg, qq|該当するユーザー名が見つかりません。
\n| . qq|→入力されたユーザー名[$SIO{'DIRGATE_username'}]はデータベースに登録されていません。|; } elsif ($result == 0) { # パスワード不正 if ($INI{'LIMIT'}) { $count ++; # 認証失敗回数を記録 (第4引数は回数をリセットするまでの秒数) stdio::setSession($SESSION_FILE, {"COUNT"=>$count}, $session_id, 10800); } push @err_msg, qq|パスワードが不正です。
\n| . qq|→大文字小文字の区別は正しいか、[CapsLock]がオンになっていないか等を確認の上、再入力してください。|; # 認証自体は成功しているが…有効期限切れ } elsif ($result == 1 && $field[8] ne "" && $field[8] - time <= 10) { push @err_msg, qq|アカウントの有効期限が切れています。
\n| . qq|→詳細は管理者にお問い合わせください。\n|; } } # エラーがあれば差し戻す if (@err_msg) { my($err_msg) = "\n"; Show_LoginPage($err_msg); } # ★ この時点で認証成功 ---------------------------------- $username = $SIO{'DIRGATE_username'}; $username = $1 if ($username =~ /^([\w\-\.\+]+)@[\w\-\.]+\.[\w]+$/); # リトライリミットチェック回数をリセット if ($count && $INI{'LIMIT'}) { stdio::setSession($SESSION_FILE, "", $session_id); } $argv = "?$SIO{'DIRGATE_argv'}" if ($SIO{'DIRGATE_argv'} ne ""); $SIO{'DIRGATE_method'} = "GET" if ($SIO{'DIRGATE_method'} eq ""); # 有効期限設定 if ($field[11] && $field[8]) { $expires = time + $field[11] > $field[8] ? $field[8] : time + $field[11]; } elsif ($field[8]) { $expires = $field[8]; } elsif ($field[11]) { $expires = time + $field[11]; } { my(@time) = gmtime($field[6]+3600*$INI{'TIME_ZONE'}); $last_login = $USER_AGENT ne "OTHER" ? sprintf("%02d/%02d %02d:%02d", $time[4]+1,$time[3],$time[2],$time[1]) : sprintf("%04d/%02d/%02d %02d:%02d:%02d", $time[5]+1900,$time[4]+1,$time[3],$time[2],$time[1],$time[0]); } # セッションID生成 => セッション設定 $session_id = stdio::getRandomString(16); if (!stdio::setSession($SESSION_FILE, {"IP" => $ENV{'REMOTE_ADDR'}, "UA" => $CGI{'HTTP_USER_AGENT'}, "ID" => $SIO{'DIRGATE_username'}, "EM" => $field[2], "EX" => $expires, "IN" => time }, $session_id, $INI{'EXPIRES'}*60)) { show_ErrorPage('[03]ファイル書込エラー', 'セッションファイルへの書き込みに失敗しました', "

　セッションファイルの上書きオープンに失敗しました。
\n" . "　セッションファイルがあるディレクトリのパス(場所)の指定は正しいか、指定されたパスにディレクトリが存在するか、パーミッション(読み書き権)は正しく設定されているを確認してください。

"); } # HTML表示開始 print "Content-Type: text/html", $CHARSET, "\n" . "Cache-Control: no-cache\n" . "Pragma: no-cache\n"; # クッキー設定(PCのみ) if ($USER_AGENT eq "OTHER") { stdio::setCookie({"SID"=>$session_id}, $INI{'COOKIE_NAME'}, "", $INI{'COOKIE_PATH'}); if ($SIO{'DIRGATE_save'}) { stdio::setCookie({"USER"=>$SIO{'DIRGATE_username'},"PASS"=>$SIO{'DIRGATE_password'}}, "$INI{'COOKIE_NAME'}.2", 86400*30, $INI{'COOKIE_PATH'}, undef, undef, undef, $INI{'COOKIE_PASS'}); } else { stdio::setCookie({"0"=>0}, "$INI{'COOKIE_NAME'}.2", -1, $INI{'COOKIE_PATH'}, undef, undef, undef, $INI{'COOKIE_PASS'}); } } print "\n"; if ($USER_AGENT eq "OTHER") { print <<__HTML__; } else { print <<__HTML2__; } $INI{'TITLE'} [サインイン中]

サインイン中

ようこそ、$usernameさん

前回サインイン : $last_login
サインイン回数 : $field[7]回

サインイン処理をしています。そのまま数秒間お待ちください。

　

$HIDDEN
__HTML__ $INI{'TITLE'} [ｻｲﾝｲﾝ中]

ようこそ
$usernameさん

前回ｻｲﾝｲﾝ
$last_login
($field[7]回目)

$HIDDEN

※ｸｲｯｸｻｲﾝｲﾝを設定すればｻｲﾝｲﾝ時のﾕｰｻﾞｰ名とﾊﾟｽﾜｰﾄﾞ入力を省略できます｡

__HTML2__ # アクセスログに記録 if ($INI{'LOG'}) { my(@time, $log_file); @time = gmtime(time + $INI{'TIME_ZONE'} * 3600); if ($INI{'LOG'} == 3) { $log_file = sprintf("%04d%02d%02d", $time[5]+1900, $time[4]+1, $time[3]); } elsif ($INI{'LOG'} == 2) { my($sun, $weeks); $sun = $time[3] - $time[6]; if ($sun <= 1) { $weeks = 1; } elsif ($sun % 7 == 1 || $sun % 7 == 0) { $weeks = int($sun / 7) + 1; } else { $weeks = int($sun / 7) + 2; } $log_file = sprintf("%04d%02d%d", $time[5]+1900, $time[4]+1, $weeks); } else { $log_file = sprintf("%04d%02d", $time[5]+1900, $time[4]+1); } $log_file = "$SYS{'DATA_DIR'}$SYS{'FILE_NAME'}.$log_file.log"; if (open OUT, ">>$log_file") { print OUT time . "\t$SIO{'DIRGATE_username'}\t$ENV{'REMOTE_HOST'}\t$ENV{'HTTP_USER_AGENT'}\n"; close OUT; } } exit; }#Login #──────────────────────────────────────── # ■ サインアウトする # # 呼出元 : main # 引 数 : (ユーザー名, セッションID, サインイン時間) # 戻り値 : (終了) #──────────────────────────────────────── sub Logout #($username, $session_id, $login_time) { # →仮引数 my($username, $session_id, $login_time) = @_; # ! 局所変数宣言 my(@time, $stay_time, $logout_time); $stay_time = time - $login_time; $stay_time = int($stay_time / 3600) . "時間" . int($stay_time / 60) . "分" . $stay_time % 60 . "秒"; @time = gmtime(time + $INI{'TIME_ZONE'}*3600); $logout_time = sprintf("%04d/%02d/%02d %02d:%02d:%02d", $time[5]+1900,$time[4]+1,$time[3],$time[2],$time[1],$time[0]); # セッション解放 stdio::setSession($SESSION_FILE, "", $SESSION_ID); # HTML表示開始 print "Content-Type: text/html", $CHARSET, "\n" . "Cache-Control: no-cache\n" . "Pragma: no-cache\n"; stdio::setCookie({"0"=>0}, $INI{'COOKIE_NAME'}, -1, $INI{'COOKIE_PATH'}) if ($USER_AGENT eq "OTHER"); print "\n"; if ($USER_AGENT eq "OTHER") { print <<__HTML__; } else { print <<__HTML2__; } $INI{'TITLE'} [サインアウト]

サインアウト

ありがとうございました

サインアウト時間 : $logout_time
今回ご利用時間 : $stay_time

サインアウトは完了しました。またのご利用をお待ちしております。

　

ホームページへ戻る

__HTML__ $INI{'TITLE'} [ｻｲﾝｱｳﾄ]

ｻｲﾝｱｳﾄ完了

今回ご利用時間
$stay_time

ご利用ありがとうございました｡またのご利用をお待ちしております。

ﾎｰﾑﾍﾟｰｼﾞへ戻る

__HTML2__ exit; }#Logout #------------------------------------------------------------------------------ # ■ ユーザー認証 # # 呼出元 : Authorize # 引 数 : (ユーザーファイルパス, ユーザー名, パスワード) # 戻り値 : (1:成功／0:パスワード不備／-1:ユーザー名該当無し／ # -2:ファイル書けず／-3:ファイル読めず／-4:ロック中),@フィールド #------------------------------------------------------------------------------ sub authorize_User #($user_file, $username, $password) { # →仮引数 my($user_file, $username, $password) = @_; # ! 局所変数宣言 my(@field, $flag, $tmp_file, $i); $tmp_file = "$user_file.$$.tmp"; $flag = -1; # ファイルロック if ($SYS{'USE_LOCK'} && !stdio::lock($user_file)) { return -4; } if (!open IN, $user_file) { stdio::lock($user_file) if ($SYS{'USE_LOCK'}); return -3; } if (!open OUT, ">$tmp_file") { stdio::lock($user_file) if ($SYS{'USE_LOCK'}); return -2; } while () { tr/\x0D\x0A//d; my(@field2) = split /\t/; if ($flag == -1 && $username ne "" && $username eq $field2[0]) { $flag = 0; # パスワード一致 if ($password ne "" && $field2[1] !~ /^!/ && crypt($password, $field2[1]) eq $field2[1]) { my($last_login, $expires) = ($field2[6], $field2[12]); $expires = 300 if (!$expires); $flag = 1; # $field2[12]秒以内の再サインインでなく ＆ 有効期限内であれば if (!$field2[7] || time - $field2[6] > $expires) { if ($field2[8] eq "" || $field2[8] - time > 0) { $field2[7] ++; $field2[9] -- if ($field2[10]); $field2[10] -- if ($field2[10]); $field2[6] = time; } } @field = @field2; $field[6] = $last_login; } print OUT join("\t", @field2) . "\n"; } else { print OUT "$_\n"; } } close OUT; close IN; while (!rename $tmp_file, $user_file) { last if ($i ++ >= 3); sleep 1; } unlink $tmp_file if (-f $tmp_file); # ファイルロック解除 stdio::unlock($user_file) if ($SYS{'USE_LOCK'}); return $flag, @field; }#authorize_User #------------------------------------------------------------------------------ # ■ ディレクトリ内の条件にマッチする古いファイル削除する # # 呼出元 : Authorize # 引 数 : (ディレクトリパス, 検索条件, 有効秒数) # 戻り値 : (1>=:削除したファイル数／なし:ディレクトリ開けず) #------------------------------------------------------------------------------ sub remove_GarbageFiles #($dir, $filename, $expires) { # →仮引数 my($dir, $filename, $expires) = @_; # ! 局所変数宣言 my($i) = 0; if (!opendir DIR, $dir) { return; } while ($_ = readdir DIR) { if (/$filename/) { next if ($expires && (-M "$dir$_") * 86400 <= $expires); unlink "$dir$_"; $i ++; } } closedir DIR; return $i; }#remove_GarbageFiles #──────────────────────────────────────── # ■ ドキュメント表示する # # 呼出元 : main # 引 数 : (ディレクトリのパス) # 戻り値 : (終了) #──────────────────────────────────────── sub Show_Document #($username) { # →仮引数 my($username) = @_; # ! 局所変数宣言 my($body, $flag, $header, $footer, $buffer, $open_file, $session_id2); # 環境変数設定 (セキュリティーガード) $PATH_INFO =~ s/^\/+//; $PATH_INFO =~ s/\/\/+/\//g; $PATH_INFO =~ s/^[A-Za-z0-9]{16}\/?// if ($USER_AGENT ne "OTHER"); $PATH_INFO =~ s/\.\.//g; $PATH_INFO =~ tr/A-Za-z0-9_.+=[]()$&!@~\/\-//cd; # パス情報(PATH_INFO)の抽出 if ($PATH_INFO ne "" && !-e "$SYS{'BASE_DIR'}$PATH_INFO") { my($path, $i); while (!-f "$SYS{'BASE_DIR'}$PATH_INFO" && $PATH_INFO =~ /\//) { $PATH_INFO =~ s/(.*)(\/.*)$/$1/; $path = "$2$path"; last if ($i ++ > 20); } $ENV{'PATH_INFO'} = $path; Show_RequestErrorPage(404) if (-d "$SYS{'BASE_DIR'}$PATH_INFO"); } else { $flag = 1; } if ($USER_AGENT ne "OTHER") { $ENV{'SCRIPT_NAME'} = "$ENV{'SCRIPT_NAME'}/$SESSION_ID/$PATH_INFO"; } else { $ENV{'SCRIPT_NAME'} = "$ENV{'SCRIPT_NAME'}/$PATH_INFO"; } $ENV{'REMOTE_USER'} = $username; $ENV{'AUTH_ID'} = $SESSION_ID; # $session_id2 = "$SESSION_ID/" if ($USER_AGENT ne "OTHER"); # 開くファイル名設定 $open_file = "$SYS{'BASE_DIR'}$PATH_INFO"; # URIが"/"で終わらない ＆ ファイルが見つからない ＆ ディレクトリが存在 => "/"が省略されている if ($ENV{'PATH_INFO'} !~ /\/$/ && !-f $open_file && -d $open_file) { print "Location: $SYS{'PROTOCOL'}://$ENV{'SERVER_NAME'}$ENV{'SCRIPT_NAME'}"; print "/" if ($ENV{'SCRIPT_NAME'} !~ /\/$/); print "\n" . "\n"; exit; # URIが"/"で終わる => 標準インデックス参照 } elsif ($ENV{'PATH_INFO'} =~ /\/$/) { my($flag); foreach (@DEFAULT_INDEX) { if (-f "$open_file/$_") { $open_file .= "/$_"; $flag = 1; last; } } # 標準インデックスが見つからない => ディレクトリのインデックスリスト表示 if (!$flag && -d $open_file) { &show_IndexList($open_file); } } delete $ENV{'PATH_INFO'} if ($flag); # ファイルチェック if (!-f $open_file) { show_ErrorPage('[04]ファイル未検出', '404 ファイルが見つかりません', "

404 Not Found. The requested URL was not found on this server.

" . "

　リクエストされたURLはこのサーバー上に存在しません。URLの指定が間違っている、リンクが切れている、URLが変更になった可能\性が考えられます。

\n", '404 Not Found'); } if (!-r $open_file) { show_ErrorPage('[05]アクセス拒否', '403 アクセスが許可されていません', "

403 Forbidden. You don't have permission to access this URL.

\n" . "

　リクエストされたURLへのアクセスは許可されていません。URLの指定が間違っている、パーミッションが正しく設定されていない可能\性が考えられます。

\n", '403 Forbidden'); } # インクルードするHTML設定 if ($INI{'INS_HEADER'} || $INI{'INS_FOOTER'} || $INI{'INS_BODY'}) { $body = $INI{'INS_BODY'}; $header = $INI{'INS_HEADER'}; $header =~ s/\$\{USERNAME\}/$username/g; $footer = $INI{'INS_FOOTER'}; $footer =~ s/\$\{USERNAME\}/$username/g; } $ENV{'SCRIPT_FILENAME'} = $open_file; # 実行ファイル(CGI)がリクエストされた場合 foreach (@EXE_SUFFIX) { my($suffix, $program) = split /,/; if ($open_file =~ /$suffix$/) { my($stdin_file, $stdin, $argv, $chdir); # カレントディレクトリの変更 $chdir = $open_file; $chdir =~ s/(.+)\/.*$/$1/; chdir $chdir; $stdin_file = "$SYS{'DATA_DIR'}$$.in.tmp"; $argv = join " ", @ARGV; # 標準入力をファイルに書き込み if ($ENV{'CONTENT_LENGTH'} > 0) { if (!open OUT, ">$stdin_file") { show_ErrorPage('[06]サーバーエラー', '500 サーバーエラー', "

500 Server Error. An error occurred while processing this request.

" . "

　リクエストされたURLはこのサーバー上に存在しません。URLの指定が間違っている、リンクが切れている、URLが変更になった可能\性が考えられます。

\n", '500 Server Error'); } binmode OUT; binmode STDIN; print OUT $buffer while (read STDIN, $buffer, 4096); close OUT; $stdin = "<$stdin_file"; } # 1行目のコマンドライン読み込み if ($program eq "" || $program eq "<command>") { if (!open IN, $open_file) { unlink $stdin_file if (-f $stdin_file); show_ErrorPage('[07]アクセス拒否', '403 アクセスが許可されていません', "

403 Forbidden. You don't have permission to access this URL.

\n" . "

　リクエストされたURLへのアクセスは許可されていません。URLの指定が間違っている、パーミッションが正しく設定されていない可能\性が考えられます。

\n", '403 Forbidden'); } $program = ; close IN; $program =~ tr/\x0D\x0A//d; $program = $program =~ /^#! *(.+) *$/ ? $1 : ""; } # コマンド実行 実行結果 > ファイル if ($program ne "" && $program ne "execute") { my($html) = 1; $program .= ".exe" if ($^O =~ /win/i); if (!-x $program) { unlink $stdin_file if (-f $stdin_file); show_ErrorPage('[08]サーバーエラー', '500 サーバーエラー', "

500 Server Error. An error occurred while processing this request.

" . "

　リクエスト処理中にサーバーエラーが発生しました。リクエスト内容が不正である、誤った設定がなされている可能\性が考えられます。

\n", '500 Server Error'); } if (!open PIPE, "$program $open_file $argv $stdin |") { unlink $stdin_file if (-f $stdin_file); show_ErrorPage('[09]サーバーエラー', '500 サーバーエラー', "

500 Server Error. An error occurred while processing this request.

" . "

　リクエスト処理中にサーバーエラーが発生しました。リクエスト内容が不正である、誤った設定がなされている可能\性が考えられます。

\n", '500 Server Error'); } while () { $html = 1 if (!$html && /^Content-Type: *text\/html/i); if ($html) { #s//run_SSI_Command($open_file, $1, $2)/eg; s/\$\$\{SESSION_ID\}\$\$/$SESSION_ID/g; s/\$\$\{SESSION_ID\/\}\$\$/$session_id2/g; s/##\{SESSION_ID\}##/$SESSION_ID/g; s/##\{SESSION_ID\/\}##/$session_id2/g; if ($INI{'CGI_INSERT'}) { s/]*)>/$header/i; s/<\/body>/$footer<\/body>/i; } } print; } close PIPE; } else { my($html) = 1; if (!open PIPE, "$open_file $argv $stdin |") { unlink $stdin_file if (-f $stdin_file); show_ErrorPage('[0A]サーバーエラー', '500 サーバーエラー', "

500 Server Error. An error occurred while processing this request.

" . "

　リクエスト処理中にサーバーエラーが発生しました。リクエスト内容が不正である、誤った設定がなされている可能\性が考えられます。

\n", '500 Server Error'); } while () { $html = 1 if (!$html && /^Content-Type: *text\/html/i); if ($html) { #s//run_SSI_Command($open_file, $1, $2)/eg; s/\$\$\{SESSION_ID\}\$\$/$SESSION_ID/g; s/\$\$\{SESSION_ID\/\}\$\$/$session_id2/g; s/##\{SESSION_ID\}##/$SESSION_ID/g; s/##\{SESSION_ID\/\}##/$session_id2/g; if ($INI{'CGI_INSERT'}) { s/]*)>/$header/i; s/<\/body>/$footer<\/body>/i; } } print; } close PIPE; } # テンポラリファイル削除 unlink $stdin_file if (-f $stdin_file); remove_GarbageFiles($SYS{'DATA_DIR'}, '\.in\.tmp$', 60) if (int(rand 100) == 50); exit; } } # SSI命令解釈実行 => HTML表示 foreach (@SSI_SUFFIX) { if ($open_file =~ /$_$/) { my($chdir); # カレントディレクトリの変更 $chdir = $open_file; $chdir =~ s/(.+)\/.*$/$1/; chdir $chdir; if (!open IN, $open_file) { show_ErrorPage('[0B]アクセス拒否', '403 アクセスが許可されていません', "

403 Forbidden. You don't have permission to access this URL.

\n" . "

　リクエストされたURLへのアクセスは許可されていません。URLの指定が間違っている、パーミッションが正しく設定されていない可能\性が考えられます。

\n", '403 Forbidden'); } print "Content-Type: " . stdio::getMimeType($open_file) . "\n"; if ($INI{'NO_CACHE'}) { print "Pragma: no-cache\n" . "Cache-Control: no-cache\n"; printf "Last-Modified: %s, %d %s %d %s GMT\n", (split / /, scalar(gmtime((stat $open_file)[9])))[0,2,1,4,3]; } else { printf "Expires: %s, %d %s %d %s GMT\n", (split / /, scalar(gmtime time+$INI{'EXPIRES'}*60))[0,2,1,4,3]; } print "\n"; while () { s//run_SSI_Command($open_file, $1, $2)/eg; s/\$\$\{SESSION_ID\}\$\$/$SESSION_ID/g; s/\$\$\{SESSION_ID\/\}\$\$/$session_id2/g; s/##\{SESSION_ID\}##/$SESSION_ID/g; s/##\{SESSION_ID\/\}##/$session_id2/g; s/]*)>/$header/i; s/<\/body>/$footer<\/body>/i; print; } close IN; exit; } } # 通常ファイル出力 if (!open IN, $open_file) { show_ErrorPage('[0C]アクセス拒否', '403 アクセスが許可されていません', "

403 Forbidden. You don't have permission to access this URL.

\n" . "

　リクエストされたURLへのアクセスは許可されていません。URLの指定が間違っている、パーミッションが正しく設定されていない可能\性が考えられます。

\n", '403 Forbidden'); } binmode STDOUT; binmode IN; # ファイル表示開始 print "Content-Type: " . stdio::getMimeType($open_file) . "\n"; if ($open_file =~ /html?$/) { printf "Content-Length: %d\n", (-s $open_file)+length($body)+length($footer)+length($header); } else { print "Content-Length: " . (-s $open_file) . "\n"; } printf "Expires: %s, %d %s %d %s GMT\n", (split / /, scalar(gmtime time+$INI{'EXPIRES'}*60))[0,2,1,4,3]; #print "Pragma: no-cache\n" # . "Cache-Control: no-cache\n"; printf "Last-Modified: %s, %d %s %d %s GMT\n", (split / /, scalar(gmtime((stat $open_file)[9])))[0,2,1,4,3]; print "\n"; if ($open_file =~ /html?$/) { my($length) = 0; while () { s/\$\$\{SESSION_ID\}\$\$/$SESSION_ID/g; $length += s/\$\$\{SESSION_ID\/\}\$\$/$session_id2/g; s/##\{SESSION_ID\}##/$SESSION_ID/g; $length += s/##\{SESSION_ID\/\}##/$session_id2/g; s/]*)>/$header/i; s/<\/body>/$footer<\/body>/i; print; } if ($length) { $length *= 17; print " " x $length; } } else { print $buffer while (read IN, $buffer, 4096); } close IN; exit; }#Show_Document #──────────────────────────────────────── # ■ ディレクトリのインデックスリストを表示する # # 呼出元 : Show_Document # 引 数 : (ディレクトリのパス) # 戻り値 : (終了) #──────────────────────────────────────── sub show_IndexList #($dir) { # →仮引数 my($dir) = @_; # ! 局所変数宣言 my(@dir, @file); # ディレクトリを開く if (!-d $dir) { show_ErrorPage('[0D]ファイル未検出', '404 ファイルが見つかりません', "

404 Not Found. The requested URL was not found on this server.

" . "

　リクエストされたURLはこのサーバー上に存在しません。URLの指定が間違っている、リンクが切れている、URLが変更になった可能\性が考えられます。

\n", '404 Not Found'); } elsif (!opendir DIR, $dir) { show_ErrorPage('[0E]アクセス拒否', '403 アクセスが許可されていません', "

403 Forbidden. You don't have permission to access this URL.

\n" . "

　リクエストされたURLへのアクセスは許可されていません。URLの指定が間違っている、パーミッションが正しく設定されていない可能\性が考えられます。

\n", '403 Forbidden'); } while ($_ = readdir DIR) { if ($_ ne ".." && $_ ne ".") { s/&/&/g; s/"/"/g; s//>/g; if (-d "$dir$_") { push @dir, $_; } else { push @file,$_; } } } closedir DIR; # HTML表示開始 print "Content-Type: text/html", $CHARSET, "\n" . "Pragma: no-cache\n" . "Cache-Control: no-cache\n" . "\n"; print <<__HTML__; $INI{'Title'} [index of $ENV{'SCRIPT_NAME'}]

Index of $ENV{'SCRIPT_NAME'}

 ../ Parent Directory

__HTML__

    #  ディレクトリリスト表示開始
    foreach (sort { $a cmp $b } @dir) {
        my($file) = $_;
        $file = substr($file, 0, 34) . ".." if (length $file >= 37);
        print qq| $file/|;
        print " " x (37 - length $file);
        print "           <DIR>" . '  ' . gmtime((stat "$dir$_")[9] + 9 * 3600);
        print "\n";
    }
    print "\n";
    foreach (sort { $a cmp $b } @file) {
        my($file) = $_;
        $file = substr($file, 0, 34) . ".." if (length $file >= 37);
        print qq| $file|;
        print " " x (38 - length);
        print sprintf("%8d",(-s "$dir$_")) . ' Byte(s)  ' . gmtime((stat "$dir$_")[9] +9 * 3600);
        print "\n";
    }

    print <<__HTML__;

@{[scalar @file]} file(s) and @{[scalar @dir]} directory(ies) in this directory.
__HTML__ exit; }#show_IndexList #──────────────────────────────────────── # ■ SSIコマンドを解釈実行する # # 呼出元 : Show_Documents # 引 数 : (ファイルパス, コマンド, 属性) # 戻り値 : (SSI実行結果) #──────────────────────────────────────── my(%static, %static_var); sub run_SSI_Command #($open_file, $command, $attribute) { # →仮引数 my($open_file, $command, $attribute) = @_; # ! 変数宣言 my(@attribute); # ! 静的変数宣言 $static{'err_msg'} = '[an error occurred while processing this directive]' if ($static{'err_msg'} eq ""); $static{'time_format'} = '' if ($static{'time_format'} eq ""); %static_var = () if (!%static_var); $attribute =~ s/\s+$//; $attribute =~ s/^\s+//; $attribute =~ s/(\w+="[^"]*")/push(@attribute, $1)/eg; # config if ($command eq 'config') { foreach (@attribute) { my($key, $val) = split /=/, $_, 2; $val =~ s/^['"]//g; $val =~ s/['"]$//g; if ($key eq 'errmsg') { $static{'err_msg'} = $val; } elsif ($key eq 'sizefmt') { $static{'size_format'} = $val; } elsif ($key eq 'timefmt') { $static{'time_format'} = $val; $static{'time_format'} =~ s/%c/%mm\/%dd\/%yy %hh:%nn:%ss/g; $static{'time_format'} =~ s/%x/%mm\/%dd\/%yy/g; $static{'time_format'} =~ s/%X/%hh:%nn:%ss/g; $static{'time_format'} =~ s/%y/%yy/g; $static{'time_format'} =~ s/%Y/%yyyy/g; $static{'time_format'} =~ s/%b/%MM/g; $static{'time_format'} =~ s/%B/%MM2/g; $static{'time_format'} =~ s/%s/%ss/g; $static{'time_format'} =~ s/%m/%mm/g; $static{'time_format'} =~ s/%a/%ww2/g; $static{'time_format'} =~ s/%A/%ww3/g; $static{'time_format'} =~ s/%d/%dd/g; $static{'time_format'} =~ s/%M/%nn/g; $static{'time_format'} =~ s/%S/%ss/g; $static{'time_format'} =~ s/%p/%ap2/g; $static{'time_format'} =~ s/%I/%HH/g; $static{'time_format'} =~ s/%H/%hh/g; $static{'time_format'} =~ s/%Z/GMT $INI{'TIME_ZONE'}/g; } } return; # echo } elsif ($command eq 'echo') { my($result); foreach (@attribute) { my($key, $val) = split /=/, $_, 2; $val =~ s/^['"]//g; $val =~ s/['"]$//g; if ($key eq 'var') { if ($val eq 'DOCUMENT_NAME') { $result .= $1 if ($open_file =~ /([^\\\/]+$)/); } elsif ($val eq 'DOCUMENT_URI') { $result .= $ENV{'SCRIPT_NAME'} . $PATH_INFO; } elsif ($val eq 'DATE_GMT') { $result .= stdio::getTime($static{'time_format'}); } elsif ($val eq 'DATE_LOCAL') { $result .= stdio::getTime($static{'time_format'}, $INI{'TIME_ZONE'}); } elsif ($val eq 'LAST_MODIFIED') { $result .= stdio::getTime($static{'time_format'}, $INI{'TIME_ZONE'}, (stat($open_file))[9]); } elsif (defined $ENV{$val}) { $result .= $ENV{$val}; } else { $result .= $static_var{$val}; } } } return $result; # printenv } elsif ($command eq 'printenv') { my($result); foreach (sort keys %ENV) { $result .= "$_=$ENV{$_}\n"; } return $result; # set } elsif ($command eq 'set') { my($var); foreach (@attribute) { my($key, $val) = split /=/, $_, 2; $val =~ s/^['"]//g; $val =~ s/['"]$//g; if ($key eq "var") { $var = $val; } elsif ($key eq "value") { $static_var{$var} = $val; } } # fsize } elsif ($command eq 'fsize') { my($result); foreach (@attribute) { my($key, $val) = split /=/, $_, 2; $val =~ s/^['"]//g; $val =~ s/['"]$//g; if ($key eq "file") { my($dir) = $open_file; $dir =~ s/(.*\/).*$/$1/; if (!-f "$dir$val") { $result .= $static{'err_msg'}; next; } $result .= compute_Byte((-s "$dir$val"), $static{'size_format'}); } elsif ($key eq "virtual") { my($dir) = $val; $dir = s/^\///; if (!-f "$SYS{'BASE_DIR'}$val") { $result .= $static{'err_msg'}; next; } $result .= compute_Byte((-s "$SYS{'BASE_DIR'}$val"), $static{'size_format'}); } } return $result; # flastmod } elsif ($command eq 'flastmod') { my($result); foreach (@attribute) { my($key, $val) = split /=/, $_, 2; $val =~ s/^['"]//g; $val =~ s/['"]$//g; if ($key eq "file") { my($dir) = $open_file; $dir =~ s/(.*\/).*$/$1/; if (!-f "$dir$val") { $result .= $static{'err_msg'}; next; } $result .= stdio::getTime($static{'time_format'}, $INI{'TIME_ZONE'}, (stat("$dir$val"))[9]); } elsif ($key eq "virtual") { my($dir) = $val; $dir = s/^\///; if (!-f "$SYS{'BASE_DIR'}$val") { $result .= $static{'err_msg'}; next; } $result .= stdio::getTime($static{'time_format'}, $INI{'TIME_ZONE'}, (stat("$SYS{'BASE_DIR'}$val"))[9]); } } return $result; # include } elsif ($command eq 'include') { my($result, $buffer); foreach (@attribute) { my($key, $val) = split /=/, $_, 2; $val =~ s/^['"]//g; $val =~ s/['"]$//g; if ($key eq "file") { my($dir) = $open_file; $dir =~ s/(.*\/).*$/$1/; if (!open SIN, "$dir$val") { $result .= $static{'err_msg'}; next; } $result .= $_ while (read SIN, $buffer, 4096); close SIN; } elsif ($key eq "virtual") { my($dir) = $val; $dir = s/^\///; if (!open SIN, "$SYS{'BASE_DIR'}$val") { $result .= $static{'err_msg'}; next; } $result .= $_ while (read SIN, $buffer, 4096); close SIN; } } return $result; # exec } elsif ($command eq 'exec') { my($result); foreach (@attribute) { my($key, $val) = split /=/, $_, 2; $val =~ s/^['"]//g; $val =~ s/['"]$//g; if ($key eq "cmd") { my(@argv, $argv, $program); ($val, @argv) = split / +/, $val, 2; if ($val =~ /\.pl$/) { $program = 'perl '; } elsif ($val =~ /\.rb$/) { $program = 'ruby '; } $argv = join " ", @argv; if (!open PIPE, "$program$val $argv |") { $result .= $static{'err_msg'}; next; } $result .= $_ while (); close PIPE; } elsif ($key eq "cgi") { my(@argv, $argv, $program, $flag); ($val, $ENV{'QUERY_STRING_UNESCAPED'}) = split /\?/, $val, 2; @argv = split / /, $ENV{'QUERY_STRING_UNESCAPED'}; $argv = join " ", @argv; if (!open SIN, $val) { $result .= $static{'err_msg'}; next; } $program = ; close SIN; $program =~ tr/\x0D\x0A//d; $program =~ s/^#! *(.+)$/$1/; if (!open PIPE, "$program $val $argv |") { $result .= $static{'err_msg'}; next; } while () { if ($flag == 2) { $result .= $_; } elsif (!$flag && /^Content-Type:/i) { $flag = 1; } elsif ($flag == 1 && /^[\r\n]$/) { $flag = 2; } } close PIPE; } } return $result; } return $static{'err_msg'}; }#run_SSI_Command #──────────────────────────────────────── # ■ バイトを計算する # # 呼出元 : run_SSI_Command # 引 数 : (バイト, abbrevを指定すると指数単位付け) # 戻り値 : (単位付けされたバイト) #──────────────────────────────────────── sub compute_Byte #($byte, $size_format) { # →仮引数 my($byte, $size_format) = @_; if ($size_format eq 'abbrev') { my(@size_format, $i); $i = 0; @size_format = ("", "K", "M", "G", "T", "P", "E", "Z", "Y"); while ($byte >= 1024) { $byte = int($byte / 1024); $i ++; } return sprintf("%4d$size_format[$i]", $byte); } return $byte; }#compute_Byte #──────────────────────────────────────── # ■ リクエスト元のIPアドレスが指定したIPアドレス(サブネットマスク指定)に一致するか確認する # # 呼出元 : init, forbidAccess # 引 数 : @IPアドレス(例:192.168.1.0/24) # 戻り値 : 1=一致 / 0=不一致 #──────────────────────────────────────── sub checkIPaddr #($ipaddr, @ipaddr) { # →仮引数 (string) my(@ipaddr) = @_; # ! 局所変数宣言 (string) my($ipaddr); foreach (split /\./, $ENV{'REMOTE_ADDR'}, 4) { $ipaddr .= unpack("B8", pack("C", $_)); } a:foreach (@ipaddr) { my($ipaddr2, $ipaddr_bit2, $subnet_mask); ($ipaddr2, $subnet_mask) = split /\//; foreach (split /\./, $ipaddr2, 4) { next a if ($_ >= 256 || $_ < 0); $ipaddr_bit2 .= unpack("B8", pack("C", $_)); } $ipaddr_bit2 = substr $ipaddr_bit2, 0, $subnet_mask if ($subnet_mask); return 1 if (index($ipaddr, $ipaddr_bit2) == 0); } return 0; }#checkIPaddr #------------------------------------------------------------------------------ # ■ ソフトウェアキーボードを表示する # # 呼出元 : main # 引 数 : (なし) # 戻り値 : (終了) #------------------------------------------------------------------------------ sub Show_SoftwareKeyboard #(void) { # HTML表示開始 print "Content-Type: text/html", $CHARSET, "\n"; print "Cache-Control: no-cache\n" . "Pragma: no-cache\n" . "\n"; print <<__HTML__; $INI{'TITLE'} [セキュリティーキーボード]






__HTML__ exit; }#Show_CookieError #------------------------------------------------------------------------------ # ■ クッキーエラーを表示する # # 呼出元 : main # 引 数 : (なし) # 戻り値 : (終了) #------------------------------------------------------------------------------ sub Show_CookieError #(void) { # HTML表示開始 print "Content-Type: text/html", $CHARSET, "\n"; print "Cache-Control: no-cache\n" . "Pragma: no-cache\n" . "\n"; print <<__HTML__; $INI{'TITLE'} [クッキーエラー]

クッキーの設定時にエラーが発生しました

　この認証システムでは、ユーザーの識別にHTTPクッキー(Cookie)と呼ばれる技術を使っています。そのため、クッキーに関する設定が正しくされていないと、ユーザーがサインインしているかどうかを識別できません。

お使いのブラウザでクッキーの設定は正しくされていますか？

　お使いのブラウザでクッキーを拒否、あるいは制限するように設定されている可能\性があります。サインイン中は設定を変更してクッキーを受け入れるようにしてください。詳しくは各ソ\フトのマニュアルを参照してください。
　(InternetExplorer6.0の場合、メニューバーの[ツール]→[インターネットオプション]→[プライバシー]の設定で[中-高]以下にしてください。)

お使いのセキュリティーソ\フトの設定は正しくされていますか？

　ウィルス対策ソ\フトやファイアーウォールソ\フトをお使いの場合、ソ\フトの設定によってはクッキーを拒否、あるいは制限されている可能\性があります。サインイン中はソ\フトを無効にするか、設定を変更してクッキーを受け入れるようにしてください。詳しくは各ソ\フトのマニュアルを参照してください。

それでもうまくいかない場合は？

　古いクッキーが残っている可能\性があります。お使いのブラウザに蓄積されているクッキーを削除して、ブラウザを再起動してください。
　どうしても解決しない場合は、サイトの管理者へ連絡してください。

戻る

__HTML__ exit; }#Show_CookieError #──────────────────────────────────────── # ■ エラーページを表示する # # 呼出元 : (汎用) # 引 数 : (エラーコード, エラータイトル, エラーメッセージ, HTTPステータス) # 戻り値 : (終了) #──────────────────────────────────────── sub show_ErrorPage #($err_type, $err_title, $err_msg, $status) { # →仮引数 my($err_type, $err_title, $err_msg, $status) = @_; $err_msg = $err_msg =~ /^$err_msg

"; if ($ENV{'REMOTE_HOST'} eq $ENV{'REMOTE_ADDR'} || !$ENV{'REMOTE_HOST'}) { $ENV{'REMOTE_HOST'} = gethostbyaddr(pack('C4',split(/\./, $ENV{'REMOTE_ADDR'})),2); $ENV{'REMOTE_HOST'} = $ENV{'REMOTE_ADDR'} if (!$ENV{'REMOTE_HOST'}); } # iMODE/J-SKY用に全角カタカナを半角に変換 $jcode'version = $jcode'version; if ($jcode'version && $ENV{'HTTP_USER_AGENT'} =~ /^(DoCoMo|J-PHONE)/) { if ($JCODE eq "euc") { &jcode'z2h_euc(\$err_type); &jcode'z2h_euc(\$err_title); &jcode'z2h_euc(\$err_msg); } elsif ($JCODE eq "jis") { &jcode'z2h_jis(\$err_type); &jcode'z2h_jis(\$err_title); &jcode'z2h_euc(\$err_msg); } else { &jcode'z2h_sjis(\$err_type); &jcode'z2h_sjis(\$err_title); &jcode'z2h_sjis(\$err_msg); } } # HTML表示開始 print "Content-Type: text/html", $CHARSET, "\n"; print "Status: $status" if ($status); print "Cache-Control: no-cache\n" . "Pragma: no-cache\n" . "\n"; if ($ENV{'HTTP_USER_AGENT'} !~ /^(DoCoMo|J-PHONE)/) { print <<__HTML__; } else { print <<__HTML2__; } $INI{'TITLE'} [システムエラー]

$err_title

$err_msg

[←戻る] [再試行]

ご迷惑をおかけして申\し訳ありません。
問題が解決しない場合は以下の情報を添えて管理者に連絡してください。 

  $err_type ($VERSION)
  TIME  : @{[scalar gmtime(time+$INI{'TIME_ZONE'}*3600)]} (GMT $INI{'TIME_ZONE'})
  HOST  : $ENV{'REMOTE_HOST'} ($ENV{'REMOTE_ADDR'})
  AGENT : $ENV{'HTTP_USER_AGENT'}
  REFFER: $ENV{'HTTP_REFERER'}
  ERRMSG: $!
__HTML__ ｼｽﾃﾑｴﾗｰ

[ｼｽﾃﾑｴﾗｰ]
$err_title

$err_msg

※端末の[戻る]で戻ってください｡

$err_type($VERSION)

__HTML2__ exit; }#show_ErrorPage