#!/usr/local/bin/perl ### read.cgi ver 2.05 (2001/08/22) # ----------------------------------------------------------- use strict; use vars qw($ver); use vars qw($gzip_path); use vars qw($gzip_enable); $ver="read.cgi ver4.20 (2001/7/31)"; $gzip_path = "/usr/local/bin/gzip"; $gzip_enable = 1; #================================================== #　初期情報の取得（ＰＯＳＴ） #================================================== { use vars qw(%FORM); my ($buffer, @pairs, $name, $value); if ($ENV{'REQUEST_METHOD'} eq "GET") { $buffer = $ENV{'QUERY_STRING'}; @pairs = split(/&/,$buffer); foreach (@pairs) { ($name, $value) = split /=/; $value =~ tr/+/ /; $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack('H2',$1)/eg; $FORM{$name} = $value; } } } #================================================== #　エラーレスポンス（ＢＢＳ情報） #================================================== { if(!-e "../$FORM{'bbs'}/dat/$FORM{'key'}.dat" || $FORM{'bbs'} =~ /(\.|\/)/){ DispError("そんな板orスレッドないです。"); } if(-s "../$FORM{'bbs'}/dat/$FORM{'key'}.dat" > 512000) { DispError("このスレッド大きすぎます。"); } } #================================================== #　初期情報の取得（設定ファイル） #================================================== { use vars qw(%SETTING); $SETTING{"BBS_BG_COLOR"}="#EFEFEF"; $SETTING{"BBS_SUBJECT_COLOR"}="#FF0000"; $SETTING{"BBS_NAME_COLOR"}="forestgreen"; $SETTING{"BBS_TEXT_COLOR"}="#000000"; $SETTING{"BBS_LINK_COLOR"}="#0000FF"; $SETTING{"BBS_ALINK_COLOR"}="#FF0000"; $SETTING{"BBS_VLINK_COLOR"}="#660099"; } #================================================== #　変数の設定 #================================================== { use vars qw($start); use vars qw($end); use vars qw($NOW); use vars qw(@LOG); $NOW=time; open(ALL,"../$FORM{'bbs'}/dat/$FORM{'key'}.dat"); @LOG=; close(ALL); my $LINENUM=@LOG; if($FORM{'st'}){ $start=$FORM{'st'}; }else { $start=1; } $end = $FORM{'to'}+1; if($FORM{'ls'}){$start = $LINENUM - $FORM{'ls'} + 1;} if ($start<1||$start>$LINENUM){$start=1;} if(!$end){$end=$LINENUM+1;} my $subject=(split /<>/,$LOG[0])[4]; my ($name,$mail,$time,$message,$mailto); if(!$FORM{'imode'}){ print "Content-type: text/html\n"; if ( $gzip_enable ){ if ( $ENV{'HTTP_ACCEPT_ENCODING'} =~ /x-gzip/ ){ print "Content-encoding: x-gzip\n\n"; } elsif ( $ENV{'HTTP_ACCEPT_ENCODING'} =~ /gzip/ ){ print "Content-encoding: gzip\n\n"; } else { print "\n"; $gzip_enable = 0; } } else { print "\n"; } open(STDOUT,"| $gzip_path -1 -c") if $gzip_enable; print < ■戻る 全部読む 最新100件
EOF if ($LINENUM >=1000){ print <


レス数が 1000 を超えています。残念ながら全部は表\示しません。
EOF }elsif ($LINENUM >=950){ print <
レス数が 950 を超えています。1000を超えると表\示できなくなるよ。
EOF }elsif ($LINENUM >=900){ print <
レス数が 900 を超えています。1000を超えると表\示できなくなるよ。
EOF } print < $subject
EOF if($FORM{'nofirst'} ne "true" || $FORM{'st'} eq 1){ chop($LOG[0]); ($name,$mail,$time,$message,$subject) = split(/<>/,$LOG[0]); #本文が空の場合 if ($message eq "") { $name=""; $mail=""; $time="[ここ壊れてます]"; $message="[ここ壊れてます]"; } $message =~ s/(https?|ftp|gopher|telnet|whois|news)\:([\w|\:\!\#\$\%\=\&\-\^\`\\\|\@\~\[\{\]\}\;\+\*\,\.\?\/]+)/$1\:$2<\/a>/ig; if($mail){ $mailto = "$name "; }else{ $mailto = "$name "; } print "
1: $mailto $time
$message
\n"; if($start eq 1){$start++;} } while($start != $end){ unless($LOG[$start-1]){last;} chop($LOG[$start-1]); ($name,$mail,$time,$message,$subject) = split(/<>/,$LOG[$start-1]); #本文が空の場合 if ($message eq "") { $name=""; $mail=""; $time="[ここ壊れてます]"; $message="[ここ壊れてます]"; } $message =~ s/(https?|ftp|gopher|telnet|whois|news)\:([\w|\:\!\#\$\%\=\&\-\^\`\\\|\@\~\[\{\]\}\;\+\*\,\.\?\/]+)/$1\:$2<\/a>/ig; if($mail){ $mailto = "$name"; }else{ $mailto = "$name"; } print "
$start :$mailto $time
$message
\n"; $start++; } if ($LINENUM <= 1000){ print <
名前： E-mail（省略可）：
EOF } print <

$ver EOF close(STDOUT) if $gzip_enable; }else{ #================================================== #　ｉ−ｍｏｄｅ用 #================================================== if($start eq 10){$start = 1;$end=10;} if($end-$start => 11) {$end=$start+10;} if($FORM{'ls'} eq 10 || $FORM{'st'} eq '' && $FORM{'to'} eq '' && $FORM{'ls'} eq '' && @LOG > 10){ $start = $LINENUM - 10; $end=@LOG+1; } if ($start<1||$start>$LINENUM){$start=1;} print "Content-type: text/html\n\n"; print < $subject ■戻る レスを最初から読む 最新10

$subject
EOF if($FORM{'nofirst'} ne "true" || $FORM{'st'} eq 1){ chop($LOG[0]); ($name,$mail,$time,$message,$subject) = split(/<>/,$LOG[0]); #本文が空の場合 if ($message eq "") { $name=""; $mail=""; $time="[ここ壊れてます]"; $message="[ここ壊れてます]"; } $message =~ s/(https?|ftp|gopher|telnet|whois|news)\:([\w|\:\!\#\$\%\=\&\-\^\`\\\|\@\~\[\{\]\}\;\+\*\,\.\?\/]+)/$1\:$2<\/a>/ig; if($mail){ $mailto = "$name "; }else{ $mailto = "$name "; } print "

[1:$mailto($time)]
$message

\n"; if($start eq 1){$start++;} } while($start != $end){ unless($LOG[$start-1]){last;} chop($LOG[$start-1]); ($name,$mail,$time,$message,$subject) = split(/<>/,$LOG[$start-1]); #本文が空の場合 if ($message eq "") { $name=""; $mail=""; $time="[ここ壊れてます]"; $message="[ここ壊れてます]"; } $message =~ s/(https?|ftp|gopher|telnet|whois|news)\:([\w|\:\!\#\$\%\=\&\-\^\`\\\|\@\~\[\{\]\}\;\+\*\,\.\?\/]+)/$1\:$2<\/a>/ig; if($mail){ $mailto = "$name "; }else{ $mailto = "$name "; } print "

[$start:$mailto($time)]
$message

\n"; $start++; } my $FL=1; if($FORM{'ls'} || $end > 1001 || $end > @LOG-1){$FL=0} if($FL){ my $start1=$start+10; print <次の 10 レスを見る 最新レス 10
EOF } print "
\n"; print " "; print "NAME："; print "MAIL："; print "
"; print "\n"; print "\n"; print "\n"; print "\n"; print "

\n"; print "

$ver"; print ""; print ""; exit; } } #エラー画面（エラー処理） #DispError(TITLE,TOPIC); sub DispError{ my ($topic)=@_; print "Content-type: text/html; charset=shift_jis\n\n"; #----------------------------------------------------------------------- print < $topic

$topic

1 名前：$ver投稿日：2001/04/12(木) 15:11
$topic


$ver

EOF my $datn = substr($FORM{'key'},0,3); if (-e "../$FORM{'bbs'}/kako/$datn/$FORM{'key'}.html"){ print "隊長! 過去ログ倉庫で、スレッド $FORM{'key'}.html　を発見しました。\n"; }elsif (-e "../$FORM{'bbs'}/kako/$datn/$FORM{'key'}.dat"){ print "隊長! 過去ログ倉庫で、スレッド $FORM{'key'}.dat　を発見しました。
が、しかしまだ html化されていません。残念、待つしかない。\n"; }else{ print "過去ログ倉庫にもありませんでした。
問い合わせても見つかる可能\性はほとんどありません。\n"; } print < EOF exit; }