Cleanups of request checks, mod_perl checks and all around: &escapeHTML
authorshort <>
Sat, 10 Sep 2005 08:26:54 +0000 (08:26 +0000)
committershort <>
Sat, 10 Sep 2005 08:26:54 +0000 (08:26 +0000)
Web.pm

diff --git a/Web.pm b/Web.pm
index 599005f..0cf0d3c 100644 (file)
--- a/Web.pm
+++ b/Web.pm
@@ -135,14 +135,15 @@ my($apache_request)=@_;
        return OK;
 }
 
-sub W_check(;$)
+sub request_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__"};
+       # Do not: confess "Calling sensitive dynamic code without My::Web::init" if !$W->{"__PACKAGE__"};
+       # as it is valid at least while preparing arguments to call: &project::Lib::init
 }
 
 sub init ($%)
@@ -166,6 +167,10 @@ my($class,%args)=@_;
        # $Apache2::Registry::curstash is no longer supported.
        do { cluck "No $_" if !$W->{$_}; } for "__PACKAGE__";
 
+       # See: &escapeHTML
+       do { cluck "charset==$_, expecting ISO-8859-1" if $_ ne "ISO-8859-1"; } for CGI::charset();
+       CGI::charset("utf-8");
+
        do { $W->{$_}=0  if !defined $W->{$_}; } for ("detect_ent");
        do { $W->{$_}=0  if !defined $W->{$_}; } for ("detect_js");
        do { $W->{$_}=1  if !defined $W->{$_}; } for ("have_css");      # AFAIK it does not hurt anyone.
@@ -262,8 +267,16 @@ sub escapeHTML($)
 my($text)=@_;
 
        # Prevent &CGI::escapeHTML breaking utf-8 strings like: \xC4\x9B eq \x{11B}
-       do { cluck "charset==$_" if $_ && $_ ne "utf-8"; } for CGI::charset();
+       # Prevent case if we run under mod_perl but still just initializing:
+       request_check() if $ENV{"MOD_PERL"};
+       # Generally we are initialized from &init but we may be used without it without mod_perl
+       # and in such case check the change on all non-first invocations.
+       our $init;
+       if (!$ENV{"MOD_PERL"} && $init++) {
+               do { cluck "charset==$_" if $_ ne "utf-8"; } for CGI::charset();
+               }
        CGI::charset("utf-8");
+
        return CGI::escapeHTML($text);
 }
 
@@ -309,6 +322,7 @@ sub dir_top_abs_disk()
 
 sub unparsed_uri()
 {
+       request_check();
        if (!$W->{"unparsed_uri"}) {
                # Do not: $W->{"r"}
                # as we may be called before &init from: &My::Project::init
@@ -534,9 +548,9 @@ sub uri_escaped($)
 my($uri)=@_;
 
        cluck if !ref $uri;
-       W_check();
        my $urient=escapeHTML($uri);
        return $uri    if $uri eq $urient;
+       request_check();
        return $urient if uri_is_local $uri;
        return $uri    if defined $W->{"have_ent"} && !$W->{"have_ent"};        # non-ent client
        return $urient if $W->{"have_ent"};     # ent client
@@ -549,7 +563,7 @@ sub a_href($;$%)
 {
 my($in,$contents,%args)=@_;
 
-       W_check();
+       request_check();
        do { $$_=1 if !defined $$_; } for (\$args{"size"});
        if (!defined $contents) {
                $contents=$in;
@@ -585,7 +599,7 @@ my($self,$sub,@sub_args)=@_;
 
 sub input_hidden_persistents()
 {
-       W_check();
+       request_check();
        return join("",map({
                my $key=$_;
                my $val=$W->{"args"}{$key};
@@ -734,7 +748,7 @@ sub img ($$%)
 {
 my($in,$alt,%args)=@_;
 
-       W_check();
+       request_check();
        my($path_web,$path_abs_disk)=_img_src($in,%args);
        my($width,$height)=Image::Size::imgsize($path_abs_disk);
        $alt=~s/<[^>]*>//g;