[LON-CAPA-cvs] cvs: loncom /lonnet/perl lonnet.pm

[albertel]

albertel		Thu Sep 28 17:24:56 2006 EDT

  Modified files:              
    /loncom/lonnet/perl	lonnet.pm 
  Log:
  - need to wait for lock on session env as there could be contention
  - only do the conversion if it looks like its a text session env
  
  
Index: loncom/lonnet/perl/lonnet.pm
diff -u loncom/lonnet/perl/lonnet.pm:1.785 loncom/lonnet/perl/lonnet.pm:1.786
--- loncom/lonnet/perl/lonnet.pm:1.785	Thu Sep 28 16:03:55 2006
+++ loncom/lonnet/perl/lonnet.pm	Thu Sep 28 17:24:56 2006
@@ -1,7 +1,7 @@
 # The LearningOnline Network
 # TCP networking package
 #
-# $Id: lonnet.pm,v 1.785 2006/09/28 20:03:55 albertel Exp $
+# $Id: lonnet.pm,v 1.786 2006/09/28 21:24:56 albertel Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -303,6 +303,9 @@
     }
     my %temp_env;
     foreach my $line (@profile) {
+	if ($line !~ m/=/) {
+	    return 0;
+	}
 	chomp($line);
 	my ($envname,$envvalue)=split(/=/,$line,2);
 	$temp_env{&unescape($envname)} = &unescape($envvalue);
@@ -314,6 +317,7 @@
 	@env{keys(%temp_env)} = @disk_env{keys(%temp_env)};
 	untie(%disk_env);
     }
+    return 1;
 }
 
 # ------------------------------------------- Transfer profile into environment
@@ -329,15 +333,25 @@
         ($handle) = ($env{'user.environment'} =~m|/([^/]+)\.id$| );
     }
 
-    my %remove;
-    if (tie(my %disk_env,'GDBM_File',"$lonidsdir/$handle.id",&GDBM_READER(),
-	    0640)) {
-	@env{keys(%disk_env)} = @disk_env{keys(%disk_env)};
-	untie(%disk_env);
-    } else {
-	&convert_and_load_session_env($lonidsdir,$handle);
+    my $convert;
+    {
+    	open(my $idf,"$lonidsdir/$handle.id");
+	flock($idf,LOCK_SH);
+	if (tie(my %disk_env,'GDBM_File',"$lonidsdir/$handle.id",
+		&GDBM_READER(),0640)) {
+	    @env{keys(%disk_env)} = @disk_env{keys(%disk_env)};
+	    untie(%disk_env);
+	} else {
+	    $convert = 1;
+	}
+    }
+    if ($convert) {
+	if (!&convert_and_load_session_env($lonidsdir,$handle)) {
+	    &logthis("Failed to load session, or convert session.");
+	}
     }
 
+    my %remove;
     while ( my $envname = each(%env) ) {
         if (my ($key,$time) = ($envname =~ /^(cgi\.(\d+)_\d+\.)/)) {
             if ($time < time-300) {