HTML-Defang

 view release on metacpan or  search on metacpan

MANIFEST  view on Meta::CPAN

lib/HTML/Defang.pm
Makefile.PL
MANIFEST			This list of files
README
t/01_basic.t
t/02_xss.t
t/03_styles.t
t/04_imports.t
t/05_callbacks.t
t/06_unicode.t
t/07_rcdata.t
t/08_comments.t
t/09_attrs.t
META.yml                                 Module meta-data (added by MakeMaker)
META.json                                Module JSON meta-data (added by MakeMaker)

lib/HTML/Defang.pm  view on Meta::CPAN

my %InlineTags = map { $_ => 1 } qw(span abbr acronym q sub sup cite code em kbd samp strong var dfn strike b i u s tt small big nobr a font);
my %NestInlineTags = map { $_ => 1 } qw(span abbr acronym q sub sup cite code em kbd samp strong var dfn strike b i u s tt small big nobr);

# Default list of mismatched tags to track
my %MismatchedTags = (%BlockTags, %InlineTags);

# Elements whose contents are RCDATA (title, textarea) or RAWTEXT (noembed,
#  noframes): the browser does not parse comments or nested tags inside them,
#  only a matching end tag. We must consume their content as opaque text
#  rather than parsing it as HTML, or an attacker can smuggle a literal end
#  tag + active markup past us. See defang_rcdata_content(). (<script>,
#  <style> and the defanged raw-text tags like <xmp>/<iframe> are handled
#  separately.)
my %RawTextTags = map { $_ => 1 } qw(title textarea noembed noframes);

=head1 CONSTRUCTOR

=over 4

=cut

lib/HTML/Defang.pm  view on Meta::CPAN

        warn "defang Defang=$Defang" if $Debug;

        # RCDATA/RAWTEXT elements (title, textarea, noembed, noframes): their
        #  content is opaque text to a browser, not HTML. Consume it verbatim
        #  up to the matching end tag so we don't parse comments/tags inside
        #  it (which would let an attacker smuggle a literal end tag + active
        #  markup past the defanger). Skipped if a user tags_callback owns the
        #  tag, since it is then responsible for the content.
        if (!$IsEndTag && $RawTextTags{$lcTag}
            && !exists $Self->{tags_to_callback}->{$lcTag}) {
          $Self->defang_rcdata_content(\$I, $lcTag);
        }

        # Build tag content, because if we defang, we have to remove --'s within it

        # @Attributes can have unicode values, but we're within "use bytes", so it's flattened ok
        my $TagContent = $TagTrail . join("", grep { defined } map { @$_ } @Attributes);

        if ($Self->{fix_mismatched_tags} && ($Defang == DEFANG_NONE)) {
          if (!$IsEndTag) {
            $Defang = $Self->open_tag(0, $OutR, \$I, $lcTag, \$TagContent);

lib/HTML/Defang.pm  view on Meta::CPAN

        $ScriptTagContents = "<!-- " . $ScriptTagContents . " -->";
        $Self->add_to_output($ScriptTagContents);
      }
    }
  }

  # Also defang tag
  return DEFANG_ALWAYS;
}

=item I<defang_rcdata_content($HtmlR, $lcTag)>

Consume the RCDATA/RAWTEXT content of a "text" element and pass it straight
through to the output as opaque text.

The elements this applies to are C<< <title> >> and C<< <textarea> >>
(RCDATA) and C<< <noembed> >> and C<< <noframes> >> (RAWTEXT) - see the
listing in C<%RawTextTags>. Per the HTML5 tree construction/tokenization
spec, a start tag for one of these switches the tokenizer into a raw text
mode in which the browser does I<not> parse comments or nested tags - the
only markup it recognises is a matching C<< </tag >> end tag, everything

lib/HTML/Defang.pm  view on Meta::CPAN

We would emit the C<< <img> >> unchanged (believing it comment data), but a
browser closes the title at the literal C<< </title> >> and then runs the
C<< <img> >> as live markup.

So, like <script> and <style>, we consume everything up to the matching
C<< </tag >> (whose name is C<$lcTag>) as opaque text. That content contains
no C<< </tag >> (we stop before the first one), so re-parsed as raw text it
stays inert right up to the end tag that follows it in the output.

=cut
sub defang_rcdata_content {
  my ($Self, $HtmlR, $lcTag) = @_;

  warn "defang_rcdata_content Tag=$lcTag" if $Self->{Debug};

  # Do the raw text scan in byte mode (see defang())
  use bytes;

  # Consume raw content verbatim up to the matching end tag (or EOF if
  #  there's no closing tag, just as a browser would leave the element open)
  if ($$HtmlR =~ m{\G(.*?)(?=</\Q$lcTag\E\b)}gcis || $$HtmlR =~ m{\G(.*)$}gcs) {
    my $Content = $1;
    warn "defang_rcdata_content Content=$Content" if $Self->{Debug};
    $Self->add_to_output($Content) if defined($Content) && length($Content);
  }

  return;
}

sub defang_style_tag {
  my ($Self, $OutR, $HtmlR, $TagOps, $OpenAngle, $IsEndTag, $lcTag, $TagTrail, $Attributes, $CloseAngle) = @_;

  warn "defang_style_tag Tag=$lcTag IsEndTag=$IsEndTag" if $Self->{Debug};

t/01_basic.t  view on Meta::CPAN

# Refer http://msdn.microsoft.com/en-us/library/ms537512.aspx for IE conditional comment information
like($Res, qr{22:<!--${CommentStartText}\[if gte IE 4\]>}, "IE conditional downlevel-hidden comment start");
like($Res, qr{23:<SCRIPT>alert\('XSS'\);</SCRIPT>}, "IE conditional downlevel-hidden comment body");
like($Res, qr{24:<!\[endif\]${CommentEndText}-->}, "IE conditional downlevel-hidden comment end");
like($Res, qr{25:<!--${CommentStartText}\[if gte IE 4\]${CommentEndText}-->}, "IE conditional downlevel-revealed comment start");
like($Res, qr{26:<!--defang_SCRIPT--><!-- alert\('XSS'\); --><!--/defang_SCRIPT-->}, "IE conditional downlevel-revealed comment body");
like($Res, qr{27:<!--${CommentStartText}\[endif\]${CommentEndText}-->}, "IE conditional downlevel-revealed comment end");
like($Res, qr{27a:<!--${CommentStartText}\[if gte IE 4\]${CommentEndText}--><!--${DefangString}foo-->}, "IE conditional defang content");

# Some XML tests
# Refer http://www.w3schools.com/XML/xml_cdata.asp for information on CDATA
like($Res, qr{28:<!--${DefangString}XML ID=I--><!--${DefangString}X--><!--${DefangString}C-->}, "Defang unknown xml and other opening tags");
like($Res, qr{29:<!--${CommentStartText}\[CDATA\[<IMG SRC="javas]]${CommentEndText}-->}, "Comment out single-line cdata section");
like($Res, qr{30:<!--${CommentStartText}\[CDATA\[cript:alert\('XSS'\);">}, "Comment out multi-line cdata section start");
like($Res, qr{31:]]${CommentEndText}-->}, "Comment out multi-line cdata section end");
like($Res, qr{32:<!--/${DefangString}C--><!--/${DefangString}X--><!--/${DefangString}xml-->}, "Defang unknown xml and other closing tags");
# Make sure xss:xss tag comes after each import in the original html for the below checks
# HTML::Defang.pm tended to dump all HTML output without defanging if a '<?' tag was closed by just '>'
like($Res, qr{33:<!--\?import namespace="xss" implementation="http://ha.ckers.org/xss.htc"-->}, "Defang <?import tag");
like($Res, qr{34:<!--${DefangString}xss:xss-->XSS<!--/${DefangString}xss:xss-->}, "Defang xss:xss");
like($Res, qr{35:<!--\?import namespace="xss" implementation="http://ha.ckers.org/xss.htc"\?-->}, "Defang <?import tag with ending ?");
like($Res, qr{36:<!--${DefangString}xss:xss-->XSS<!--/${DefangString}xss:xss-->}, "Defang xss:xss");

# Attributes surrounded by backticks
like($Res, qr{37:<a defang_href="javascript:alert\(&quot;Surprise&quot;\);">}, "Defang invalid attribute surrounded by backticks");