[LON-CAPA-cvs] cvs: modules /raeburn monitor.pl

[raeburn]

raeburn		Thu Dec 27 11:49:36 2007 EDT

  Modified files:              
    /modules/raeburn	monitor.pl 
  Log:
  - Log HTTP status code when conlost failure occurs.
  - Page parser handles &amp; now used in <meta> Refresh for switch server.
  
  
Index: modules/raeburn/monitor.pl
diff -u modules/raeburn/monitor.pl:1.7 modules/raeburn/monitor.pl:1.8
--- modules/raeburn/monitor.pl:1.7	Tue Aug 28 14:43:06 2007
+++ modules/raeburn/monitor.pl	Thu Dec 27 11:49:34 2007
@@ -1,6 +1,6 @@
 #! /usr/bin/perl
 #
-# $Id: monitor.pl,v 1.7 2007/08/28 18:43:06 raeburn Exp $
+# $Id: monitor.pl,v 1.8 2007/12/27 16:49:34 raeburn Exp $
 #
 use strict;
 use lib qw(/usr/lib/perl5/site_perl/);
@@ -14,7 +14,7 @@
 # monitor.pl
 #
 # Stuart Raeburn, March 28, 2005
-# updated January 28, 2007; August 28, 2007
+# updated January 28, 2007; August 28, 2007; December 27,2007
 #
 #########################################################
 # 
@@ -295,7 +295,7 @@
 
 my $logfile = $monitordir.'/'.$serveralias.'/log'; 
 
-($outcome,$loadbalserver) = &attempt_access($outcome,$server,$loginpage,$lonid,$role,\@formitems,\%formvalues,\%loadtimes,$monitordir,$path_to_java,$loncookie_file,$loadbalance,$sso,\%ssoparam,\%ssourl);
+($outcome,$loadbalserver) = &attempt_access($outcome,$server,$loginpage,$lonid,$role,\@formitems,\%formvalues,\%loadtimes,$monitordir,$path_to_java,$loncookie_file,$loadbalance,$sso,\%ssoparam,\%ssourl,$logfile);
 my %needmail = &alertstatus($outcome,$server,$serveralias,\@failures,$logfile,$monitordir,\%recipients,\%cleared);
 if (keys(%needmail) > 0) {
     my $mailresult = &mailalert($server,$outcome,$contact_email,\%needmail,'fail');
@@ -329,8 +329,8 @@
 sub attempt_access {
     my ($outcome,$server,$loginpage,$lonid,$role,$formitems,$formvalues,
         $loadtimes,$monitordir,$path_to_java,$loncookie_file,$loadbalance,
-        $sso,$ssoparamref,$ssourlref) = @_;
-    ($outcome,$loginpage) = &get_loginpage($server,$ua,$loncookie_file,$sso);
+        $sso,$ssoparamref,$ssourlref,$logfile) = @_;
+    ($outcome,$loginpage) = &get_loginpage($server,$ua,$loncookie_file,$sso,$logfile);
     my $loadbalserver;
     if ($outcome eq 'ok') {
         $ua->timeout(30);
@@ -369,7 +369,7 @@
 }
 
 sub get_loginpage {
-    my ($server,$ua,$loncookie_file,$sso) = @_;
+    my ($server,$ua,$loncookie_file,$sso,$logfile) = @_;
     my ($outcome,$loginpage);
     my $URL = 'http://'.$server.'/';
     if ($sso) {
@@ -388,6 +388,9 @@
         $loncookie_file->extract_cookies($res);
     } else {
         $outcome = 'conlost';
+        open (my $logfh,">>$logfile");
+        print $logfh localtime(time)." - conlost, status_line: ".$res->status_line."\n";
+        close($logfh);
     }
     return ($outcome,$loginpage);
 }
@@ -568,8 +571,8 @@
     if ($response->is_success) {
         if ($loadbalance) {
             (my $switchurl,$$serverref) = &parse_switchpage($response->content,
-                                                            $uname,$udom); 
-            if ($switchurl) {  
+                                                            $uname,$udom);
+            if ($switchurl) {
                 ($outcome,$lonid) = 
                     &switchserver($switchurl,$ua,$loadtimes,$loncookie_file);
             } else {
@@ -596,8 +599,12 @@
 
 sub parse_switchpage {
     my ($content,$uname,$udom) = @_;
-    if ($content =~ m{<meta\sHTTP\-EQUIV="Refresh"\sCONTENT="0\.5;\surl=(http://)([^/]+)(/adm/login\?domain=\Q$udom\E&username=\Q$uname\E&token=\w+)">}s ) {
-         return ($1.$2.$3, $2);
+    if ($content =~ m{<meta\shttp\-equiv="Refresh"\scontent="0\.5;\surl=(http://)([^/]+)(/adm/login\?domain=\Q$udom\E&amp;username=\Q$uname\E&amp;token=\w+)" />}s ) {
+         my $protocol = $1;
+         my $server= $2;
+         my $path = $3;
+         $path =~ s/\&amp;/\&/g;
+         return ($protocol.$server.$path, $server);
     }
     return;
 }