Workaround Mozilla corrupting saved pages - send proper XML/HTML MIME.

Fixed PNG/GIF negotiations for the "apache2" branch.

diff --git a/Web.pm b/Web.pm
index 6b42e82..2d8b988 100644 (file)
--- a/Web.pm
+++ b/Web.pm
@@ -560,9 +560,28 @@ my(%args)=@_;
        return [ map(($args{$_}),@fields) ];
 }
 
+# Input: $self is required!
+# Input: Put the fallback variant as the first one.
+# Returns: always only scalar!
+sub Negotiate_choose($$)
+{
+my($self,$variants)=@_;
+
+       my $best=HTTP::Negotiate::choose($variants,
+                       # Do not: $W->{"r"}
+                       # to prevent: Can't locate object method "scan" via package "Apache::RequestRec" at HTTP/Negotiate.pm line 84.
+                       # Do not: $W->{"r"}->headers_in()
+                       # to prevent: Can't locate object method "scan" via package "APR::Table" at HTTP/Negotiate.pm line 84.
+                       # Do not: HTTP::Headers->new($W->{"r"}->headers_in());
+                       # to prevent empty result or even: Odd number of elements in anonymous hash
+                       HTTP::Headers->new(%{$W->{"r"}->headers_in()}));
+       $best||=$variants->[0]{"id"};   # &HTTP::Negotiate::choose failed?
+       return $best;
+}
+
 my @img_variants=(
-               { "id"=>"png","qs"=>1.0,"content-type"=>"image/png" },
-               { "id"=>"gif","qs"=>0.9,"content-type"=>"image/gif" },
+               { "id"=>"png","qs"=>0.9,"content-type"=>"image/png" },
+               { "id"=>"gif","qs"=>0.7,"content-type"=>"image/gif" },
                );
 my $img_variants_re='[.](?:'.join('|',"jpeg",map(($_->{"id"}),@img_variants)).')$';
 
@@ -603,10 +622,7 @@ my($file_base)=@_;
                                "size"=>(stat $file)[7],
                                );
                }
-       # Do not: ,$W->{"r"});
-       # but should we provide somehow either 'HTTP::Headers' or 'HTTP::Request' ?
-       my $ext=HTTP::Negotiate::choose(\@nego_variants);
-       $ext||=$img_variants[0]->{"id"};        # &HTTP::Negotiate::choose failed?
+       my $ext=__PACKAGE__->Negotiate_choose(\@nego_variants);
 
        return $file_base_uri.".".$ext if !wantarray();
        return ($file_base_uri.".".$ext,$file_base_disk.".".$ext);
@@ -708,22 +724,42 @@ my($class)=@_;
        while (my($key,$val)=each(%{$W->{"headers"}})) {
                $W->{"r"}->header_out($key,$val);
                }
-       if (!$W->{"header_only"}) {
-               $W->{"r"}->send_http_header("text/html; charset=$client_charset");      # "Content-type"; do not use header()
-               }
-
        exit if $W->{"r"}->header_only();
        return if $W->{"header_only"};
        # We still can append headers before we put out some text.
        # FIXME: It is not clean to still append them without overwriting.
        return if $W->{"heading_done"}++;
 
+       my $lang=($W->{"language"}||"en-US");
+       # Workaround bug
+       #   https://bugzilla.mozilla.org/show_bug.cgi?id=120556
+       # of at least
+       #   Mozilla/5.0 (X11; U; Linux i686; en-US; rv:1.8b) Gecko/20050217
+       my $mime=$class->Negotiate_choose([
+                       # Put the fallback variant as the first one.
+                       negotiate_variant(
+                                       "id"=>"text/html",
+                                       "content-type"=>"text/html",
+                                       "qs"=>0.5,
+                                       "charset"=>$client_charset,
+                                       "lang"=>$lang,
+                                       ),
+                       negotiate_variant(
+                                       "id"=>"application/xhtml+xml",
+                                       "content-type"=>"application/xhtml+xml",
+                                       "qs"=>0.9,
+                                       "charset"=>$client_charset,
+                                       "lang"=>$lang,
+                                       ),
+                       # application/xml ?
+                       # text/xml ?
+                       ]);
+       $W->{"r"}->send_http_header("$mime; charset=$client_charset");  # "Content-type"; do not use header()
        if (1) { # || !$msie_major || $msie_major>=4) # TODO:dyn
                Wprint '<?xml version="1.0" encoding="'.$client_charset.'"?>'."\n";
                }
        Wprint '<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.1//EN" "http://www.w3.org/TR/xhtml11/DTD/xhtml11.dtd">'."\n";
-       Wprint '<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="'
-                       .($W->{"language"}||"en-US").'">'."\n";
+       Wprint '<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="'.$lang.'">'."\n";
        my $title=$W->{"title_prefix"}.join("",map({ ': '.$_; } ($W->{"title"} || ())));
        $title=~s#<[^>]*>##g;
        Wprint "<head>";