[BACK]Return to lonnet.pm CVS log [TXT] [DIR] Up to [LON-CAPA] / loncom / lonnet / perl

Diff for /loncom/lonnet/perl/lonnet.pm between versions 1.84 and 1.91

version 1.84, 2000/12/29 21:52:19 version 1.91, 2001/01/09 22:27:07
Line 82 Line 82
 # 10/30,10/31,  # 10/30,10/31,
 # 11/2,11/14,11/15,11/16,11/20,11/21,11/22,11/25,11/27,  # 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  # 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
   
 package Apache::lonnet;  package Apache::lonnet;
   
Line 95  use IO::Socket; Line 97  use IO::Socket;
 use GDBM_File;  use GDBM_File;
 use Apache::Constants qw(:common :http);  use Apache::Constants qw(:common :http);
 use HTML::TokeParser;  use HTML::TokeParser;
   use Fcntl qw(:flock);
   
 # --------------------------------------------------------------------- Logging  # --------------------------------------------------------------------- Logging
   
Line 177  sub reconlonc { Line 180  sub reconlonc {
   
 sub critical {  sub critical {
     my ($cmd,$server)=@_;      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);      my $answer=reply($cmd,$server);
     if ($answer eq 'con_lost') {      if ($answer eq 'con_lost') {
         my $pingreply=reply('ping',$server);          my $pingreply=reply('ping',$server);
Line 226  sub critical { Line 234  sub critical {
   
 sub appenv {  sub appenv {
     my %newenv=@_;      my %newenv=@_;
       my ($in,$out);
     map {      map {
  if (($newenv{$_}=~/^user\.role/) || ($newenv{$_}=~/^user\.priv/)) {   if (($newenv{$_}=~/^user\.role/) || ($newenv{$_}=~/^user\.priv/)) {
             &logthis("<font color=blue>WARNING: ".              &logthis("<font color=blue>WARNING: ".
Line 241  sub appenv { Line 250  sub appenv {
      unless ($fh=Apache::File->new("$ENV{'user.environment'}")) {       unless ($fh=Apache::File->new("$ENV{'user.environment'}")) {
  return 'error';   return 'error';
      }       }
        unless (flock($fh,LOCK_SH)) {
            &logthis("<font color=blue>WARNING: ".
                     'Could not obtain shared lock in appenv: '.$!);
            $fh->close();
            return 'error: '.$!;
        }
        &logthis("<font color=green>appenv LOCK_SH gotten");
      @oldenv=<$fh>;       @oldenv=<$fh>;
        $in=$#oldenv+1;
        &logthis("<font color=green>appenv LOCK_SH to be closed");
        $fh->close();
     }      }
       &logthis("<font color=green>Number of elements read appenv: ".$in."from".join(" ",caller));
     for (my $i=0; $i<=$#oldenv; $i++) {      for (my $i=0; $i<=$#oldenv; $i++) {
         chomp($oldenv[$i]);          chomp($oldenv[$i]);
         if ($oldenv[$i] ne '') {          if ($oldenv[$i] ne '') {
Line 258  sub appenv { Line 278  sub appenv {
  return 'error';   return 'error';
      }       }
      my $newname;       my $newname;
      foreach $newname (keys %newenv) {       unless (flock($fh,LOCK_EX)) {
            &logthis("<font color=blue>WARNING: ".
                     'Could not obtain exclusive lock in appenv: '.$!);
            $fh->close();
            return 'error: '.$!;
        }
        &logthis("<font color=green>appenv LOCK_EX gotten");
        $out=0;
        foreach $newname (sort keys %newenv) {
  print $fh "$newname=$newenv{$newname}\n";   print $fh "$newname=$newenv{$newname}\n";
    $out++;
      }       }
        &logthis("<font color=green>appenv LOCK_EX to be closed");
        $fh->close();
     }      }
       &logthis("<font color=green>Number of elements read appenv: ".$in." number out:".$out."from".join(" ",caller));
     return 'ok';      return 'ok';
 }  }
 # ----------------------------------------------------- Delete from Environment  # ----------------------------------------------------- Delete from Environment
Line 280  sub delenv { Line 312  sub delenv {
      unless ($fh=Apache::File->new("$ENV{'user.environment'}")) {       unless ($fh=Apache::File->new("$ENV{'user.environment'}")) {
  return 'error';   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>;       @oldenv=<$fh>;
        $fh->close();
     }      }
     {      {
      my $fh;       my $fh;
      unless ($fh=Apache::File->new(">$ENV{'user.environment'}")) {       unless ($fh=Apache::File->new(">$ENV{'user.environment'}")) {
  return 'error';   return 'error';
      }       }
        unless (flock($fh,LOCK_EX)) {
            &logthis("<font color=blue>WARNING: ".
                     'Could not obtain exclusive lock in delenv: '.$!);
            $fh->close();
            return 'error: '.$!;
        }
      map {       map {
  unless ($_=~/^$delthis/) { print $fh $_; }   unless ($_=~/^$delthis/) { print $fh $_; }
      } @oldenv;       } @oldenv;
        $fh->close();
     }      }
     return 'ok';      return 'ok';
 }  }
Line 1325  sub createcourse { Line 1371  sub createcourse {
     my ($udom,$description,$url)=@_;      my ($udom,$description,$url)=@_;
     $url=&declutter($url);      $url=&declutter($url);
     my $cid='';      my $cid='';
     unless ($cid=$ENV{'request.course.id'}) {  
  return 'not_in_class';  
     }  
     unless (&allowed('ccc',$ENV{'user.domain'})) {      unless (&allowed('ccc',$ENV{'user.domain'})) {
         return 'refused';          return 'refused';
     }      }
Removed from v.1.84  
changed lines
  Added in v.1.91

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>