--- loncom/lonnet/perl/lonnet.pm	2001/01/05 20:06:07	1.86
+++ loncom/lonnet/perl/lonnet.pm	2001/01/11 11:11:27	1.97
@@ -82,6 +82,10 @@
 # 10/30,10/31,
 # 11/2,11/14,11/15,11/16,11/20,11/21,11/22,11/25,11/27,
 # 12/02,12/12,12/13,12/14,12/28,12/29 Gerd Kortemeyer
+# 05/01/01 Guy Albertelli
+# 05/01,06/01,09/01 Gerd Kortemeyer
+# 09/01 Guy Albertelli
+# 09/01,10/01,11/01 Gerd Kortemeyer
 
 package Apache::lonnet;
 
@@ -95,6 +99,7 @@ use IO::Socket;
 use GDBM_File;
 use Apache::Constants qw(:common :http);
 use HTML::TokeParser;
+use Fcntl qw(:flock);
 
 # --------------------------------------------------------------------- Logging
 
@@ -177,6 +182,11 @@ sub reconlonc {
 
 sub critical {
     my ($cmd,$server)=@_;
+    unless ($hostname{$server}) {
+        &logthis("<font color=blue>WARNING:".
+               " Critical message to unknown server ($server)</font>");
+        return 'no_such_host';
+    }
     my $answer=reply($cmd,$server);
     if ($answer eq 'con_lost') {
         my $pingreply=reply('ping',$server);
@@ -235,13 +245,26 @@ sub appenv {
             $ENV{$_}=$newenv{$_};
         }
     } keys %newenv;
+
+    my $lockfh;
+    unless ($lockfh=Apache::File->new("$ENV{'user.environment'}")) {
+       return 'error: '.$!;
+    }
+    unless (flock($lockfh,LOCK_EX)) {
+         &logthis("<font color=blue>WARNING: ".
+                  'Could not obtain exclusive lock in appenv: '.$!);
+         $lockfh->close();
+         return 'error: '.$!;
+    }
+
     my @oldenv;
     {
      my $fh;
      unless ($fh=Apache::File->new("$ENV{'user.environment'}")) {
-	return 'error';
+	return 'error: '.$!;
      }
      @oldenv=<$fh>;
+     $fh->close();
     }
     for (my $i=0; $i<=$#oldenv; $i++) {
         chomp($oldenv[$i]);
@@ -258,12 +281,13 @@ sub appenv {
 	return 'error';
      }
      my $newname;
-     flock($fh,'LOCK_EX');
      foreach $newname (keys %newenv) {
 	 print $fh "$newname=$newenv{$newname}\n";
      }
      $fh->close();
     }
+
+    $lockfh->close();
     return 'ok';
 }
 # ----------------------------------------------------- Delete from Environment
@@ -282,16 +306,30 @@ sub delenv {
      unless ($fh=Apache::File->new("$ENV{'user.environment'}")) {
 	return 'error';
      }
+     unless (flock($fh,LOCK_SH)) {
+         &logthis("<font color=blue>WARNING: ".
+                  'Could not obtain shared lock in delenv: '.$!);
+         $fh->close();
+         return 'error: '.$!;
+     }
      @oldenv=<$fh>;
+     $fh->close();
     }
     {
      my $fh;
      unless ($fh=Apache::File->new(">$ENV{'user.environment'}")) {
 	return 'error';
      }
+     unless (flock($fh,LOCK_EX)) {
+         &logthis("<font color=blue>WARNING: ".
+                  'Could not obtain exclusive lock in delenv: '.$!);
+         $fh->close();
+         return 'error: '.$!;
+     }
      map {
 	 unless ($_=~/^$delthis/) { print $fh $_; }
      } @oldenv;
+     $fh->close();
     }
     return 'ok';
 }
@@ -655,8 +693,7 @@ sub coursedescription {
     if ($chome ne 'no_host') {
        my $rep=reply("dump:$cdomain:$cnum:environment",$chome);
        if ($rep ne 'con_lost') {
-           my $normalid=$courseid;
-           $normalid=~s/\//\_/g;
+           my $normalid=$cdomain.'_'.$cnum;
            my %envhash=();
            my %returnhash=('home'   => $chome, 
                            'domain' => $cdomain,
@@ -1005,6 +1042,7 @@ sub allowed {
            if ($envkey=~/^user\.role\.(st|ta)\.([^\.]*)/) {
                my $courseid=$2;
                my $roleid=$1.'.'.$2;
+               $courseid=~s/^\///;
                my $expiretime=600;
                if ($ENV{'request.role'} eq $roleid) {
 		  $expiretime=120;
@@ -1578,11 +1616,11 @@ sub EXT {
        my $courselevelm=
             $ENV{'request.course.id'}.'.'.$mapparm;
 
-
 # ----------------------------------------------------------- first, check user
       my %resourcedata=get('resourcedata',
                            ($courselevelr,$courselevelm,$courselevel));
-      if ($resourcedata{$courselevelr}!~/^error\:/) {
+      if (($resourcedata{$courselevelr}!~/^error\:/) &&
+          ($resourcedata{$courselevelr}!~/^con_lost/)) {
 
        if ($resourcedata{$courselevelr}) { 
           return $resourcedata{$courselevelr}; }
@@ -1590,25 +1628,39 @@ sub EXT {
           return $resourcedata{$courselevelm}; }
        if ($resourcedata{$courselevel}) { return $resourcedata{$courselevel}; }
 
+      } else {
+	  if ($resourcedata{$courselevelr}!~/No such file/) {
+	    &logthis("<font color=blue>WARNING:".
+		   " Trying to get resource data for ".$ENV{'user.name'}." at "
+                   .$ENV{'user.domain'}.": ".$resourcedata{$courselevelr}.
+                 "</font>");
+	  }
       }
+
 # -------------------------------------------------------- second, check course
-        my $section='';
-        if ($ENV{'request.course.sec'}) {
-	    $section='_'.$ENV{'request.course.sec'};
-        }
+
         my $reply=&reply('get:'.
-              $ENV{'course.'.$ENV{'request.course.id'}.$section.'.domain'}.':'.
-              $ENV{'course.'.$ENV{'request.course.id'}.$section.'.num'}.
+              $ENV{'course.'.$ENV{'request.course.id'}.'.domain'}.':'.
+              $ENV{'course.'.$ENV{'request.course.id'}.'.num'}.
 	      ':resourcedata:'.
    &escape($seclevelr).'&'.&escape($seclevelm).'&'.&escape($seclevel).'&'.
    &escape($courselevelr).'&'.&escape($courselevelm).'&'.&escape($courselevel),
-		   $ENV{'course.'.$ENV{'request.course.id'}.$section.'.home'});
+		   $ENV{'course.'.$ENV{'request.course.id'}.'.home'});
       if ($reply!~/^error\:/) {
 	  map {
 	      if ($_) { return &unescape($_); }
           } split(/\&/,$reply);
       }
-
+      if (($reply=~/^con_lost/) || ($reply=~/^error\:/)) {
+	  &logthis("<font color=blue>WARNING:".
+                " Getting ".$reply." asking for ".$varname." for ".
+                $ENV{'course.'.$ENV{'request.course.id'}.'.num'}.
+                ' at '.
+                $ENV{'course.'.$ENV{'request.course.id'}.'.domain'}.
+                ' from '.
+                $ENV{'course.'.$ENV{'request.course.id'}.'.home'}.
+                 "</font>");
+      }
 # ------------------------------------------------------ third, check map parms
        my %parmhash=();
        my $thisparm='';