#!/usr/local/bin/perl
# ↑サーバに合わせて設定
# ##################################################################
# get_list - list_in 周辺のサーバー負荷を減らす対策／付随作業用
# ##################################################################
# このスクリプトを利用する際の注意事項
# ※決められた用途以外には使用しないで下さい。
# ※実行前に全てのSOSスクリプトの動作を停止させて下さい。
# ※特にユーザーファイルへアクセスする動作（ユーザーリストの表示など）
# には細心の注意を払う必要があります。
# ※このスクリプトの使用により、ユーザーデータの一部、または全部が破損
# し、消失する恐れがあります。
# 必ず全てのデータを一時的にコピーし、修復できる状態にしてからご使用
# 下さい。
# ※このスクリプトを使用した結果、何らかの問題が生じても一切の保障は致
# し兼ねます。スクリプトの使用にはご自身で十分動作を理解し、ご自身の
# 責任において実行して下さい。
# ※このスクリプトを実行した時点で、これらの注意事項に同意した物とみな
# します。
# ##################################################################
print qq|Content-type: text/html\n\n|;
print qq|\n\n|;
print qq|\n|;
print qq|exterior accsess\n|;
print qq|\n\n|;
$headflag = 1;
require 'jcode.pl'; # jcode.plのパス 644
$usrdir = 'userfile/'; # ユーザデータを格納するフォルダ
$listin = 'listin.cgi'; # List In用のファイル名
# ---------- LOCK FILE
$lockkey = 1; # ファイルのロック(Mkdir = 1,Symlink=2,No = 0)
$lockfile = './sos.lock'; # ロックファイル名＆パス
&lock;
opendir(DIR,"$usrdir") || &error("ユーザデータ読みこみエラー");
@usrfile = sort grep /\.dat/,readdir(DIR);
closedir(DIR);
foreach $no (0 .. $#usrfile) {
open(IN,"$usrdir$usrfile[$no]") || &error("Can't open $usrfile[$no]");
$line = ;
close(IN);
push(@lstlines,$line);
}
open(OUT,">$listin") || &error("Write Error : $listin");
print OUT @lstlines;
close(OUT);
print qq|作業を完了しました。
$listin を表\示します。正常に書き込まれている事を確認して下さい。\n|;
open(IN,"$listin") || &error("Can't open $listin");
@listinline = ;
close(IN);
print qq|
|
\n|;
foreach (0 .. $#listinline) {
print qq|| $listinline[$_] |
\n|;
}
print qq|
|
\n
|;
print qq|プログラムを終了します。|;
&unlock;
# Sub Lock
sub lock {
return if !$lockkey;
local($flag) = 1;
if ($lockkey == 1) {
rmdir($lockfile) if (time - (stat($lockfile))[9] > 60);
while (!mkdir($lockfile,0755)) {
--$flag or &error('ＳＯＳが起動されています',1);
sleep(1);
}
}
elsif ($lockkey == 2) {
unlink($lockfile) if (time - (stat($lockfile))[9] > 60);
while (!symlink(".",$lockfile)) {
--$flag or &error('ＳＯＳが起動されています',1);
sleep(1);
}
}
}
# Sub Error #
sub error {
$_[1] || &unlock;
print qq|\n|;
print qq|
\n|;
print qq|$_[0]\n|;
print qq|
\n|;
print qq|\n|;
exit;
}
# Sub Unlock #
sub unlock {
if ($lockkey == 1) { rmdir($lockfile) }
elsif ($lockkey == 2) { unlink($lockfile) }
}