KENTとつくろう! PerlでCGI

Back

「KENTと作ろう! PerlでCGI」

収録スクリプトの修正・補足事項

項修正内容書籍刷数

第1刷第2-3刷第4-6刷

1 bbs5.cgi における修正 (00/05/04) ○

2 search.cgi における補足修正 (00/05/04) ○

3 cruiser.cgi における補足修正 (00/05/04) ○

4 cruiser.cgi における修正 (00/05/07) : 重要 ○

5 cruiser.cgi における修正 (00/05/20) : 重要 ○

6 cruiser.cgi における修正 (00/06/18) ○ ○

7 search.cgi における修正 (00/06/18) : 重要
○

8 search.cgi における解説ページ修正 (00/09/24) ○ ○

9 cruiser.cgi における補足修正 (00/09/24) ○ ○

10 bbs3.cgi における補足修正 (00/10/17) : 重要 ○ ○

11 cruiser.cgi における補足修正 (01/02/21) : 重要 ○ ○ ○

項	修正内容	書籍刷数
第1刷	第2-3刷	第4-6刷
1	bbs5.cgi における修正 (00/05/04)	○
2	search.cgi における補足修正 (00/05/04)	○
3	cruiser.cgi における補足修正 (00/05/04)	○
4	cruiser.cgi における修正 (00/05/07) : 重要	○
5	cruiser.cgi における修正 (00/05/20) : 重要	○
6	cruiser.cgi における修正 (00/06/18)	○	○
7	search.cgi における修正 (00/06/18) : 重要		○
8	search.cgi における解説ページ修正 (00/09/24)	○	○
9	cruiser.cgi における補足修正 (00/09/24)	○	○
10	bbs3.cgi における補足修正 (00/10/17) : 重要	○	○
11	cruiser.cgi における補足修正 (01/02/21) : 重要	○	○	○

1. bbs5.cgi における修正

スクリプトの修正作業：スクリプトの記述ミス
IE4, IE5, ネットスケープ4 で動作確認してみたところ正常に処理をするので、ブラウザで拡大解釈をしてくれるらしいのですが、念のため以下のとおり修正を行ってください。
【変更前】 (先頭の数字は行数を表します) 155|# 削除キーフォーム 156|print "<div align=center>\n"; 157|print "<form acion=\"$script\" method=\"$method\">\n"; 【変更後】 155|# 削除キーフォーム 156|print "<div align=center>\n"; 157|print "<form action=\"$script\" method=\"$method\">\n";
2. search.cgi における補足修正

@nifty などで、CGIファイルのURL表示がHTMLファイルのURL表示と異なる場合はこの修正が必要です。
http://からの絶対URLが、HTMLもCGIも特に変わらないプロバイダでは、今回の修正は必要ありません。

例：以下のように、HTMLとCGIとでは絶対パスが異なるケース
　HTML : http://homepage1.nifty.com/xxx/hoge.html
　CGI : http://hpcgi1.nifty.com/xxx/bbs5.cgi

15行目 ■変更前 # 対象ディレクトリ $area = ".."; ■変更後 # 対象ディレクトリ $area = ".."; # 上の「対象ディレクトリ」の絶対パス(URL) $url_path = "http://homepage1.nifty.com/xxx"; 106行目 ■変更前 local($dir) = $_[0]; local(@lines, $line, $file); ■変更後 local($dir, $floor) = @_; local(@lines, $line, $file, $path); 116行目 ■変更前 # 対象をパス付で定義 $file = "$dir\/$line"; ■変更後 # 対象をパス付で定義 $file = "$dir\/$line"; $path = "$url_path$floor\/$line"; 122行目 ■変更前 if ($line eq "$target") { &opendir($file); } ■変更後 if ($line eq "$target") { &opendir("$file","$floor/$line"); } 162行目 ■変更前 print "<LI><a href=\"$file\"><b>$title</b></a>\n"; ■変更後 print "<LI><a href=\"$path\"><b>$title</b></a>\n";
3. cruiser.cgi における補足修正

スクリプトの修正作業：登録作業を管理者限定にする場合の処理定義を追加
新規データの登録作業を、標準のユーザ登録方式 ($regist=0;) にする方は、この修正は必要ありません。
1072行目付近：「管理モード」サブルーチン部 ■変更前 #--------------# # 管理モード # #--------------# sub admin { if ($FORM{'action'}) { if ($FORM{'pwd'} ne "$pass") { &error("パスワードが違います"); } } &header; print "[<a href=\"$script\?\">メニューに戻る</a>]\n"; print "<center><table width='100%'><tr><th bgcolor=\"#6699CC\">\n"; print "<font color=\"#FFFFFF\">管理用画面</font>\n"; print "</th></tr></table><P>\n"; # 入室画面 if ($FORM{'action'} eq '') { print "<B>処理を選択し、パスワードを入力してください</B>\n"; print "<form action=\"$script\" method=\"$method\">\n"; print "<input type=hidden name=mode value=\"admin\">\n"; print "<input type=hidden name=action value=\"in\">\n"; print "<select name=part>\n"; foreach (0 .. $#parts) { print "<option value=\"$_\">$parts[$_]\n"; } print "</select>\n"; print "<P><input type=radio name=do value=\"del\" checked><B>削除</B>\n"; print "<input type=radio name=do value=\"rec\"><B>推奨</B>\n"; print "<P><input type=password name=pwd size=8>"; print "<input type=submit value=\" 認証 \">\n"; ■変更後 #--------------# # 管理モード # #--------------# sub admin { if ($FORM{'action'}) { if ($FORM{'pwd'} ne "$pass") { &error("パスワードが違います"); } } if ($FORM{'do'} eq "reg") { &new_url; } &header; print "[<a href=\"$script\?\">メニューに戻る</a>]\n"; print "<center><table width='100%'><tr><th bgcolor=\"#6699CC\">\n"; print "<font color=\"#FFFFFF\">管理用画面</font>\n"; print "</th></tr></table><P>\n"; # 入室画面 if ($FORM{'action'} eq '') { print "<B>処理を選択し、パスワードを入力してください</B>\n"; print "<form action=\"$script\" method=\"$method\">\n"; print "<input type=hidden name=mode value=\"admin\">\n"; print "<input type=hidden name=action value=\"in\">\n"; print "<select name=part>\n"; foreach (0 .. $#parts) { print "<option value=\"$_\">$parts[$_]\n"; } print "</select>\n"; print "<P><input type=radio name=do value=\"del\" checked><B>削除</B>\n"; print "<input type=radio name=do value=\"rec\"><B>推奨</B>\n"; if (!$regist) { print "<input type=radio name=do value=\"reg\"><B>登録</B>\n"; } print "<P><input type=password name=pwd size=8>"; print "<input type=submit value=\" 認証 \">\n"; 326行目付近：「新規登録画面」サブルーチン部 ■変更前 <table><tr><td> <OL> <LI>新規登録を行います。 <LI>下記フォームに内容を記述し、登録ボタンを押してください。 <LI>パスワードは今後のメンテナンスに必要なので必ず記入してください。 </OL> </td></tr></table> <table width=560 height=3 cellspacing=0 cellpadding=0> <tr><td bgcolor="$obi_color"><img width=1 height=3></td></tr> </table> <form action="$script" method="$method"> <input type=hidden name=mode value="regist"> ■変更後 <table><tr><td> <OL> <LI>新規登録を行います。 <LI>下記フォームに内容を記述し、登録ボタンを押してください。 <LI>パスワードは今後のメンテナンスに必要なので必ず記入してください。 </OL> </td></tr></table> <table width=560 height=3 cellspacing=0 cellpadding=0> <tr><td bgcolor="$obi_color"><img width=1 height=3></td></tr> </table> <form action="$script" method="$method"> <input type=hidden name=mode value="regist"> <input type=hidden name=pwd value="$FORM{'pwd'}"> 386行目付近：「登録処理」サブルーチン部 ■変更前 #------------# # 登録処理 # #------------# sub regist { # ホスト名をチェック &get_host; local($flag)=0; foreach (@deny) { if ($_ eq "") { next; } $_ =~ s/\*/\.\*/g; if ($host =~ /$_/) { $flag=1; last; } } if ($flag) { &error("現在新規登録はできません"); } ■変更後 #------------# # 登録処理 # #------------# sub regist { # ホスト名をチェック &get_host; local($flag)=0; foreach (@deny) { if ($_ eq "") { next; } $_ =~ s/\*/\.\*/g; if ($host =~ /$_/) { $flag=1; last; } } if ($flag) { &error("現在新規登録はできません"); } if (!$regist && $FORM{'pwd'} ne "$pass") { &error("不正なアクセスです"); } 451行目付近：「登録処理」サブルーチン部 ■変更前 # 新着ファイル open(IN,"$newfile"); @data = <IN>; close(IN); while ($w_new <= @data) { pop(@data); } ($no,$pt2,$sp2,$sub2,$url2,$name2,$mail2,$pw2, $msg2,$dt2,$t2,$n2,$r2,$host2) = split(/<>/, $data[0]); if ($host eq "$host2") { &error("連続登録は禁止されています<br> お１人様１つでお願いします"); } $no++; ■変更後 # 新着ファイル open(IN,"$newfile"); @data = <IN>; close(IN); while ($w_new <= @data) { pop(@data); } ($no,$pt2,$sp2,$sub2,$url2,$name2,$mail2,$pw2, $msg2,$dt2,$t2,$n2,$r2,$host2) = split(/<>/, $data[0]); if ($regist && $host eq "$host2") { &error("連続登録は禁止されています<br> お１人様１つでお願いします","lock"); } $no++;
4. cruiser.cgi における修正

スクリプトの修正作業：管理モードからの「推奨マーク」付加作業でデータフォーマットが崩れてしまうバグの修正

1220行目付近：「管理者一括削除／推奨マーク付加処理」サブルーチン部 ■変更前 ## 推奨マーク付加処理 } elsif ($FORM{'do'} eq 'rec') { @new=(); foreach $line (@lines) { ($no,$part,$subpt,$sub,$hp,$name,$email, $pw,$msg,$dt,$ts,$rec,$axs,$ho) = split(/<>/, $line); foreach (@recs) { if ($no eq "$_") { if ($rec == 0) { $rec = 1; } else { $rec = 0; } $line = "$no<>$part<>$sub<>$hp<>$name<>$email<>$pw<>$msg<>$dt<>$ts<>$rec<>$axs<>$ho<>\n"; last; } } push(@new,$line); } } ■変更後 ## 推奨マーク付加処理 } elsif ($FORM{'do'} eq 'rec') { @new=(); foreach $line (@lines) { ($no,$part,$subpt,$sub,$hp,$name,$email, $pw,$msg,$dt,$ts,$rec,$axs,$ho) = split(/<>/, $line); foreach (@recs) { if ($no eq "$_") { if ($rec == 0) { $rec = 1; } else { $rec = 0; } $line = "$no<>$part<>$subpt<>$sub<>$hp<>$name<>$email<>$pw<>$msg<>$dt<>$ts<>$rec<>$axs<>$ho<>\n"; last; } } push(@new,$line); } }
5. cruiser.cgi における修正

スクリプトの修正作業：オプション設定にて、「同一URLの二重登録を許可」をありとしている場合 ($w_url = 1;) 、同一カテゴルのファイルが常に最新１件としてしか登録保存されないバグ。
「同一URLの二重登録を許可」をなしとしている場合 ($w_url=0;) にはこの不具合は出ませんが、念のため今後のことを考えて修正していただくようお願いいたします。

482行目付近：「管理者一括削除／推奨マーク付加処理」サブルーチン部 ■変更前 # ファイルに追加 unshift(@new,$new); $logfile = "$logdir\/$FORM{'part'}\.dat"; open(OUT,">$logfile") || &error("Write Error : $logfile","lock"); print OUT @new; close(OUT); ■変更後 # ファイルに追加 $logfile = "$logdir\/$FORM{'part'}\.dat"; if ($w_url) { open(IN,"$logfile") || &error("Open Error : $logfile","lock"); @new = <IN>; close(IN); } unshift(@new,$new); open(OUT,">$logfile") || &error("Write Error : $logfile","lock"); print OUT @new; close(OUT);
6. cruiser.cgi における修正

カテゴリページの先頭部のリンク記述の不備。

905行目 ■変更前 print "[ <a href=\"$script\">トップページ</a> > "; if ($FORM{'subpt'} ne "") { if ($FORM{'subpt'} eq '99') { $SUB[$FORM{'subpt'}] = 'その他'; } print "<a href=\"$scrpt?mode=part&part=$FORM{'part'}\">$parts[$FORM{'part'}]</a> "; print "> <b>$SUB[$FORM{'subpt'}]</b> ]\n"; } else { print "<b>$parts[$FORM{'part'}]</b> ]\n"; } ■変更後 print "[ <a href=\"$script\">トップページ</a> > "; if ($FORM{'subpt'} ne "") { if ($FORM{'subpt'} eq '99') { $SUB[$FORM{'subpt'}] = 'その他'; } print "<a href=\"$script?mode=part&part=$FORM{'part'}\">$parts[$FORM{'part'}]</a> "; print "> <b>$SUB[$FORM{'subpt'}]</b> ]\n"; } else { print "<b>$parts[$FORM{'part'}]</b> ]\n"; }
7. search.cgi における修正

ディレクトリ呼び出し部の不備。

105行目 ■変更前 #--------------------------# # ディレクトリ内読み取り # #--------------------------# sub opendir { local($dir) = $_[0]; local(@lines, $line, $file, $path); ■変更後 #--------------------------# # ディレクトリ内読み取り # #--------------------------# sub opendir { local($dir, $floor) = @_; local(@lines, $line, $file, $path);

8. search.cgi における解説ページ修正

検索範囲内の説明個所の誤植

192ページ目
■変更前
ディレクトリ例２
public_html / index.html  ←検索対象
     |
     +-- secret / file3.html
     |
     +-- file / serach.cgi
                file1.html
                file2.html

■変更後
ディレクトリ例２
public_html / index.html  ←非検索対象
     |
     +-- secret / file3.html
     |
     +-- file / serach.cgi
                file1.html
                file2.html

9. cruiser.cgi における補足修正

管理モードから項目を削除した場合に「新着情報」からもそれを削除する。

最大登録件数の設定が効かない不具合を修正。

1201行目付近
■変更前
#--------------------------------------#
#  管理者一括削除／推奨マーク付加処理    #
#--------------------------------------#
sub admin_edit {
if ($FORM{'pwd'} ne "$pass") { &error("パスワードが違います"); }

# ロック開始
if ($lockkey == 1) { &lock1; }
elsif ($lockkey == 2) { &lock2; }

$logfile = "$logdir\/$FORM{'part'}\.dat";
open(IN,"$logfile") || &error("Can't open $logfile","lock");
@lines = <IN>;
close(IN);

## 削除処理
if ($FORM{'do'} eq 'del') {
@new=();
foreach $line (@lines) {
$dflag=0;
($no,$part,$subpt,$sub,$hp,$name,$email,
$pw,$msg,$dt,$ts,$rec,$axs,$ho) = split(/<>/, $line);

foreach $del (@delete) {
if ($no eq "$del") { $dflag=1; last; }
}

if ($dflag == 0) { push(@new,$line); }
}

■変更後
#--------------------------------------#
#  管理者一括削除／推奨マーク付加処理    #
#--------------------------------------#
sub admin_edit {
if ($FORM{'pwd'} ne "$pass") { &error("パスワードが違います"); }

# ロック開始
if ($lockkey == 1) { &lock1; }
elsif ($lockkey == 2) { &lock2; }

$logfile = "$logdir\/$FORM{'part'}\.dat";
open(IN,"$logfile") || &error("Can't open $logfile","lock");
@lines = <IN>;
close(IN);

## 削除処理
if ($FORM{'do'} eq 'del') {
@new=();
foreach $line (@lines) {
$dflag=0;
($no,$part,$subpt,$sub,$hp,$name,$email,
$pw,$msg,$dt,$ts,$rec,$axs,$ho) = split(/<>/, $line);

foreach $del (@delete) {
if ($no eq "$del") { $dflag=1; last; }
}

if ($dflag == 0) { push(@new,$line); }
}

# ↓追加：ここから
@new2=();
open(IN,"$newfile") || &error("Open Error : $newfile");
@data = <IN>;
close(IN);

$match=0;
foreach (@data) {
$dflag=0;
($no,$dmy) = split(/<>/);

foreach $del (@delete) {
if ($no eq "$del") { $match=1; $dflag=1; last; }
}
if ($dflag == 0) { push(@new2,$_); }
}
# 該当記事があれば更新
if ($match) {
open(OUT,">$newfile") || &error("Write Error : $newfile");
print OUT @new2;
close(OUT);
}
# ↑追加：ここまで


259行目付近
■変更前
if ($regist) { $DT = "<DT>・<a href=\"$script?mode=new_url\">新規登録</a><P>"; }

■変更後
# 新着ファイルをチェック
open(IN,"$newfile") || &error("Open Error : $newfile");
$top = <IN>;
close(IN);
local($no,$pt,$sp,$sub,$ur,$nam,
	$ml,$pw,$msg,$dt,$t,$n,$r,$h,$all) = split(/<>/, $top);
if ($regist && $max > $all) {
$DT = "<DT>・<a href=\"$script?mode=new_url\">新規登録</a><P>";
}

1201行目付近
■変更前
# 二重登録をチェック
if (!$w_url) {
$match=0;
foreach (0 .. $#parts) {
open(IN,"$logdir\/$_\.dat") || &error("Open Error : $_\.dat","lock");
@lines = <IN>;
close(IN);

# 分類が同一の場合配列を更新用に一時コピー
if ($FORM{'part'} eq "$_") { @new = @lines; }

foreach (@lines) {
local($no,$part,$subpt,$sub,$hp,$name,$email) = split(/<>/, $_);

# URLが合致すればループを解除
if ($FORM{'url'} eq "$hp") { $match=1; last; }
if ($FORM{'email'} eq "$email") { $match=2; last; }
}
}
if ($match == 1) { &error("登録しようとするURLは既に登録済です","lock"); }
if ($match == 2) { &error("他のサイトで登録済みです。<br>
				お１人様１つしか登録できません","lock"); }
}

# パスワードを暗号化
$PW = &e_passwd("$FORM{'pwd'}");

# 新着ファイル
open(IN,"$newfile");
@data = <IN>;
close(IN);

while ($w_new <= @data) { pop(@data); }

($no,$pt2,$sp2,$sub2,$url2,$name2,$mail2,$pw2,
	$msg2,$dt2,$t2,$n2,$r2,$host2) = split(/<>/, $data[0]);
if ($regist && $host eq "$host2") { &error("連続登録は禁止されています<br>
						お１人様１つでお願いします"); }
$no++;

# 登録記事をフォーマット
$new = "$no<>$FORM{'part'}<>$subpt<>$FORM{'sub'}<>$FORM{'url'}<>$FORM{'name'}<>
$FORM{'email'}<>$PW<>$FORM{'msg'}<>$date<>$times<>0<>0<>$host<>\n";

# 禁止ワード
$match=0;
foreach (@WORDS) {
if (index($new,$_) >= 0) { $match=1; last; }
}
# 警告
if ($match) { &error("禁止ワード「$word」が使用されています","lock"); }

# 新着ファイルを更新
unshift(@data,$new);
open(OUT,">$newfile");
print OUT @data;
close(OUT);

# ファイルに追加
$logfile = "$logdir\/$FORM{'part'}\.dat";
if ($w_url) {
open(IN,"$logfile") || &error("Open Error : $logfile","lock");
@new = <IN>;
close(IN);
}
unshift(@new,$new);
open(OUT,">$logfile") || &error("Write Error : $logfile","lock");
print OUT @new;
close(OUT);

# ロック解除
unlink($lockfile) if (-e $lockfile);

■変更後
# 二重登録をチェック
$i=1;
$maxflag=0;
$match=0;
foreach (0 .. $#parts) {
if ($maxflag || $match) { last; }
open(IN,"$logdir\/$_\.dat") || &error("Open Error : $_\.dat","lock");
@lines = <IN>;
close(IN);

# 分類が同一の場合配列を更新用に一時コピー
if ($FORM{'part'} eq "$_") { @new = @lines; }

foreach (@lines) {
$i++;
if ($i > $max) { $maxflag=1; last; }
local($no,$part,$subpt,$sub,$hp,$name,$email) = split(/<>/);

# URLが合致すればループを解除
if (!$w_url) {
if ($FORM{'url'} eq "$hp") { $match=1; last; }
if ($FORM{'email'} eq "$email") { $match=2; last; }
}
}
}
if ($maxflag) {
&error("規定の登録件数を超えため現在登録を中止しています","lock");
}
if (!$w_url) {
if ($match == 1) { &error("登録しようとするURLは既に登録済です","lock"); }
if ($match == 2) { &error("他のサイトを登録済みです。<br>
				お１人様１つしか登録できません","lock"); }
}

# パスワードを暗号化
$PW = &e_passwd("$FORM{'pwd'}");

# 新着ファイル
open(IN,"$newfile");
@data = <IN>;
close(IN);

while ($w_new <= @data) { pop(@data); }

($no,$pt2,$sp2,$sub2,$url2,$name2,$mail2,$pw2,
	$msg2,$dt2,$t2,$n2,$r2,$host2) = split(/<>/, $data[0]);
if ($regist && $host eq "$host2") { &error("連続登録は禁止されています<br>
						お１人様１つでお願いします"); }
$no++;

# 登録記事をフォーマット
$new = "$no<>$FORM{'part'}<>$subpt<>$FORM{'sub'}<>$FORM{'url'}<>$FORM{'name'}<>
$FORM{'email'}<>$PW<>$FORM{'msg'}<>$date<>$times<>0<>0<>$host<>";

# 禁止ワード
$match=0;
foreach (@WORDS) {
if (index($new,$_) >= 0) { $match=1; last; }
}
# 警告
if ($match) { &error("禁止ワード「$word」が使用されています","lock"); }

# 新着ファイルを更新
unshift(@data,"$new$i<>\n");
open(OUT,">$newfile");
print OUT @data;
close(OUT);

# ファイルに追加
$logfile = "$logdir\/$FORM{'part'}\.dat";
if ($w_url) {
open(IN,"$logfile") || &error("Open Error : $logfile","lock");
@new = <IN>;
close(IN);
}
unshift(@new,"$new\n");
open(OUT,">$logfile") || &error("Write Error : $logfile","lock");
print OUT @new;
close(OUT);

# ロック解除
unlink($lockfile) if (-e $lockfile);

10. bbs3.cgi における補足修正

クッキーの発行と取得におけるID名の不一致。

307行目付近：クッキー取得サブルーチン部分
■変更前
#-----------------#
# クッキーを取得   #
#-----------------#
sub get_cookie {
  # クッキー情報を取得
  $cookie = $ENV{'HTTP_COOKIE'};

  # 取得したクッキー情報を分解
  @pairs = split(/;/, $cookie);
  foreach $pair (@pairs) {
    local($name,$value) = split(/=/, $pair);
    $name =~ s/\s//g;
    $DUMMY{$name} = $value;
  }

  # クッキーIDを指定
  @pairs = split(/,/, $DUMMY{'EZBBS'});
  foreach $pair (@pairs) {
    local($name,$value) = split(/:/, $pair);
    $COOKIE{$name} = $value;
  }

■変更後
#-----------------#
# クッキーを取得   #
#-----------------#
sub get_cookie {
  # クッキー情報を取得
  $cookie = $ENV{'HTTP_COOKIE'};

  # 取得したクッキー情報を分解
  @pairs = split(/;/, $cookie);
  foreach $pair (@pairs) {
    local($name,$value) = split(/=/, $pair);
    $name =~ s/\s//g;
    $DUMMY{$name} = $value;
  }

  # クッキーIDを指定
  @pairs = split(/,/, $DUMMY{'WEBBBS'});
  foreach $pair (@pairs) {
    local($name,$value) = split(/:/, $pair);
    $COOKIE{$name} = $value;
  }

11. cruiser.cgi における補足修正

セキュリティ強化。

307行目付近：クッキー取得サブルーチン部分

■変更前
sub decode {
	if ($ENV{'REQUEST_METHOD'} eq "POST") {
		if ($ENV{'CONTENT_LENGTH'} > 51200) { &error("投稿量が大きすぎます"); }
		read(STDIN, $buffer, $ENV{'CONTENT_LENGTH'});
	} else { $buffer = $ENV{'QUERY_STRING'}; }

	@pairs = split(/&/, $buffer);
	foreach $pair (@pairs) {
		($name, $value) = split(/=/, $pair);
		$value =~ tr/+/ /;
		$value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;

		# 文字コード変換
		&jcode'convert(*value,'sjis');

		# タグ処理
		$value =~ s/\"/&quot;/g;
		$value =~ s/</&lt;/g;
		$value =~ s/>/&gt;/g;

		# 改行処理
		if ($name eq "msg") {
			$value =~ s/\r\n/<br>/g;
			$value =~ s/\r/<br>/g;
			$value =~ s/\n/<br>/g;
		} else {
			$value =~ s/\r//g;
			$value =~ s/\n//g;
		}

		# 削除／推奨マーク処理
		if ($name eq 'del') { push(@delete,$value); }
		elsif ($name eq 'rec') { push(@recs,$value); }

		$FORM{$name} = $value;
	}
	$mode = $FORM{'mode'};
	$page = $FORM{'page'};
}
■変更後
sub decode {
	if ($ENV{'REQUEST_METHOD'} eq "POST") {
		if ($ENV{'CONTENT_LENGTH'} > 51200) { &error("投稿量が大きすぎます"); }
		read(STDIN, $buffer, $ENV{'CONTENT_LENGTH'});
	} else { $buffer = $ENV{'QUERY_STRING'}; }

	@pairs = split(/&/, $buffer);
	foreach $pair (@pairs) {
		($name, $value) = split(/=/, $pair);
		$value =~ tr/+/ /;
		$value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;

		# 文字コード変換
		&jcode'convert(*value,'sjis');

		# タグ処理
		$value =~ s/\"/&quot;/g;
		$value =~ s/</&lt;/g;
		$value =~ s/>/&gt;/g;

		# 改行処理
		if ($name eq "msg") {
			$value =~ s/\r\n/<br>/g;
			$value =~ s/\r/<br>/g;
			$value =~ s/\n/<br>/g;
		} else {
			$value =~ s/\r//g;
			$value =~ s/\n//g;
		}

		# 削除／推奨マーク処理
		if ($name eq 'del') { push(@delete,$value); }
		elsif ($name eq 'rec') { push(@recs,$value); }

		$FORM{$name} = $value;
	}
	$mode = $FORM{'mode'};
	$page = $FORM{'page'};
	# ↓追加
	$FORM{'part'} =~ s/[^0-9\:]//g;
}