Index: openacs-4/packages/acs-tcl/tcl/text-html-procs.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/acs-tcl/tcl/text-html-procs.tcl,v diff -u -r1.109.2.25 -r1.109.2.26 --- openacs-4/packages/acs-tcl/tcl/text-html-procs.tcl 25 Jan 2022 23:12:04 -0000 1.109.2.25 +++ openacs-4/packages/acs-tcl/tcl/text-html-procs.tcl 2 Mar 2022 17:01:22 -0000 1.109.2.26 @@ -856,15 +856,30 @@ - ad_proc ad_html_security_check { html } { + ad_proc ad_html_security_check { + -allowed_tags + -allowed_attributes + -allowed_protocols + html + } { Returns a human-readable explanation if the user has used any - HTML tag other than the ones marked allowed in antispam - section of the kernel parameters. Otherwise returns an empty - string. + HTML tag other than the allowed ones. - @return a human-readable, plaintext explanation of what's wrong with the user's input. + It uses for checking the provided values. If these values are + not provided the function takes the union of the per-package + instance value and the values from the "antispam" section of + the kernel parameters. + @param allowed_tags + @param allowed_attributes + @param allowed_protocols + @param html The HTML text being validated. + + @return a human-readable, plaintext explanation of what's + wrong with the user's input. If everthing is ok, + return an empty string. + @author Lars Pind (lars@pinds.com) @creation-date 20 July 2000 @@ -880,33 +895,37 @@ return "For security reasons, you're not allowed to have the less-than-percent combination in your input." } - array set allowed_attribute [list] - array set allowed_tag [list] - array set allowed_protocol [list] + if {[info exists allowed_tags]} { + lappend allowed_tags {*}$extra_tags + } else { + set allowed_tags [concat \ + $extra_tags \ + [ad_parameter_all_values_as_list \ + -package_id $::acs::kernel_id \ + AllowedTag antispam] \ + [ad_parameter_all_values_as_list AllowedTag antispam]] + } - # Use the antispam tags for this package instance and whatever is on the kernel. - set allowed_tags_list [concat \ - $extra_tags \ - [ad_parameter_all_values_as_list -package_id $::acs::kernel_id AllowedTag antispam] \ - [ad_parameter_all_values_as_list AllowedTag antispam]] + if {![info exists allowed_attributes]} { + set allowed_attributes [concat \ + [ad_parameter_all_values_as_list \ + -package_id $::acs::kernel_id \ + AllowedAttribute antispam] \ + [ad_parameter_all_values_as_list AllowedAttribute antispam]] + } - set allowed_attributes_list [concat \ - [ad_parameter_all_values_as_list -package_id $::acs::kernel_id AllowedAttribute antispam] \ - [ad_parameter_all_values_as_list AllowedAttribute antispam]] + if {![info exists allowed_protocols]} { + set allowed_protocols [concat \ + [ad_parameter_all_values_as_list \ + -package_id $::acs::kernel_id \ + AllowedProtocol antispam] \ + [ad_parameter_all_values_as_list AllowedProtocol antispam]] + } - set allowed_protocols_list [concat \ - [ad_parameter_all_values_as_list -package_id $::acs::kernel_id AllowedProtocol antispam] \ - [ad_parameter_all_values_as_list AllowedProtocol antispam]] - - foreach attribute $allowed_attributes_list { - set allowed_attribute([string tolower $attribute]) 1 + foreach var {attributes tags protocols} { + set allowed_$var [string tolower [set allowed_$var]] + set allow_all_$var [expr {"*" in [set allowed_$var]}] } - foreach tagname $allowed_tags_list { - set allowed_tag([string tolower $tagname]) 1 - } - foreach protocol $allowed_protocols_list { - set allowed_protocol([string tolower $protocol]) 1 - } # loop over all tags for { set i [string first < $html] } { $i != -1 } { set i [string first < $html $i] } { @@ -918,45 +937,57 @@ # Not considered a tag. Shouldn't do any harm in browsers. # (Tested with digits, with A syntax, with whitespace) } else { - # The tag was valid ... now let's see if it's on the allowed list. + # + # The tag is potentially ok ... now let's see if it's + # on the allowed list. + # set tagname [string tolower [string range $html [lindex $name_idx 0] [lindex $name_idx 1]]] - if { ![info exists allowed_tag($tagname)] && ![info exists allowed_tag(*)] } { - # Nope, this was a naughty tag. - return "For security reasons we only accept the submission of HTML - containing the following tags: [join $allowed_tags_list " "]. - You have a [string toupper $tagname] tag in there." + if { !$allow_all_tags && $tagname ni $allowed_tags } { + # + # This tag is not allowed. + # + return [subst {For security reasons we only accept the submission of HTML + containing the following tags: [join $allowed_tags " "]. + You have a '[string toupper $tagname]' tag in there. + }] } else { - # Legal tag. - - # Make i point to the first character inside the tag, after the tag name and any whitespace + # + # Valid and allowed tag. Make i point to the first + # character inside the tag, after the tag name and + # any whitespace. + # set i [expr { [lindex $match 1] + 1}] set attr_list [ad_parse_html_attributes_upvar html i] foreach attribute $attr_list { + # + # All attribute names in $attr_list are + # already lower case. + # lassign $attribute attr_name attr_value - if { ![info exists allowed_attribute($attr_name)] - && ![info exists allowed_attribute(*)] } { + if { !$allow_all_attributes + && $attr_name ni $allowed_attributes} { return "The attribute '$attr_name' is not allowed for $tagname tags" } - if { [string tolower $attr_name] ne "style" } { + if { !$allow_all_protocols && $attr_name ne "style" } { if { [regexp {^\s*(([^\s:]+):\/\/|(data|javascript|blob):)} $attr_value match . p1 p2] } { - set protocol [expr {$p1 ne "" ? $p1 : $p2}] - if { ![info exists allowed_protocol([string tolower $protocol])] - && ![info exists allowed_protocol(*)] } { - return "Your URLs can only use these protocols: [join $allowed_protocols_list ", "]. - You have a '$protocol' protocol in there." + set protocol [string tolower [expr {$p1 ne "" ? $p1 : $p2}]] + if { $protocol ni $allowed_protocols } { + return [subst {The allowed URLs can only use these protocols: + [join $allowed_protocols ", "]. + You have a '$protocol' protocol in there.}] } } } } } } } - return {} + return "" } # This was created in order to pre-process some content to be fed