HTMLを含む文字列をパースして一部のタグと属性だけを許可する。

Perl

特定のHTMLタグ以外を削除する正規表現またはperlモジュールを教えてください。 について需要がありそうなわりに簡単に、google でも見つからなかったので書いてみた。

仕様としては

  • 許可しているタグ（要素）を残し、許可していないものは削除（または「<」と「>」を実体参照に置き換えエスケープ）する。
  • 許可している属性を残し、許可していない属性は取り除く。
  • 特定の属性（href等）についてはスキームについてもチェックし、許可されていないスキームであればその属性を取り除く。
  • 要素名、属性名は全て小文字に統一。
  • 属性値は全て「"」で囲む。

最後の二つは「そうしたい」というより、処理の都合上「そうなってしまう」というのが本当のところ。

あまり自信はないのだが、とりあえず動いているので掲載。



sub HTML_Escape {

	my $str = shift;

	local $new_str;
	use HTML::Parser();
	# 設定：許可する要素及びその属性

	local %Elements = (

		a	=> [href],

		img	=> [src,width,height],

		em	=> [],

	);

	# 設定：許可されていないタグの扱い

	local $Escape = 1; # 0:タグを削除 1:タグをエスケープ('>'→'&gt;' '<'→'&lt;')
	# 設定：許可するスキーム

	local $Scheme = 'https?|ftp';
	# 設定：スキームをチェックすべき属性（変更不要）

	local $SchemeAttr = 'href|cite|src|data';
	my $parser = HTML::Parser->new( 

		api_version => 3,

		start_h	=> [\&start_tag,'tagname, attr'],

		end_h	=> [\&end_tag,'tagname'],

		text_h	=> [sub{$new_str.= shift;},'dtext'],

	);

	$parser->parse( $str );

	$parser->eof;
	return $new_str;

}

sub start_tag {

	my ($tagname,$attr) = @_;

	my $new_tag = '';

	$tagname = lc $tagname;
	if(exists $Elements{$tagname}) {

		$new_tag .= '<'.$tagname;

		while ( my ($key, $val) = each %$attr ){

			$key = lc $key;

			for(@{ $Elements{$tagname} }) {

				if($key eq $_ ) {

					next unless($key !~ /$SchemeAttr/ or $key =~ /$SchemeAttr/ and $val =~ /^($Scheme):/i);

					$new_tag .= ' '.$key.'="'.$val.'"';

				}

			}

		}

		$new_tag .= '>';

	} elsif($Escape) {

		$new_tag .= '&gt;'.$tagname;

		while ( my ($key, $val) = each %$attr ){

			$key = lc $key;

			$new_tag .= ' '.$key.'="'.$val.'"';

		}

		$new_tag .= '&lt;';

	}

	$new_str .= $new_tag;

}
sub end_tag {

	my $tagname = shift;

	$tagname = lc $tagname;
	if(exists $Elements{$tagname}) {

		$new_str .= "";

	} elsif($Escape) {

		$new_str .= "&lt;/$tagname&gt;";

	}

}

HTML_Escape関数の使用例



my $str =<<HTML;

<a href="javsacript:alert('NG')">javascriptは<i>使えない。</i></a>

<a href="http://d.hatena.ne.jp/Mars/" onclick="alert('NG')">Mars Diary</a>

HTML
my $result = HTML_Escape($str);
print $result;

結果

<a>javascriptは使えない。</a>

<a href="http://d.hatena.ne.jp/Mars/">Mars Diary</a>

掲示板のコメント欄なんかに使うのを想定しているのだからタグの閉じ忘れ防止策（自動補正？）なんかも入れたいところ。
インターフェースとかもっと改善の余地有り、ってゆーかPerlについて全然わかってないのがバレバレですね。

HTML_escape Sample … 動作テスト用のページ