Dynamic/static check moved from inappropriate &escapeHTML to new: &W_check

&escapeHTML can be now used even from a static code.

diff --git a/Web.pm b/Web.pm
index 3d24a95..599005f 100644 (file)
--- a/Web.pm
+++ b/Web.pm
@@ -36,6 +36,7 @@ our @EXPORT=qw(
                &img &centerimg &rightimg
                $W
                &input_hidden_persistents
+               &escapeHTML
                );
 our @ISA=qw(Tie::Handle Exporter);
 
@@ -134,6 +135,16 @@ my($apache_request)=@_;
        return OK;
 }
 
+sub W_check(;$)
+{
+my($self)=@_;
+
+       # Use &eval to prevent: Global $r object is not available. Set:\n\tPerlOptions +GlobalRequest\nin ...
+       # CGI requires valid "r": check it beforehand here.
+       confess "Calling sensitive dynamic code from a static code" if !eval { Apache2::RequestUtil->request(); };
+       confess "Calling sensitive dynamic code without My::Web::init" if !$W->{"__PACKAGE__"};
+}
+
 sub init ($%)
 {
 my($class,%args)=@_;
@@ -226,7 +237,7 @@ my($class,%args)=@_;
                $W->{"head"}.='<script type="text/javascript" src="'.path_web('/have_js.pm').'"></script>'."\n";
                }
 
-       do { args_check(%$_) if $_; } for ($W->{"args_check"});
+       do { _args_check(%$_) if $_; } for ($W->{"args_check"});
 
        return bless $W,$class;
 }
@@ -250,9 +261,6 @@ sub escapeHTML($)
 {
 my($text)=@_;
 
-       # Use &eval to prevent: Global $r object is not available. Set:\n\tPerlOptions +GlobalRequest\nin ...
-       # CGI requires valid "r": check it beforehand here.
-       confess "Calling dynamic URL generator from a static code" if !eval { Apache2::RequestUtil->request(); };
        # Prevent &CGI::escapeHTML breaking utf-8 strings like: \xC4\x9B eq \x{11B}
        do { cluck "charset==$_" if $_ && $_ ne "utf-8"; } for CGI::charset();
        CGI::charset("utf-8");
@@ -367,7 +375,7 @@ my($in,%args)=@_;
 
 sub fatal (;$);
 
-sub args_check (%)
+sub _args_check (%)
 {
 my(%tmpl)=@_;
 
@@ -526,6 +534,7 @@ sub uri_escaped($)
 my($uri)=@_;
 
        cluck if !ref $uri;
+       W_check();
        my $urient=escapeHTML($uri);
        return $uri    if $uri eq $urient;
        return $urient if uri_is_local $uri;
@@ -540,6 +549,7 @@ sub a_href($;$%)
 {
 my($in,$contents,%args)=@_;
 
+       W_check();
        do { $$_=1 if !defined $$_; } for (\$args{"size"});
        if (!defined $contents) {
                $contents=$in;
@@ -575,6 +585,7 @@ my($self,$sub,@sub_args)=@_;
 
 sub input_hidden_persistents()
 {
+       W_check();
        return join("",map({
                my $key=$_;
                my $val=$W->{"args"}{$key};
@@ -723,6 +734,7 @@ sub img ($$%)
 {
 my($in,$alt,%args)=@_;
 
+       W_check();
        my($path_web,$path_abs_disk)=_img_src($in,%args);
        my($width,$height)=Image::Size::imgsize($path_abs_disk);
        $alt=~s/<[^>]*>//g;