HTML-Defang-1.07/0000755000000000000000000000000013316605446012075 5ustar rootrootHTML-Defang-1.07/README0000644000000000000000000000116713316605416012757 0ustar rootrootHTML-Defang version 1.07 ======================== This module accepts an input HTML and/or CSS string and removes any executable code including scripting, embedded objects, applets, etc., and neutralises any XSS attacks. A whitelist based approach is used which means only HTML known to be safe is allowed through. INSTALLATION To install this module type the following: perl Makefile.PL make make test make install DEPENDENCIES None COPYRIGHT AND LICENCE Copyright (C) 2003-2018 by FastMail Pty Ltd This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. HTML-Defang-1.07/Makefile.PL0000644000000000000000000000105013312112446014030 0ustar rootrootuse 5.008008; use ExtUtils::MakeMaker; # See lib/ExtUtils/MakeMaker.pm for details of how to influence # the contents of the Makefile that is written. WriteMakefile( NAME => 'HTML::Defang', VERSION_FROM => 'lib/HTML/Defang.pm', # finds $VERSION PREREQ_PM => {}, # e.g., Module::Name => 1.1 ($] >= 5.005 ? ## Add these new keywords supported since 5.005 (ABSTRACT_FROM => 'lib/HTML/Defang.pm', # retrieve abstract from module AUTHOR => 'Rob Mueller ') : ()), ); HTML-Defang-1.07/META.json0000644000000000000000000000161313316605446013517 0ustar rootroot{ "abstract" : "Cleans HTML as well as CSS of scripting and other executable contents, and neutralises XSS attacks.", "author" : [ "Rob Mueller " ], "dynamic_config" : 1, "generated_by" : "ExtUtils::MakeMaker version 6.98, CPAN::Meta::Converter version 2.142690", "license" : [ "unknown" ], "meta-spec" : { "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", "version" : "2" }, "name" : "HTML-Defang", "no_index" : { "directory" : [ "t", "inc" ] }, "prereqs" : { "build" : { "requires" : { "ExtUtils::MakeMaker" : "0" } }, "configure" : { "requires" : { "ExtUtils::MakeMaker" : "0" } }, "runtime" : { "requires" : {} } }, "release_status" : "stable", "version" : 1.07 } HTML-Defang-1.07/lib/0000755000000000000000000000000013316605446012643 5ustar rootrootHTML-Defang-1.07/lib/HTML/0000755000000000000000000000000013316605446013407 5ustar rootrootHTML-Defang-1.07/lib/HTML/Defang.pm0000644000000000000000000023137413316605247015142 0ustar rootrootpackage HTML::Defang; =head1 NAME HTML::Defang - Cleans HTML as well as CSS of scripting and other executable contents, and neutralises XSS attacks. =head1 SYNOPSIS my $InputHtml = ""; my $Defang = HTML::Defang->new( context => $Self, fix_mismatched_tags => 1, tags_to_callback => [ br embed img ], tags_callback => \&DefangTagsCallback, url_callback => \&DefangUrlCallback, css_callback => \&DefangCssCallback, attribs_to_callback => [ qw(border src) ], attribs_callback => \&DefangAttribsCallback, content_callback => \&ContentCallback, ); my $SanitizedHtml = $Defang->defang($InputHtml); # Callback for custom handling specific HTML tags sub DefangTagsCallback { my ($Self, $Defang, $OpenAngle, $lcTag, $IsEndTag, $AttributeHash, $CloseAngle, $HtmlR, $OutR) = @_; # Explicitly defang this tag, eventhough safe return DEFANG_ALWAYS if $lcTag eq 'br'; # Explicitly whitelist this tag, eventhough unsafe return DEFANG_NONE if $lcTag eq 'embed'; # I am not sure what to do with this tag, so process as HTML::Defang normally would return DEFANG_DEFAULT if $lcTag eq 'img'; } # Callback for custom handling URLs in HTML attributes as well as style tag/attribute declarations sub DefangUrlCallback { my ($Self, $Defang, $lcTag, $lcAttrKey, $AttrValR, $AttributeHash, $HtmlR) = @_; # Explicitly allow this URL in tag attributes or stylesheets return DEFANG_NONE if $$AttrValR =~ /safesite.com/i; # Explicitly defang this URL in tag attributes or stylesheets return DEFANG_ALWAYS if $$AttrValR =~ /evilsite.com/i; } # Callback for custom handling style tags/attributes sub DefangCssCallback { my ($Self, $Defang, $Selectors, $SelectorRules, $Tag, $IsAttr) = @_; my $i = 0; foreach (@$Selectors) { my $SelectorRule = $$SelectorRules[$i]; foreach my $KeyValueRules (@$SelectorRule) { foreach my $KeyValueRule (@$KeyValueRules) { my ($Key, $Value) = @$KeyValueRule; # Comment out any '!important' directive $$KeyValueRule[2] = DEFANG_ALWAYS if $Value =~ '!important'; # Comment out any 'position=fixed;' declaration $$KeyValueRule[2] = DEFANG_ALWAYS if $Key =~ 'position' && $Value =~ 'fixed'; } } $i++; } } # Callback for custom handling HTML tag attributes sub DefangAttribsCallback { my ($Self, $Defang, $lcTag, $lcAttrKey, $AttrValR, $HtmlR) = @_; # Change all 'border' attribute values to zero. $$AttrValR = '0' if $lcAttrKey eq 'border'; # Defang all 'src' attributes return DEFANG_ALWAYS if $lcAttrKey eq 'src'; return DEFANG_NONE; } # Callback for all content between tags (except ") if !$ClosingStyleTagPresent; return $Defang; } =item I Defang some raw css data and return the defanged content =over 4 =item B =over 4 =item I<$Content> The input style string that is defanged. =item I<$IsAttr> True if $Content is from an attribute, otherwise from a EOF $Res = $Defang->defang($H); like($Res, qr{^$}, "Test 1"); $H = <\@import url(style.css); EOF $Res = $Defang->defang($H); like($Res, qr{^$}, "Test 2"); $H = <\@import "style.css"; EOF $Res = $Defang->defang($H); like($Res, qr{^$}, "Test 3"); $H = <\@import url("style.css") all; EOF $Res = $Defang->defang($H); like($Res, qr{^$}, "Test 4"); $H = <\@import url("&#115;tyle.css"); EOF $Res = $Defang->defang($H); like($Res, qr{^$}, "Test 5"); $H = <&#64;import url("style.css"); EOF $Res = $Defang->defang($H); like($Res, qr{^$}, "Test 6"); $H = <\@import url("style.%63ss"); EOF $Res = $Defang->defang($H); like($Res, qr{^$}, "Test 7"); $H = <\@import/**/"style.css"; EOF $Res = $Defang->defang($H); like($Res, qr{^$}, "Test 8"); $H = <\@import "style.css"/**/; EOF $Res = $Defang->defang($H); like($Res, qr{^$}, "Test 9"); $H = <\@import url(/**/"style.css"); EOF $Res = $Defang->defang($H); like($Res, qr{^$}, "Test 10"); $H = <\@imp\6F rt url("style.css"); EOF $Res = $Defang->defang($H); like($Res, qr{^$}, "Test 11"); $H = <\@import\**\"style.css"; EOF $Res = $Defang->defang($H); like($Res, qr{^$}, "Test 12"); $H = <\@im\\port url("style.css"); EOF $Res = $Defang->defang($H); like($Res, qr{^$}, "Test 13"); $H = <\@import\ url("style.css"); EOF $Res = $Defang->defang($H); like($Res, qr{^$}, "Test 14"); $H = <\@import_url("style.css"); EOF $Res = $Defang->defang($H); like($Res, qr{^$}, "Test 15"); $H = <\@import "style.css"; EOF $Res = $Defang->defang($H); like($Res, qr{^$}, "Test 16"); $H = < \@import "style.css"; EOF $Res = $Defang->defang($H); like($Res, qr{^$}, "Test 17"); $H = <\@import "style.css" ; EOF $Res = $Defang->defang($H); like($Res, qr{^$}, "Test 18"); $H = <\@import url ("style.css"); EOF $Res = $Defang->defang($H); like($Res, qr{^$}, "Test 19"); $H = <\@import: url("style.css"); EOF $Res = $Defang->defang($H); like($Res, qr{^$}, "Test 20"); $H = <\@ import url("style.css"); EOF $Res = $Defang->defang($H); like($Res, qr{^$}, "Test 21"); $H = <\@import url ("style.css"); EOF $Res = $Defang->defang($H); like($Res, qr{^$}, "Test 22"); $H = <\@import style.css; EOF $Res = $Defang->defang($H); like($Res, qr{^$}, "Test 23"); $H = <_\@import "style.css"; EOF $Res = $Defang->defang($H); like($Res, qr{^$}, "Test 24"); $H = <\@import url("style.css")_; EOF $Res = $Defang->defang($H); like($Res, qr{^$}, "Test 25"); $H = <em{color:red};\@import url("style.css"); EOF $Res = $Defang->defang($H); like($Res, qr{^$}, "Test 26"); $H = <\@import url("style.css"); EOF $Res = $Defang->defang($H); like($Res, qr{^$}, "Test 27"); $H = <\@import url\ ("style.css"); EOF $Res = $Defang->defang($H); like($Res, qr{^$}, "Test 28"); $H = <\@import ur\6C ("style.css"); EOF $Res = $Defang->defang($H); like($Res, qr{^$}, "Test 29"); $H = <\@import(style.css); EOF $Res = $Defang->defang($H); like($Res, qr{^$}, "Test 30"); $H = <\@import url("style.\63 ss"); EOF $Res = $Defang->defang($H); like($Res, qr{^$}, "Test 31"); $H = <\@import url("style. css"); EOF $Res = $Defang->defang($H); like($Res, qr{^$}, "Test 32"); $H = <\@import url("style.\ css"); EOF $Res = $Defang->defang($H); like($Res, qr{^$}, "Test 33"); HTML-Defang-1.07/t/06_unicode.t0000644000000000000000000000421413316605025014452 0ustar rootroot#!/usr/bin/perl -w BEGIN { # CPAN users don't have ME::*, so use eval eval 'use ME::FindLibs' } use utf8; use Test::More tests => 19; use HTML::Defang; use Encode; use Devel::Peek; use strict; my ($Res, $H); my ($DefangString, $CommentStartText, $CommentEndText) = ('defang_', ' ', ' '); ################################# # Check unicodeness is preserved despite internal non-unicode magic ################################# my $Defang = HTML::Defang->new( tags_to_callback => [ qw(a p) ], tags_callback => sub { my ($Context, $Defang, $Angle, $Tag, $IsEndTag, $AttributeHash, $AttributesEnd, $HtmlR, $OutR) = @_; if ($Tag eq 'a' && !$IsEndTag) { ok(Encode::is_utf8(${$AttributeHash->{href}}), "attr is unicode"); is(${$AttributeHash->{href}}, 'http://blah.com/ø', "attr unicode is correct"); ${$AttributeHash->{href}} = 'http://blah.com/ø'; ok(Encode::is_utf8(${$AttributeHash->{href}}), "attr is unicode2"); } elsif ($Tag eq 'p' && !$IsEndTag) { ok(Encode::is_utf8($$HtmlR), "html ref is unicode"); ok($$HtmlR =~ /\G(?=岡)/gc, "html ref unicode is correct"); } return 1; } ); $H = <岡

non-english href EOF ok(Encode::is_utf8($H), "input is unicode"); $Res = $Defang->defang($H); ok(Encode::is_utf8($Res), "output is unicode"); like($Res, qr{^岡}, "defang preserves unicode"); like($Res, qr{^non-english href}m, "defang preserves unicode2"); $H = <岡

non-english href EOF ok(Encode::is_utf8($H), "input2 is unicode"); $Res = $Defang->defang($H); ok(Encode::is_utf8($Res), "output2 is unicode"); like($Res, qr{^岡}, "defang2 preserves unicode"); like($Res, qr{^non-english href}m, "defang2 preserves unicode2"); like($Res, qr(^)m, "style unicode correct"); HTML-Defang-1.07/t/05_callbacks.t0000644000000000000000000015332113316605025014746 0ustar rootroot#!/usr/bin/perl -w BEGIN { # CPAN users don't have ME::*, so use eval eval 'use ME::FindLibs' } use Test::More tests => 94; use HTML::Defang; use strict; my ($Res, $H); my ($DefangString, $CommentStartText, $CommentEndText) = ('defang_', ' ', ' '); ################################# # Basic tag callback tests ################################# my $Defang = HTML::Defang->new( tags_to_callback => [ qw(img font unknown1 unknown2 button hr area) ], tags_callback => sub { my ($Context, $Defang, $Angle, $Tag, $IsEndTag, $AttributeHash, $HtmlR) = @_; my $DefangFlag = 2; $DefangFlag = 0 if $Tag eq "img" || $Tag eq "unknown1" || $Tag eq "button"; $DefangFlag = 1 if $Tag eq "font" || $Tag eq "unknown2" || $Tag eq "hr"; return $DefangFlag; } ); $H = < 2: 3: 4: 5: 6: 7: 8: 9: 14:
15: 16: 17:}, "Force skip known tag with closing tags and attributes"); like($Res, qr{14:}, "Force defang known tag with closing tags and attributes"); like($Res, qr{15:}, "Force skip unknown tag with closing tags and attributes"); like($Res, qr{16:}, "Force defang unknown tag with closing tags and attritues"); like($Res, qr{17: 14:
15: 16: 17: