.\" Automatically generated by Pod::Man 2.23 (Pod::Simple 3.13) .\" .\" Standard preamble: .\" ======================================================================== .de Sp \" Vertical space (when we can't use .PP) .if t .sp .5v .if n .sp .. .de Vb \" Begin verbatim text .ft CW .nf .ne \\$1 .. .de Ve \" End verbatim text .ft R .fi .. .\" Set up some character translations and predefined strings. \*(-- will .\" give an unbreakable dash, \*(PI will give pi, \*(L" will give a left .\" double quote, and \*(R" will give a right double quote. \*(C+ will .\" give a nicer C++. Capital omega is used to do unbreakable dashes and .\" therefore won't be available. \*(C` and \*(C' expand to `' in nroff, .\" nothing in troff, for use with C<>. .tr \(*W- .ds C+ C\v'-.1v'\h'-1p'\s-2+\h'-1p'+\s0\v'.1v'\h'-1p' .ie n \{\ . ds -- \(*W- . ds PI pi . if (\n(.H=4u)&(1m=24u) .ds -- \(*W\h'-12u'\(*W\h'-12u'-\" diablo 10 pitch . if (\n(.H=4u)&(1m=20u) .ds -- \(*W\h'-12u'\(*W\h'-8u'-\" diablo 12 pitch . ds L" "" . ds R" "" . ds C` "" . ds C' "" 'br\} .el\{\ . ds -- \|\(em\| . ds PI \(*p . ds L" `` . ds R" '' 'br\} .\" .\" Escape single quotes in literal strings from groff's Unicode transform. .ie \n(.g .ds Aq \(aq .el .ds Aq ' .\" .\" If the F register is turned on, we'll generate index entries on stderr for .\" titles (.TH), headers (.SH), subsections (.SS), items (.Ip), and index .\" entries marked with X<> in POD. Of course, you'll have to process the .\" output yourself in some meaningful fashion. .ie \nF \{\ . de IX . tm Index:\\$1\t\\n%\t"\\$2" .. . nr % 0 . rr F .\} .el \{\ . de IX .. .\} .\" .\" Accent mark definitions (@(#)ms.acc 1.5 88/02/08 SMI; from UCB 4.2). .\" Fear. Run. Save yourself. No user-serviceable parts. . \" fudge factors for nroff and troff .if n \{\ . ds #H 0 . ds #V .8m . ds #F .3m . ds #[ \f1 . ds #] \fP .\} .if t \{\ . ds #H ((1u-(\\\\n(.fu%2u))*.13m) . ds #V .6m . ds #F 0 . ds #[ \& . ds #] \& .\} . \" simple accents for nroff and troff .if n \{\ . ds ' \& . ds ` \& . ds ^ \& . ds , \& . ds ~ ~ . ds / .\} .if t \{\ . ds ' \\k:\h'-(\\n(.wu*8/10-\*(#H)'\'\h"|\\n:u" . ds ` \\k:\h'-(\\n(.wu*8/10-\*(#H)'\`\h'|\\n:u' . ds ^ \\k:\h'-(\\n(.wu*10/11-\*(#H)'^\h'|\\n:u' . ds , \\k:\h'-(\\n(.wu*8/10)',\h'|\\n:u' . ds ~ \\k:\h'-(\\n(.wu-\*(#H-.1m)'~\h'|\\n:u' . ds / \\k:\h'-(\\n(.wu*8/10-\*(#H)'\z\(sl\h'|\\n:u' .\} . \" troff and (daisy-wheel) nroff accents .ds : \\k:\h'-(\\n(.wu*8/10-\*(#H+.1m+\*(#F)'\v'-\*(#V'\z.\h'.2m+\*(#F'.\h'|\\n:u'\v'\*(#V' .ds 8 \h'\*(#H'\(*b\h'-\*(#H' .ds o \\k:\h'-(\\n(.wu+\w'\(de'u-\*(#H)/2u'\v'-.3n'\*(#[\z\(de\v'.3n'\h'|\\n:u'\*(#] .ds d- \h'\*(#H'\(pd\h'-\w'~'u'\v'-.25m'\f2\(hy\fP\v'.25m'\h'-\*(#H' .ds D- D\\k:\h'-\w'D'u'\v'-.11m'\z\(hy\v'.11m'\h'|\\n:u' .ds th \*(#[\v'.3m'\s+1I\s-1\v'-.3m'\h'-(\w'I'u*2/3)'\s-1o\s+1\*(#] .ds Th \*(#[\s+2I\s-2\h'-\w'I'u*3/5'\v'-.3m'o\v'.3m'\*(#] .ds ae a\h'-(\w'a'u*4/10)'e .ds Ae A\h'-(\w'A'u*4/10)'E . \" corrections for vroff .if v .ds ~ \\k:\h'-(\\n(.wu*9/10-\*(#H)'\s-2\u~\d\s+2\h'|\\n:u' .if v .ds ^ \\k:\h'-(\\n(.wu*10/11-\*(#H)'\v'-.4m'^\v'.4m'\h'|\\n:u' . \" for low resolution devices (crt and lpr) .if \n(.H>23 .if \n(.V>19 \ \{\ . ds : e . ds 8 ss . ds o a . ds d- d\h'-1'\(ga . ds D- D\h'-1'\(hy . ds th \o'bp' . ds Th \o'LP' . ds ae ae . ds Ae AE .\} .rm #[ #] #H #V #F C .\" ======================================================================== .\" .IX Title "Scrubber 3" .TH Scrubber 3 "2010-05-05" "perl v5.12.0" "User Contributed Perl Documentation" .\" For nroff, turn off justification. Always turn off hyphenation; it makes .\" way too many mistakes in technical documents. .if n .ad l .nh .SH "NAME" HTML::Scrubber \- Perl extension for scrubbing/sanitizing html .SH "SYNOPSIS" .IX Header "SYNOPSIS" .Vb 10 \& #!/usr/bin/perl \-w \& use HTML::Scrubber; \& use strict; \& # \& my $html = q[ \& \& \&
\& a => link \& br =>
\& b => bold \& u => UNDERLINE \& ]; \& # \& my $scrubber = HTML::Scrubber\->new( allow => [ qw[ p b i u hr br ] ] ); # \& # \& print $scrubber\->scrub($html); # \& # \& $scrubber\->deny( qw[ p b i u hr br ] ); # \& # \& print $scrubber\->scrub($html); # \& # .Ve .SH "DESCRIPTION" .IX Header "DESCRIPTION" If you wanna \*(L"scrub\*(R" or \*(L"sanitize\*(R" html input in a reliable an flexible fashion, then this module is for you. .PP I wasn't satisfied with HTML::Sanitizer because it is based on HTML::TreeBuilder, so I thought I'd write something similar that works directly with HTML::Parser. .SH "METHODS" .IX Header "METHODS" First a note on documentation: just study the \s-1EXAMPLE\s0 below. It's all the documentation you could need .PP Also, be sure to read all the comments as well as How does it work?. .PP If you're new to perl, good luck to you. .SS "comment" .IX Subsection "comment" .Vb 2 \& warn "comments are ", $p\->comment ? \*(Aqallowed\*(Aq : \*(Aqnot allowed\*(Aq; \& $p\->comment(0); # off by default .Ve .SS "process" .IX Subsection "process" .Vb 2 \& warn "process instructions are ", $p\->process ? \*(Aqallowed\*(Aq : \*(Aqnot allowed\*(Aq; \& $p\->process(0); # off by default .Ve .SS "script" .IX Subsection "script" .Vb 3 \& warn "script tags (and everything in between) are supressed" \& if $p\->script; # off by default \& $p\->script( 0 || 1 ); .Ve .PP \&\fB**\fR Please note that this is implemented using HTML::Parser's ignore_elements function, so if \f(CW\*(C`script\*(C'\fR is set to true, all script tags encountered will be validated like all other tags. .SS "style" .IX Subsection "style" .Vb 3 \& warn "style tags (and everything in between) are supressed" \& if $p\->style; # off by default \& $p\->style( 0 || 1 ); .Ve .PP \&\fB**\fR Please note that this is implemented using HTML::Parser's ignore_elements function, so if \f(CW\*(C`style\*(C'\fR is set to true, all style tags encountered will be validated like all other tags. .SS "allow" .IX Subsection "allow" .Vb 1 \& $p\->allow(qw[ t a g s ]); .Ve .SS "deny" .IX Subsection "deny" .Vb 1 \& $p\->deny(qw[ t a g s ]); .Ve .SS "rules" .IX Subsection "rules" .Vb 9 \& $p\->rules( \& img => { \& src => qr{^(?!http://)}i, # only relative image links allowed \& alt => 1, # alt attribute allowed \& \*(Aq*\*(Aq => 0, # deny all other attributes \& }, \& b => 1, \& ... \& ); .Ve .SS "default" .IX Subsection "default" .Vb 8 \& print "default is ", $p\->default(); \& $p\->default(1); # allow tags by default \& $p\->default( \& undef, # don\*(Aqt change \& { # default attribute rules \& \*(Aq*\*(Aq => 1, # allow attributes by default \& } \& ); .Ve .SS "scrub_file" .IX Subsection "scrub_file" .Vb 6 \& $html = $scrubber\->scrub_file(\*(Aqfoo.html\*(Aq); ## returns giant string \& die "Eeek $!" unless defined $html; ## opening foo.html may have failed \& $scrubber\->scrub_file(\*(Aqfoo.html\*(Aq, \*(Aqnew.html\*(Aq) or die "Eeek $!"; \& $scrubber\->scrub_file(\*(Aqfoo.html\*(Aq, *STDOUT) \& or die "Eeek $!" \& if fileno STDOUT; .Ve .SS "scrub" .IX Subsection "scrub" .Vb 5 \& print $scrubber\->scrub($html); ## returns giant string \& $scrubber\->scrub($html, \*(Aqnew.html\*(Aq) or die "Eeek $!"; \& $scrubber\->scrub($html\*(Aq, *STDOUT) \& or die "Eeek $!" \& if fileno STDOUT; .Ve .SH "How does it work?" .IX Header "How does it work?" When a tag is encountered, HTML::Scrubber allows/denies the tag using the explicit rule if one exists. .PP If no explicit rule exists, Scrubber applies the default rule. .PP If an explicit rule exists, but it's a simple \fIrule\fR\|(1), the default attribute rule is applied. .SS "\s-1EXAMPLE\s0" .IX Subsection "EXAMPLE" .Vb 10 \& #!/usr/bin/perl \-w \& use HTML::Scrubber; \& use strict; \& # \& my @allow = qw[ br hr b a ]; \& # \& my @rules = ( \& script => 0, \& img => { \& src => qr{^(?!http://)}i, # only relative image links allowed \& alt => 1, # alt attribute allowed \& \*(Aq*\*(Aq => 0, # deny all other attributes \& }, \& ); \& # \& my @default = ( \& 0 => # default rule, deny all tags \& { \& \*(Aq*\*(Aq => 1, # default rule, allow all attributes \& \*(Aqhref\*(Aq => qr{^(?!(?:java)?script)}i, \& \*(Aqsrc\*(Aq => qr{^(?!(?:java)?script)}i, \& # If your perl doesn\*(Aqt have qr \& # just use a string with length greater than 1 \& \*(Aqcite\*(Aq => \*(Aq(?i\-xsm:^(?!(?:java)?script))\*(Aq, \& \*(Aqlanguage\*(Aq => 0, \& \*(Aqname\*(Aq => 1, # could be sneaky, but hey ;) \& \*(Aqonblur\*(Aq => 0, \& \*(Aqonchange\*(Aq => 0, \& \*(Aqonclick\*(Aq => 0, \& \*(Aqondblclick\*(Aq => 0, \& \*(Aqonerror\*(Aq => 0, \& \*(Aqonfocus\*(Aq => 0, \& \*(Aqonkeydown\*(Aq => 0, \& \*(Aqonkeypress\*(Aq => 0, \& \*(Aqonkeyup\*(Aq => 0, \& \*(Aqonload\*(Aq => 0, \& \*(Aqonmousedown\*(Aq => 0, \& \*(Aqonmousemove\*(Aq => 0, \& \*(Aqonmouseout\*(Aq => 0, \& \*(Aqonmouseover\*(Aq => 0, \& \*(Aqonmouseup\*(Aq => 0, \& \*(Aqonreset\*(Aq => 0, \& \*(Aqonselect\*(Aq => 0, \& \*(Aqonsubmit\*(Aq => 0, \& \*(Aqonunload\*(Aq => 0, \& \*(Aqsrc\*(Aq => 0, \& \*(Aqtype\*(Aq => 0, \& } \& ); \& # \& my $scrubber = HTML::Scrubber\->new(); \& $scrubber\->allow( @allow ); \& $scrubber\->rules( @rules ); # key/value pairs \& $scrubber\->default( @default ); \& $scrubber\->comment(1); # 1 allow, 0 deny \& # \& ## preferred way to create the same object \& $scrubber = HTML::Scrubber\->new( \& allow => \e@allow, \& rules => \e@rules, \& default => \e@default, \& comment => 1, \& process => 0, \& ); \& # \& require Data::Dumper,die Data::Dumper::Dumper($scrubber) if @ARGV; \& # \& my $it = q[ \& \&
\& IN ITALICS WITH FAKE="attribute"
\& IN BOLD
\& \& HREF=JAVA <!> \&
\& \& ONMOUSEOVER JAVASCRIPT \& \&
\& ]; \& # \& print "#original text",$/, $it, $/; \& print \& "#scrubbed text (default ", \& $scrubber\->default(), # no arguments returns the current value \& " comment ", \& $scrubber\->comment(), \& " process ", \& $scrubber\->process(), \& " )", \& $/, \& $scrubber\->scrub($it), \& $/; \& # \& $scrubber\->default(1); # allow all tags by default \& $scrubber\->comment(0); # deny comments \& # \& print \& "#scrubbed text (default ", \& $scrubber\->default(), \& " comment ", \& $scrubber\->comment(), \& " process ", \& $scrubber\->process(), \& " )", \& $/, \& $scrubber\->scrub($it), \& $/; \& # \& $scrubber\->process(1); # allow process instructions (dangerous) \& $default[0] = 1; # allow all tags by default \& $default[1]\->{\*(Aq*\*(Aq} = 0; # deny all attributes by default \& $scrubber\->default(@default); # set the default again \& # \& print \& "#scrubbed text (default ", \& $scrubber\->default(), \& " comment ", \& $scrubber\->comment(), \& " process ", \& $scrubber\->process(), \& " )", \& $/, \& $scrubber\->scrub($it), \& $/; .Ve .SS "\s-1FUN\s0" .IX Subsection "FUN" If you have Test::Inline (and you've installed HTML::Scrubber), try .PP .Vb 2 \& pod2test Scrubber.pm >scrubber.t \& perl scrubber.t .Ve .SH "SEE ALSO" .IX Header "SEE ALSO" HTML::Parser, Test::Inline, HTML::Sanitizer. .SH "BUGS/SUGGESTIONS/ETC" .IX Header "BUGS/SUGGESTIONS/ETC" Please use https://rt.cpan.org/NoAuth/Bugs.html?Dist=HTML\-Scrubber to report \fIbugs\fR/additions/etc or send mail to . .SH "AUTHOR" .IX Header "AUTHOR" D. H. (PodMaster) .SH "LICENSE" .IX Header "LICENSE" Copyright (c) 2003\-2004 by D.H. (PodMaster). All rights reserved. .PP This module is free software; you can redistribute it and/or modify it under the same terms as Perl itself. The \s-1LICENSE\s0 file contains the full text of the license.