diff options
Diffstat (limited to 'httpd/cgi-bin/check')
| -rwxr-xr-x | httpd/cgi-bin/check | 18 |
1 files changed, 13 insertions, 5 deletions
diff --git a/httpd/cgi-bin/check b/httpd/cgi-bin/check index a33072e..f048268 100755 --- a/httpd/cgi-bin/check +++ b/httpd/cgi-bin/check @@ -62,6 +62,7 @@ use SGML::Parser::OpenSP 0.991 qw(); use URI qw(); use URI::Escape qw(uri_escape); use URI::file; +use URI::Heuristic qw(); ############################################################################### #### Constant definitions. #################################################### @@ -1742,10 +1743,21 @@ sub handle_uri my $q = shift; # The CGI object. my $File = shift; # The master datastructure. + my $ua = W3C::Validator::UserAgent->new($CFG, $File); + my $uri = URI->new(ref $q ? $q->param('uri') : $q)->canonical(); $uri->fragment(undef); - my $ua = W3C::Validator::UserAgent->new($CFG, $File); + if (!$uri->scheme()) { + local $ENV{URL_GUESS_PATTERN} = ''; + my $guess = URI::Heuristic::uf_uri($uri); + if ($guess->scheme() && $ua->is_protocol_supported($guess)) { + $uri = $guess; + } + else { + $uri = URI->new("http://$uri"); + } + } unless ($ua->is_protocol_supported($uri)) { $File->{'Error Flagged'} = TRUE; @@ -2812,10 +2824,6 @@ sub prepCGI $q->param('uri', $q->param('url')); } - # Munge the URL to include commonly omitted prefix. - my $u = $q->param('uri'); - $q->param('uri', "http://$u") if $u && $u =~ m(^www)i; - # Set output mode; needed in get_error_template if we end up there. $File->{Opt}->{Output} = $q->param('output') || 'html'; |