Workarounded MIME::Base64 for 'Content-MD5' header.

[MyWeb.git] / Web.pm

diff --git a/Web.pm b/Web.pm
index 33cd6d9..07db01c 100644 (file)
--- a/Web.pm
+++ b/Web.pm
@@ -122,6 +122,7 @@ use Data::Dumper;
 require Encode;
 use Apache2::Filter;
 use Apache2::Connection;
+require MIME::Base64;
 
 
 #our $W;
@@ -241,13 +242,15 @@ my($class,%args)=@_;
                                "_remote_ip"=>sub { return $W->{"r"}->connection()->remote_ip(); },
                                }),
                        );
+       Wrequire 'My::Hash::Readonly';
        $W->{"headers_in"}=My::Hash::Readonly->new($W->{"headers_in"});
        
        if ($W->{"r"}->method() eq "GET" || $W->{"r"}->method() eq "HEAD") {
                for (\$W->{"http_safe"}) {
-                       # Extend the current ETag system instead if you would need it:
-                       cluck "Explicitely NOT HTTP-Safe for method \"".$W->{"r"}->method()."\"?!?"
-                                       if defined($$_) && !$$_;
+                       # Do not: # Extend the current ETag system instead if you would need it:
+                       #         cluck "Explicitely NOT HTTP-Safe for method \"".$W->{"r"}->method()."\"?!?"
+                       #                       if defined($$_) && !$$_;
+                       # as sometimes it just does not make sense to cache it.
                        $$_=1 if !defined $$_;
                        }
                }
@@ -272,7 +275,7 @@ my($class,%args)=@_;
 
        $W->{"have_js"}=($W->{"args"}{"have_js"} ? 1 : 0);
        if ($W->{"detect_js"} && !$W->{"have_js"}) {
-               $W->{"head"}.='<script type="text/javascript" src="'.uri_escaped(path_web('/have_js.pm')).'"></script>'."\n";
+               $W->{"head"}.='<script type="text/javascript" src="'.uri_escaped(path_web('/My/HaveJS.pm')).'"></script>'."\n";
                }
 
        do { _args_check(%$_) if $_; } for ($W->{"args_check"});
@@ -293,7 +296,8 @@ my($text,%args)=@_;
        delete $args{"undef"};
        cluck join(" ","Invalid arguments:",keys(%args)) if keys(%args);
        return if !defined $text;
-       cluck "utf-8 untested" if Encode::is_utf8($text);
+       # Do not: cluck "utf-8 untested" if Encode::is_utf8($text);
+       # as it is valid here.
        $W->{"r"}->puts($text);
 }
 
@@ -315,24 +319,6 @@ my($text)=@_;
        return CGI::escapeHTML($text);
 }
 
-# local *FH;
-# tie *FH,ref($W),$W;
-sub TIEHANDLE($)
-{
-my($class,$W)=@_;
-
-       my $self={};
-       $self->{"W"}=$W or confess "Missing W";
-       return bless $self,$class;
-}
-
-sub WRITE
-{
-my($self,$scalar,$length,$offset)=@_;
-
-       Wprint substr($scalar,0,$length);
-}
-
 # /home/user/www/webdir
 sub dir_top_abs_disk()
 {
@@ -596,7 +582,7 @@ my($uri)=@_;
        return $uri    if defined $W->{"have_ent"} && !$W->{"have_ent"};        # non-ent client
        return $urient if $W->{"have_ent"};     # ent client
        # Unknown client, &escapeHTML should not be needed here:
-       return escapeHTML(path_web('/Redirect.pm?location='.uri_escape($uri->abs(unparsed_uri()))));
+       return escapeHTML(path_web('/My/Redirect.pm?location='.uri_escape($uri->abs(unparsed_uri()))));
 }
 
 our $a_href_inhibited;
@@ -688,12 +674,14 @@ sub a_href_cc($$;%)
 {
 my($url,$contents,%args)=@_;
 
+       # A bit ineffective but we must process all the possibilities to get stable 'headers_in' hits!
+       my %map=map(($_=>a_href($url->{$_},$contents,%args)),keys(%$url));
        my $cc;
        $cc||=Geo::IP->new()->country_code_by_addr(remote_ip()) if $have_Geo_IP;
        $cc||="";
-       $url=$url->{$cc};
-       return $contents if !$url;
-       return a_href $url,$contents,%args;
+       my $r=$map{$cc};
+       return $r if $r;
+       return $contents;
 }
 
 sub make ($)
@@ -1002,7 +990,12 @@ sub cache_finish()
 
        # Prepare 'headers_out' for the future reusal:
        my %headers_out;
-       $headers_out{"Content-MD5"}=$W->{"digest-md5"}->b64digest();
+       # Do not: $W->{"digest-md5"}->b64digest();
+       # as it will not provide the trailing filling '='s.
+       # RFC 1864 is not clear but the same provides them.
+       # FIXME: Should we somehow provide "\r\n" newlines for the text data? Which content is "text"?
+       # ',""' to avoid breaking the headers by its default "\n".
+       $headers_out{"Content-MD5"}=MIME::Base64::encode_base64($W->{"digest-md5"}->digest(),"");
        # In fact we could also use MD5 for ETag as if we know ETag we also know MD5.
        # But this way we do not need to calculate MD5 and we still can provide such ETag. So.
        # $W->{"r"}->set_etag() ?