perl/modules/W3C/LinkChecker/bin checklink,4.155,4.156

Update of /sources/public/perl/modules/W3C/LinkChecker/bin
In directory hutz:/tmp/cvs-serv16231/bin

Modified Files:
	checklink 
Log Message:
Fix asking for basic auth (need to delay writing of HTTP headers), set cookie and print form also in auth required response.

Index: checklink
===================================================================
RCS file: /sources/public/perl/modules/W3C/LinkChecker/bin/checklink,v
retrieving revision 4.155
retrieving revision 4.156
diff -u -d -r4.155 -r4.156
--- checklink	19 Apr 2009 09:58:25 -0000	4.155
+++ checklink	19 Apr 2009 10:35:43 -0000	4.156
@@ -838,19 +838,20 @@
   my ($params, $uri, $check_num, $depth, $cookie, $referer, $is_start) = @_;
   $is_start ||= ($check_num == 1);
 
-  if ($Opts{HTML}) {
-    &html_header($uri, 0, $cookie) if ($check_num == 1);
-    &print_form($params, $cookie, $check_num) if $is_start;
-  }
-
   my $start = $Opts{Summary_Only} ? 0 : &get_timestamp();
 
   # Get and parse the document
-  my $response = &get_document('GET', $uri, $doc_count, \%redirects, $referer);
+  my $response = &get_document('GET', $uri, $doc_count, \%redirects, $referer,
+                               $cookie, $params, $check_num, $is_start);
 
   # Can we check the resource? If not, we exit here...
   return if defined($response->{Stop});
 
+  if ($Opts{HTML}) {
+    &html_header($uri, 0, $cookie) if ($check_num == 1);
+    &print_form($params, $cookie, $check_num) if $is_start;
+  }
+
   if ($is_start) { # Starting point of a new check, eg. from the command line
     # Use the first URI as the recursion base unless specified otherwise.
     push(@{$Opts{Base_Locations}}, $response->{absolute_uri}->canonical())
@@ -1133,15 +1134,18 @@
 # Get and parse a resource to process #
 #######################################
 
-sub get_document ($$$;\%$)
+sub get_document ($$$;\%$$$$$)
 {
-  my ($method, $uri, $in_recursion, $redirects, $referer) = @_;
+  my ($method, $uri, $in_recursion, $redirects, $referer, $cookie, $params,
+      $check_num, $is_start) = @_;
   # $method contains the HTTP method the use (GET or HEAD)
   # $uri contains the identifier of the resource
   # $in_recursion is > 0 if we are in recursion mode (i.e. it is at least
   #                        the second resource checked)
   # $redirects is a pointer to the hash containing the map of the redirects
   # $referer is the URI of the referring document
+  # $cookie, $params, $check_num, and $is_start are for printing HTTP headers
+  #                  and the form if $in_recursion == 0 and not authenticating
 
   # Get the resource
   my $response;
@@ -1157,10 +1161,14 @@
     if (! $in_recursion) {
       # Is it too late to request authentication?
       if ($response->code() == 401) {
-        &authentication($response);
+        &authentication($response, $cookie, $params, $check_num, $is_start);
       } else {
+        if ($Opts{HTML}) {
+          &html_header($uri, 0, $cookie) if ($check_num == 1);
+          &print_form($params, $cookie, $check_num) if $is_start;
+          print "<p>";
+        }
         # TODO: style this message to make it stand out
-        print "<p>" if $Opts{HTML};
         &hprintf("\nError: %d %s\n",
                  $response->code(), $response->message() || '(no message)');
         print "</p>\n" if $Opts{HTML};
@@ -1200,8 +1208,12 @@
   if ($failed_reason) {
     # No, there is a problem...
     if (! $in_recursion) {
+      if ($Opts{HTML}) {
+        &html_header($uri, 0, $cookie) if ($check_num == 1);
+        &print_form($params, $cookie, $check_num) if $is_start;
+        print "<p>";
+      }
       # TODO: style this message to make it stand out
-      print "<p>" if $Opts{HTML};
       &hprintf("Can't check links: %s.\n", $failed_reason);
       print "</p>\n" if $Opts{HTML};
     }
@@ -1776,9 +1788,9 @@
 # Ask for authentication #
 ##########################
 
-sub authentication ($)
+sub authentication ($;$$$$)
 {
-  my ($response) = @_;
+  my ($response, $cookie, $params, $check_num, $is_start) = @_;
 
   my $realm = '';
   if ($response->www_authenticate() =~ /Basic realm=\"([^\"]+)\"/) {
@@ -1795,7 +1807,10 @@
 EOF
   } else {
 
-    printf("Status: 401 Authorization Required\nWWW-Authenticate: %s\nConnection: close\nContent-Language: en\nContent-Type: text/html; charset=utf-8\n\n", $response->www_authenticate());
+    printf("Status: 401 Authorization Required\nWWW-Authenticate: %s\n%sConnection: close\nContent-Language: en\nContent-Type: text/html; charset=utf-8\n\n",
+           $response->www_authenticate(),
+           $cookie ? "Set-Cookie: $cookie\n" : "",
+          );
 
     printf("%s
 <html lang=\"en\" xmlns=\"http://www.w3.org/1999/xhtml\" xml:lang=\"en\">
@@ -1804,6 +1819,7 @@
 %s</head>
 <body>", $DocType, $Head);
     &banner(': 401 Authorization Required');
+    &print_form($params, $cookie, $check_num) if $is_start;
     printf("<p>
   You need \"%s\" access to <a href=\"%s\">%s</a> to perform link checking.<br />
 ", &encode($realm), (&encode($response->request()->url())) x 2);

Received on Sunday, 19 April 2009 10:35:55 UTC