#-------------------------------
# padlib.pl (ShiftJIS)
# 2001.11. 6 MIYAMORI Yoshimasa
# 1999. 1. 2 MIYAMORI Yoshimasa
#   (kan_ta@amcsys.com)
#-------------------------------

&initPadCgi($myFilePath, $myFileUrl, $myOut);

# ファイル設定など.
sub initPadCgi {
  local($s, $t) = @_;

  $bakFile = $s . 'pad.bak';
  $busyFile = $s . 'pad.bsy';
  $countFile = $s . 'pad.cnt';
  $envFile = $s . 'pad.env';
  $errFile = $s . 'pad.err';
  $errTmpFile = $s . 'err.tmp';
  $nameFile = $s . 'padname.html';
  $padFile = $s . 'pad.html';
  $passwdFile = $s . 'pad.pwd';
  $qryFile = $s . 'pad.qry';
  $tmpFile = $s . 'pad.tmp';
  $logFile[0] = $s . 'log0.html';
  $logFile[1] = $s . 'log1.html';
  $logFile[2] = $s . 'log2.html';
  $logFile[3] = $s . 'log3.html';
  $logFile[4] = $s . 'log4.html';
  $logFile[5] = $s . 'log5.html';
  $logFile[6] = $s . 'log6.html';
  $logFile[7] = $s . 'log7.html';
  $logFile[8] = $s . 'log8.html';
  $logFile[9] = $s . 'log9.html';
  $logFile[10] = $s . 'log10.html';
  $logFile[11] = $s . 'log11.html';
  $logFile[12] = $s . 'log12.html';
  $logFile[13] = $s . 'log13.html';
  $logFile[14] = $s . 'log14.html';
  $logFile[15] = $s . 'log15.html';
  $logFile[16] = $s . 'log16.html';
  $logFile[17] = $s . 'log17.html';
  $logFile[18] = $s . 'log18.html';
  $logFile[19] = $s . 'log19.html';
  $urlNameFile = $t . 'padname.html';
  $urlPadFile = $t . 'pad.html';
  $urlLogFile[0] = $t . 'log0.html';
  $urlLogFile[1] = $t . 'log1.html';
  $urlLogFile[2] = $t . 'log2.html';
  $urlLogFile[3] = $t . 'log3.html';
  $urlLogFile[4] = $t . 'log4.html';
  $urlLogFile[5] = $t . 'log5.html';
  $urlLogFile[6] = $t . 'log6.html';
  $urlLogFile[7] = $t . 'log7.html';
  $urlLogFile[8] = $t . 'log8.html';
  $urlLogFile[9] = $t . 'log9.html';
  $urlLogFile[10] = $t . 'log10.html';
  $urlLogFile[11] = $t . 'log11.html';
  $urlLogFile[12] = $t . 'log12.html';
  $urlLogFile[13] = $t . 'log13.html';
  $urlLogFile[14] = $t . 'log14.html';
  $urlLogFile[15] = $t . 'log15.html';
  $urlLogFile[16] = $t . 'log16.html';
  $urlLogFile[17] = $t . 'log17.html';
  $urlLogFile[18] = $t . 'log18.html';
  $urlLogFile[19] = $t . 'log19.html';
  $PAD_SEP = ',';
  $PAD_LAST = '<!--last-->';
  $PAD_TOP = '<!--top-->';
  $PAD_BOTTOM = '<!--bottom-->';
  $PAD_REPLY = '<!--reply-->';
  $PAD_TEXT = '<!--text-->';
  $PAD_TEXT_END = '<!--textEnd-->';
  $PAD_TEXT_REPLY = '<!--textReply-->';
  $PAD_TEXT_REPLY_END = '<!--textReplyEnd-->';
  open(MYOUT, "|$myOut");
  select(MYOUT);
  if ($myOut eq $SJIS) {
    $myCharSet = 'Shift_JIS';
  } else {
    $myCharSet = 'EUC-JP';
  }
}

# &parseQry(*qry) で 連想配列 $qry{'name'} などに値をセットする.
# 改行は "\n".
# いくつかの文字列を置き換える.
sub parseQry {
  local(*qry) = @_;
  local($s, $i, $key, $val);

  if ($ENV{'REQUEST_METHOD'} eq 'POST') {
    read(STDIN, $s, $ENV{'CONTENT_LENGTH'});
  } else {
    $s = $ENV{'QUERY_STRING'};
  }
  $s = &forMobileGear($s);
  @qry = split(/&/, $s);
  foreach $i (0 .. $#qry) {
    $qry[$i] =~ s/\+/ /g;
    ($key, $val) = split(/=/,$qry[$i], 2);
    $key =~ s/%(..)/pack('C',hex($1))/ge; # 'C':符号無しchar値.
    $val =~ s/%(..)/pack('C',hex($1))/ge;
    if (defined($qry{$key})) { # 複数選択のlistboxなどの時.
      $qry{$key} = join("\0", $qry{$key}, $val);
    } else {
      $qry{$key} = $val;
    }
    $qry{$key} = &toEuc($qry{$key});
    $qry{$key} =~ s/\r\n/\n/go;
    $qry{$key} =~ s/\r/\n/go;
    $qry{$key} =~ s/`/&#096;/go;
    $qry{$key} =~ s/</&#060;/go if ($myTagChk);
    $qry{$key} =~ s/>/&#062;/go if ($myTagChk);
    $qry{$key} = &toSjis($qry{$key}) if ($myOut eq $SJIS);
  }
}

# モバイルギアのテキストブラウザのバグ対応.
# たとえば, 改行を %a とエンコードしているので, %0A に置き換える.
sub forMobileGear {
  local($s) = @_;
  local($t, $u, $i, $j);

  $t = $s;
  $i = 0;
  do {
    $j = ($s =~ s/(%a)([^0-9a-fA-F])/%0A$2/go);
    $i++;
  } while(($i < 1000) && ($j)); # 1000回で抜ける.
  $i = 0;
  do {
    $j = ($s =~ s/(%d)([^0-9a-fA-F])/%0D$2/go);
    $i++;
  } while(($i < 1000) && ($j));
  if ($s ne $t) {
    $u = "warning: forMobileGear().\n" . "before\n$s\n" . "after\n$t";
    &putErrFile($u);
  }
  return($s);
}

sub chkAuth {
  local($s) = @_;

  if ($myAuth == 0) {
    return(0);
  } else {
    if (!$s) {
      return(1);
    } elsif (&chkPasswd($s)) {
      return(0);
    } else {
      return(1);
    }
  }
}

sub getSalt {
  srand;
  return(substr('sUbGeTsAlT', int(rand(9)), 2));
}

# $passwdFile を読んで その内容を返す.
# 無ければ crypt('password', &getSalt) を返す.
sub getPasswd {
  local($text);

  $text = crypt('password', &getSalt);
  if (-f $passwdFile) {
    open(FILE, "<$passwdFile") || return($text);
    $text = <FILE>;
    close FILE;
  }
  return($text);
}

# $s が正しいパスワードなら 1 を返す.
sub chkPasswd {
  local($s) = @_;
  local($pass);
  
  $pass = &getPasswd;
  if (crypt($s, $pass) eq $pass) {
    return(1);
  } else {
    return(0);
  }
}

# crypt($s, &getSalt) を $file に書き出す.
# 成功すれば 0 を返す.
sub putPasswd {
  local($s) = @_;

  open(FILE, ">$passwdFile") || &exitPadCgi('error: putPasswd().');
  print FILE crypt($s, &getSalt);
  close FILE;
  return(0);
}

# 日付の文字列を返す.
# $n = 1: Fri Aug 29 00:00:00 JST 1997
# $n = 0: 97年08月29日(金) 00:00:00
sub getDate {
  local($n) = @_;
  local($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst);
  local($date, $mon2, $wday2);

  ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst) = gmtime(time + 9 * 3600);
  $hour = "0$hour" if ($hour < 10);
  $min = "0$min" if ($min < 10);
  $sec = "0$sec" if ($sec < 10);
  if ($n) {
    $mon2 = ('Jan','Feb','Mar','Apr','May','Jun','Jul','Aug','Sep','Oct','Nov','Dec')[$mon];
    $wday2 = ('Sun','Mon','Tue','Wed','Thu','Fri','Sat')[$wday];
    $year = $year + 1900;
    $date = join('',$wday2,' ',$mon2,' ',$mday,' ',$hour,':',$min,':',$sec,' JST ',$year);
  } else {
    if ($year > 99) {
      $year = $year + 1900;
    }
    $mon = $mon + 1;
    $mon = "0$mon" if ($mon < 10);
    $mday = "0$mday" if ($mday < 10);
    $wday2 = ('日','月','火','水','木','金','土')[$wday];
    $date = join('',$year,'年',$mon,'月',$mday,'日','(',$wday2,') ',$hour,':',$min,':',$sec);
  }
  return($date);
}

# 時刻 と 環境変数 の文字列を返す.
# 1 で すべての環境変数を タグを付けて,
# 0 で 一部を除いたものを タグを付けないで 返す.
sub getEnv {
  local($a) = @_;
  local($key, $text);

  if ($a) {
    $text = &getDate(1).'<BR>'."\n";
    foreach $key (sort(keys %ENV)) {
      $text = $text.$key.' = '.$ENV{$key}.'<BR>'."\n";
    }
    $text = $text.'<BR>'."\n";
  } else {
    $text = &getDate(1)."\n";
    foreach $key (sort(keys %ENV)) {
      next if ($key eq 'DOCUMENT_ROOT');
      next if ($key eq 'GATEWAY_INTERFACE');
      next if ($key eq 'HTTP_HOST');
      next if ($key eq 'PATH');
      next if ($key eq 'SCRIPT_FILENAME');
      next if ($key eq 'SCRIPT_NAME');
      next if ($key eq 'SERVER_ADMIN');
      next if ($key eq 'SERVER_NAME');
      next if ($key eq 'SERVER_PORT');
      next if ($key eq 'SERVER_PROTOCOL');
      next if ($key eq 'SERVER_SOFTWARE');
      next if ($key eq 'SERVER_URL');
      if ($key eq 'HTTP_REFERER') {
        next if ($ENV{'HTTP_REFERER'} =~ /$myReferer/);
      }
      $text = $text.$key.' = '.$ENV{$key}."\n";
    }
    $text = $text."\n";
  }
  return($text);
}

# &getEnv(0) の戻り値 $text を $envFile に書き出す.
# $envFile は 1000行まで.
sub putEnv {
  local($text, $i, $s);

  $text = &getEnv(0);
  open(TMP, ">$tmpFile") || &exitPadCgi('error: putEnv().');
  if (-f $envFile) {
    open(FILE, "<$envFile") || &exitPadCgi('error: putEnv().');
    print TMP $text;
    $i = 0;
    while (<FILE>) {
      print TMP $_;
      $i++;
      last if ($i >= 1000);
    }
    close FILE;
  } else {
    print TMP $text;
  }
  close TMP;
  $s = "mv $tmpFile $envFile";
  system($s);
  chmod $myChmod, $envFile;
}

# 1 で $busyFile をつくって作業中のフラグとする.
# 0 で $busyFile を消す.
sub setBusy {
  local($a) = @_;
  local($date, $time);

  $date = &getDate(1);
  $time = time;
  if ($a) {
    if (&chkBusy) {
      sleep(2);
      if (&chkBusy) {
        &exitPadCgi('error: setBusy().');
      } else {
        &putErrFile("warning: setBusy().");
      }
    }
    open(BUSY, ">$busyFile") || &exitPadCgi('error: setBusy().');
    print BUSY $time, "\n";
    print BUSY $date, "\n";
    close BUSY;
  } else {
    unlink $busyFile if (-f $busyFile);
  }
}

# $busyFile があれば 1, 無ければ 0 を返す.
# もし 300秒以上前の $busyFile があれば, 消して,
# エラーログを残し, 0 を返す.
sub chkBusy {
  local($old, $now);
  local($oldDate);

  if (-f $busyFile) {
    open(BUSY, "<$busyFile") || &exitPadCgi('error: chkBusy().');
    chop($old = <BUSY>);
    chop($oldDate = <BUSY>);
    close BUSY;
    $now = time;
    if (($old + 300) > $now) {
      return(1);
    } else {
      &putErrFile("warning: chkBusy().  $oldDateのファイルが残っていました.");
      unlink $busyFile;
      return(0);
    }
  } else {
    return(0);
  }
}

# 発言番号を返す.
# $countFie が無ければ 1 を返す.
sub getCount {
  local($c);

  if (-f $countFile) {
    open(COUNT, "<$countFile") || &exitPadCgi('error: getCount().');
    $c = <COUNT>;
    close COUNT;
  } else {
    $c = 1;
  }
  return($c);
}

# 発言番号 $c を書く.
sub putCount {
  local($c) = @_;

  open(COUNT, ">$countFile") || &exitPadCgi('error: putCount().');
  print COUNT $c;
  close COUNT;
}

# 発言番号 $c が @logFile のどこに入っているか.
# $myPadLimit が 50 のとき, 0 〜 19 を返す.
# 100 のとき, 0 〜 9 を返す.
sub getLogNum {
  local($c) = @_;
  local($i);

  $i = $c % $myPadLimit;
  if ($i) {
    $i = $c - $i;
    $i = $i / $myPadLimit;
  } else {
    $i = $c / $myPadLimit - 1;
    if ($i < 0) {
      if ($myPadLimit == 100) {
        $i = 9;
      } else {
        $i = 19;
      }
    }
  }
  return($i);
}

# 発言番号 $c が $padFile に入っているか.
# 入っていれば 1 を返す. 入っていなければ 0 を返す.
sub isInPad {
  local($c) = @_;
  local($i);

  $i = &getCount - 1;
  if ((&getLogNum($i)) == (&getLogNum($c))) {
    return(1);
  } else {
    return(0);
  }
}

# $txt をシフトJISに. 複数行も可能.
sub toSjis {
  local($txt) = @_;

  &jcode'convert(*txt, 'sjis', '', 'z');
  return($txt);
}

# $txt を EUCに. 複数行も可能.
sub toEuc {
  local($txt) = @_;

  &jcode'convert(*txt, 'euc', '', 'z');
  return($txt);
}

# $text の記号のいくつかを番号符号に置き換える.
sub toNum {
  local($text) = @_;

  $text = &toEuc($text) if ($myOut eq $SJIS);
  $text =~ s/&/&#038;/go;
  $text =~ s/"/&#034;/go;
  $text =~ s/</&#060;/go;
  $text =~ s/>/&#062;/go;
  $text = &toSjis($text) if ($myOut eq $SJIS);
  return($text);
}

sub chkRegexp {
  local($key) = @_;

  $key =~ s/(\W)/\\\1/g;
  return($key);
}

# $text の文法チェックなど.
# 問題無し             ... 0
# 使って欲しくないタグ ... 1
# タグ構文エラー？     ... 2
sub chkHtml {
  local($text) = @_;
  local($a);

  $text = &toEuc($text) if ($myOut eq $SJIS);
  return(0) if !($text =~ /[<>]/o);

  $a = 0;
  foreach (@myBadTag) {
    $a++ if ($text =~ /<\/?$_\b/i);
    last if ($a);
  }
  $a++ if ($text =~ /$PAD_TOP/io);
  $a++ if ($text =~ /$PAD_BOTTOM/io);
  $a++ if ($text =~ /$PAD_REPLY/io);
  $a++ if ($text =~ /<a name/io);
  $a++ if ($text =~ /<!--/o);
  $a++ if ($text =~ /<img\b[^>]*\.cgi/io);
  $a++ if ($text =~ /<img\b[^>]*\.pl/io);
  $a++ if ($text =~ /<img\b[^>]*script:/io);
  if ($a) {
    &putErrFile($text);
    return(1);
  }
  $a = &chkTag(0, '', $text);
  return(2) unless ($a);
  return(0);
}

# $lastTag と $text に含まれる最初のタグ $newTag を比較する.
# 構文エラーで '' を返す.
# $rec が 0: chkHtmlが呼ぶ１回目.  1: 再帰呼び出し
sub chkTag {
  local($rec, $lastTag, $text) = @_;
  local($ret, $newTag, $bStart, $s, $t);

  $ret = 'dummy';
  $newTag = '';
  $s = $text;
  while ($s) {
    if ($s =~ /<\/?\w+\b/) { # タグ?
      $t = $&;
      $s = $'; # 次の文字から続ける.
      $bStart = 1;
      foreach (@myTag) {
        if ($t =~ /<\/?$_\b/i) {
          $newTag = $_;
          $bStart = 0 if (substr($&, 1, 1) eq '/');
          last;
        }
      }
      if ($newTag) {
        if ($bStart) {
          $ret = &chkTag(1, $newTag, $s);
          $s = $ret;
          $newTag = '';
        } else {
          if ($newTag eq $lastTag) {
            if ($rec) {
              $ret = $s;
              $s = '';
            }
          } else {
            $ret = '';
            $s = '';
          }
        }
      }
    } else {
      $s = '';
    }
  }
  if ($lastTag) {
    $ret = '' unless ($newTag);
  }
  return($ret);
}

# $key で始まる行の内容を返す. 見つからなければ ''.
# $mode は 1 が メールアドレス, 2 が ホームページ.
sub getName {
  local($key, $mode) = @_;
  local($line, $name, $ml, $hp);

  open(FILE, "<$nameFile") || &exitPadCgi('error: getName().');
  while (<FILE>) {
    last if (/^$PAD_TOP/io);
  }
  $name = &chkRegexp(&toEuc($key));
  $ml = '';
  $hp = '';
  while (<FILE>) {
    $line = &toEuc($_);
    if ($line =~ /^($name$PAD_SEP)(.*)(<BR>\n)$/i) {
      ($ml, $hp) = split(/$PAD_SEP/, $2, 2);
      last;
    }
  }
  close FILE;
  if ($mode == 1) {
    $ml = &toSjis($ml) if ($myOut eq $SJIS);
    return($ml);
  } else {
    $hp = &toSjis($hp) if ($myOut eq $SJIS);
    return($hp);
  }
}

# アドレスデータの表示.
sub dispName {
  open(FILE, "<$nameFile") || &exitPadCgi('error: dispName().');
  print "Content-type: text/html\n\n";
  while (<FILE>) {
    print $_;
  }
  close FILE;
}

# 表示.
sub dispPad {
  open(FILE, "<$padFile") || &exitPadCgi('error: dispPad().');
  print "Content-type: text/html\n\n";
  while (<FILE>) {
    print $_;
  }
  close FILE;
}

# $n 番目の過去ログの表示.
sub dispLog {
  local($n) = @_;

  open(FILE, "<$logFile[$n]") || &exitPadCgi('error: dispLog().');
  print "Content-type: text/html\n\n";
  while (<FILE>) {
    print $_;
  }
  close FILE;
}

# $msg を表示する関数.
sub dispMsg {
  local($msg) = @_;

  print <<"EndOfFile";
Content-type: text/html\n
<HTML><HEAD><TITLE>$myTitle</TITLE></HEAD>
$myBody
<P>$msg</P>
<HR>
<A HREF="$urlPadFile">$myMsgBack</A>
</BODY></HTML>
EndOfFile
}

# エラーメッセージを表示し, ログを残して終了.
sub exitPadCgi {
  local($text) = @_;

  print <<"EndOfFile";
Content-type: text/html\n
<HTML><HEAD><TITLE>$myTitle</TITLE></HEAD>
$myBody
<P>$myMsgErr</P>
<HR>
<A HREF="$urlPadFile">$myMsgBack</A>
</BODY></HTML>
EndOfFile

  &putErrFile($text);
  unlink $busyFile if (-f $busyFile);
  exit;
}

# $text を $errFile に書き出す.
# $errFile は 1000行まで.
# (ここの入出力エラーでは &exitPadCgi を呼び出さない!)
sub putErrFile {
  local($text) = @_;
  local($i, $s);

  $s = $text . "\n" . &getEnv(0);
  open(TMP, ">$errTmpFile");
  if (-f $errFile) {
    open(FILE, "<$errFile");
    print TMP $s;
    $i = 0;
    while (<FILE>) {
      print TMP $_;
      $i++;
      last if ($i >= 1000);
    }
    close FILE;
  } else {
    print TMP $s;
  }
  close TMP;
  $s = "mv $errTmpFile $errFile";
  system($s);
  chmod $myChmod, $errFile;
}
1;#dummy