Cleanups of request checks, mod_perl checks and all around: &escapeHTML

[MyWeb.git] / Web.pm

diff --git a/Web.pm b/Web.pm
index dcd40ea..0cf0d3c 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);
 
@@ -96,7 +97,7 @@ BEGIN
 }
 
 use WebConfig; # see also below: Wuse 'WebConfig';
-require CGI;   # for &escapeHTML
+require CGI;
 require Image::Size;   # for &imgsize
 use File::Basename;    # &basename
 use Carp qw(cluck confess);
@@ -134,6 +135,17 @@ my($apache_request)=@_;
        return OK;
 }
 
+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(); };
+       # 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 ($%)
 {
 my($class,%args)=@_;
@@ -155,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.
@@ -226,12 +242,16 @@ 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;
 }
 
 # Although we have &tie-d *STDOUT we try to not to be dependent on it in My::Web itself.
+# Do not: Wprint $W->{"heading"},"undef"=>1;
+# as we would need to undef() it to turn it off and it would get defaulted in such case.
+# Do not: exists $W->{"heading"}
+# as we use a lot of 'for $W->{"heading"}' which instantiates it with the value: undef()
 sub Wprint($%)
 {
 my($text,%args)=@_;
@@ -246,9 +266,17 @@ 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}
+       # 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);
 }
 
@@ -294,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
@@ -360,7 +389,7 @@ my($in,%args)=@_;
 
 sub fatal (;$);
 
-sub args_check (%)
+sub _args_check (%)
 {
 my(%tmpl)=@_;
 
@@ -416,7 +445,7 @@ sub footer (;$)
 
        Wprint vskip if $W->{"footer_delimit"};
 
-       Wprint $W->{"footing_delimit"},"undef"=>1;
+       do { Wprint $_ if $_; } for $W->{"footing_delimit"};
 
        Wprint "<hr />\n" if $W->{"footer"};
 
@@ -467,7 +496,7 @@ sub footer (;$)
                Wprint '<!-- '.$package.' - $'.$cvs_id.'$ -->'."\n" if $cvs_id;
                }
 
-       Wprint $W->{"footing"},"undef"=>1;
+       do { Wprint $_ if $_; } for $W->{"footing"};
 
        Wprint "</body></html>\n";
        exit 0;
@@ -521,6 +550,7 @@ my($uri)=@_;
        cluck if !ref $uri;
        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
@@ -533,6 +563,7 @@ sub a_href($;$%)
 {
 my($in,$contents,%args)=@_;
 
+       request_check();
        do { $$_=1 if !defined $$_; } for (\$args{"size"});
        if (!defined $contents) {
                $contents=$in;
@@ -568,6 +599,7 @@ my($self,$sub,@sub_args)=@_;
 
 sub input_hidden_persistents()
 {
+       request_check();
        return join("",map({
                my $key=$_;
                my $val=$W->{"args"}{$key};
@@ -716,6 +748,7 @@ sub img ($$%)
 {
 my($in,$alt,%args)=@_;
 
+       request_check();
        my($path_web,$path_abs_disk)=_img_src($in,%args);
        my($width,$height)=Image::Size::imgsize($path_abs_disk);
        $alt=~s/<[^>]*>//g;
@@ -865,7 +898,7 @@ HERE
        Wprint $W->{"body_attr"};
        Wprint ">\n";
 
-       Wprint $W->{"heading"},"undef"=>1;
+       do { Wprint $_ if $_; } for $W->{"heading"};
 }
 
 BEGIN {