perl Decoder気づいたこと(掲示板の迷惑なURLの取り消し)

移植のために準備していて出てきました。
#!C:/Perl64/bin/perl

print "Content-type:text/html\n\n";
print &lt;&lt;EOF ;
&lt;!DOCTYPE html&gt;
&lt;html lang="ja"&gt;
&lt;head&gt;
 &lt;meta charset="UTF-8"&gt;
&lt;title&gt;&lt;/title&gt;
&lt;/head&gt;
&lt;BODY BGCOLOR="#ffffff"&gt;
&lt;h1&gt;test decoder&lt;/h1&gt;
EOF
my %in;
&amp;decode;

$come = $in{'comment'};
$come =~ s/\r\n/\&lt;br\&gt;\r\n/g;

&amp;form;
print "end sucuript.&lt;br&gt;\n";

# ここから下へ飛ぶ。終わらせてもいい。
#-------------------------------------------------
#  form
#-------------------------------------------------
sub form {

print "日本語テスト&lt;br&gt;$ENV{'SCRIPT_NAME'}&lt;br&gt;\n";

	print &lt;&lt;EOM;
&lt;form action="$ENV{'SCRIPT_NAME'}" method="POST"&gt;
&lt;!--&lt;form action="http://localhost/my_test/cgi_test/perl_test.cgi" method="POST"&gt;--&gt;
&lt;table border=0 cellspacing=1&gt;
&lt;tr&gt;&lt;td&gt;&lt;b&gt;name&lt;/b&gt;&lt;/td&gt;&lt;td&gt;&lt;input type=text name=name size=28 value="$in{'name'}" maxlength="12" class=f&gt;&lt;/td&gt;&lt;/tr&gt;
&lt;tr&gt;&lt;td&gt;&lt;b&gt;email&lt;/b&gt;&lt;/td&gt;&lt;td&gt;&lt;input type=text name=email size=28 value="$in{'email'}" maxlength="36" class=f&gt;&lt;/td&gt;&lt;/tr&gt;
&lt;tr&gt;&lt;td&gt;&lt;b&gt;submit&lt;/b&gt;&lt;/td&gt;&lt;td&gt;&lt;input type=text name=subm size=36 value="$in{'subm'}"  maxlength="36"class=f&gt;&lt;/td&gt;&lt;/tr&gt;
&lt;tr&gt;&lt;td colspan=2&gt;&lt;b&gt;comment&lt;/b&gt;&lt;br&gt;&lt;textarea cols=70 rows=7 name=comment wrap="soft" class=f&gt;$in{'comment'}&lt;/textarea&gt;&lt;/td&gt;&lt;/tr&gt;
&lt;tr&gt;&lt;td&gt;&lt;b&gt;url&lt;/b&gt;&lt;/td&gt;&lt;td&gt;&lt;input type=text size=52 name=url value="$in{'url'}" maxlength="60" class=f&gt;&lt;/td&gt;&lt;/tr&gt;
&lt;tr&gt;&lt;td&gt;&lt;b&gt;password&lt;/b&gt;&lt;/td&gt;&lt;td&gt;&lt;input type=password size=28 name=password value="$in{'password'}" maxlength="12" class=f&gt;&lt;/td&gt;&lt;/tr&gt;
&lt;tr&gt;&lt;td&gt;&lt;input type=submit value="submit"&gt;&lt;/td&gt;&lt;td&gt;&lt;input type=reset value="reset"&gt;&lt;/td&gt;&lt;/tr&gt;
&lt;!-- &lt;input type="hidden" name="url" value=""&gt; --&gt;
&lt;/form&gt;&lt;/table&gt;
&lt;br&gt;
name=$in{'name'}&lt;br&gt;
$come&lt;br&gt;
It OK?
&lt;br&gt;
EOM
}

#-------------------------------------------------
#  デコード処理 Post Get だめ
#-------------------------------------------------
sub decode {
	local($buf,$key,$val);
	undef(%in);
#	undef($in{'name'}, $in{'email'}, $in{'subm'}, $in{'comment'}, $in{'url'}, $in{'password'});
	
print "ローカルに来たよ。&lt;br&gt;\n";
	if ($ENV{'REQUEST_METHOD'} eq "POST") {
		$post_flag=1;
		if ($ENV{'CONTENT_LENGTH'} &gt; 51200) { &amp;error("投稿量が大きすぎます"); }
		read(STDIN, $buf, $ENV{'CONTENT_LENGTH'});
	} else {
		$post_flag=1;
		$buf = $ENV{'QUERY_STRING'};
		if($buf &gt; 3){print "GETは受け付けていません。";} #GET受付、アドレスバーしない?
#アドレスバーで改ざんのし放題やんけ、これ効かないとフォームに無い要素も受け入れる。パスワードを一致するまで
#アドレスへjavascriptで
	}
print "ここはきたよ&lt;br&gt;\n";
	foreach ( split(/&amp;/, $buf) ) {
		($key, $val) = split(/=/);
		$key =~ s/\0//g;
		$key =~ s/\"/&amp;quot;/g; #koko20131029
 		$key =~ s/&lt;/&amp;lt;/g;
 		$key =~ s/&gt;/&amp;gt;/g;
		if(!($kye eq '' || $kye eq 'name' || $kye eq 'email' || $kye eq 'subm' || $kye eq 'comment' || $kye eq 'url' || $kye eq 'password')){
			print "this cgi not request.&lt;br&gt;\n";   #動かんのかな?
		}		
		if($key =~ m/\;/){$val = "";&amp;error("エラー・GET&lt;br&gt;&lt;a href=\"$script\"&gt;戻る&lt;/a&gt;");}
		$val =~ tr/+/ /;
		$val =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("H2", $1)/eg;
		# エスケープ
		$val =~ s/\0//g;
		$val =~ s/&amp;/&amp;amp;/g;
	#	$val =~ s/&amp;amp;\#/&amp;#/g;
		$val =~ s/"/&amp;quot;/g;
		$val =~ s/&lt;/&amp;lt;/g;
		$val =~ s/&gt;/&amp;gt;/g;
	#	$val =~ s/\r\n/&lt;br&gt;/g;
	#	$val =~ s/\r/&lt;br&gt;/g;
	#	$val =~ s/\n/&lt;br&gt;/g;
	#	$val =~ s/[\x00-\x20]+/ /g;
		if($key eq 'mode' &amp;&amp; $val eq 'admin'){
			$ouna_kensa = 1;
			$autolink = 1;
		}elsif($key eq 'url' &amp;&amp; $val !~ m/^&amp;lt;a./ ){
			#この項目は何もしない
		}else{
			if ($val =~ m/https?\:[\w\.\~\-\/\?\&amp;\+\=\:\(\)\@\%\;\#\%]+/){
				$val =~ s/https?\:[\w\.\~\-\/\?\&amp;\+\=\:\(\)\@\%\;\#\%]+/&lt;b&gt;ＵＲＬは、禁止されました。&lt;\/b&gt;/g; #ノーテスト				
				$url_kensa = 1;
			}
				#&amp;error("ＵＲＬは、禁止されました。");}
		}

		$in{$key} .= "\0" if (defined($in{$key}));
		$in{$key} .= $val;

		if($in{'url'} || $in{'comment'} || $in{'name'} || $in{'subm'}){
			$kensa_val = $val;
			$kensa_val =~ s/\s//g;
			$kensa_val =~ s/\　//g;
			foreach $ck_url_p (@ck_url_bad){
				chomp $ck_url_p;
				#hen2023/07/23
				if(($kensa_val =~ m/$ck_url_p/i) &amp;&amp; ($in{'kugiri'} eq 'no')){
					&amp;error("書き込みＵＲＬは、禁止されました。1");
					exit;
				}
			}
		}

	}
}
#-------　フォーム要素名　---------　入力確認用　後で消すこと
print "&lt;table border='1'&gt;";
print "&lt;tr&gt;&lt;th&gt;フォーム要素名&lt;/th&gt;&lt;th&gt;データ&lt;/th&gt;&lt;/tr&gt;";
#
foreach $key (keys %in) {
print "&lt;tr&gt;&lt;th&gt;$key&lt;/th&gt;&lt;td&gt;$in{$key}&lt;/td&gt;&lt;/tr&gt;\n";
}
print "&lt;/table&gt;";
print "&lt;/BODY&gt;&lt;/html&gt;";

exit;
#ここでメインは終わり。
sub error {
	#return;
	if(! $_[1]){
print	"&lt;h1&gt;ERROR $_[0] ダメやんか。&lt;/h1&gt;\n";	#ほんとは、html内にあるとは限らない。
	}else{
print "Content-type:text/html\n\n";		
print "&lt;!DOCTYPE html&gt;&lt;head&gt;&lt;title&gt;&lt;/title&gt;&lt;/head&gt;&lt;BODY&gt;&lt;h1&gt;Error $_[0] !&lt;/h1&gt;";
	}
print "&lt;/BODY&gt;&lt;/html&gt;";
exit;
}
__END__
 ここからはメモ書きなに書いてもやらん。
使い方がまだ慣れていない。