Diff for /loncom/lond between versions 1.326 and 1.327

version 1.326, 2006/05/13 01:31:15 version 1.327, 2006/05/18 02:17:27
Line 37  use LONCAPA::Configuration; Line 37  use LONCAPA::Configuration;
 use IO::Socket;  use IO::Socket;
 use IO::File;  use IO::File;
 #use Apache::File;  #use Apache::File;
 use Symbol;  
 use POSIX;  use POSIX;
 use Crypt::IDEA;  use Crypt::IDEA;
 use LWP::UserAgent();  use LWP::UserAgent();
Line 54  use LONCAPA::ConfigFileEdit; Line 53  use LONCAPA::ConfigFileEdit;
 use LONCAPA::lonlocal;  use LONCAPA::lonlocal;
 use LONCAPA::lonssl;  use LONCAPA::lonssl;
 use Fcntl qw(:flock);  use Fcntl qw(:flock);
 use Symbol;  
   
 my $DEBUG = 0;       # Non zero to enable debug log entries.  my $DEBUG = 0;       # Non zero to enable debug log entries.
   
Line 1050  sub _do_hash_untie { Line 1048  sub _do_hash_untie {
   
     sub _locking_hash_tie {      sub _locking_hash_tie {
  my ($file_prefix,$namespace,$how,$loghead,$what) = @_;   my ($file_prefix,$namespace,$how,$loghead,$what) = @_;
           my $lock_type=LOCK_SH;
 # is this locked by an external program?  # Are we reading or writing?
           if ($how eq &GDBM_READER()) {
         if (-e "$file_prefix.db.lock") {  # We are reading
     my $failed=0;             unless (open($sym,"$file_prefix.db.lock")) {
     eval {  # We don't have a lock file. This could mean
  local $SIG{__DIE__}='DEFAULT';  # - that there is no such db-file
  local $SIG{ALRM}=sub {   # - that it does not have a lock file yet
     $failed=1;                 unless ((-e "$file_prefix.db") || (-e "$file_prefix.db.gz")) {
     die("failed lock");  # No such file. Forget it.                
  };                     $! = 2;
  alarm(2*$lond_max_wait_time);                     return undef;
  while (-e "$file_prefix.db.lock") {}                 }
  alarm(0);  # Apparently just no lock file yet. Make one
     };                 open($sym,">>$file_prefix.db.lock");
     if ($failed) {             } 
  $! = 100; # throwing error # 100          } elsif ($how eq &GDBM_WRCREAT()) {
  return undef;  # We are writing
     }             open($sym,">>$file_prefix.db.lock");
  }  # Writing needs exclusive lock
              $lock_type=LOCK_EX;
 # is this archived?          } else {
              &logthis("Unknown method $how for $file_prefix");
         if (-e "$file_prefix.db.gz") {             die();
 # lock immediately          }
     open(TOUCH,">>$file_prefix.db.lock");  # If this is compressed, we will also need an exclusive lock
    close(TOUCH);         if (-e "$file_prefix.db.gz") { $lock_type=LOCK_EX; }
   # Okay, try to obtain the lock we want
          my $failed=0;
          eval {
              local $SIG{__DIE__}='DEFAULT';
              local $SIG{ALRM}=sub {
                  $failed=1;
                  die("failed lock");
              };
              alarm($lond_max_wait_time);
              flock($sym,$lock_type);
              alarm(0);
          };
          if ($failed) {
              $! = 100; # throwing error # 100
              return undef;
          }
   # The file is ours!
   # If it is archived, un-archive it now
          if (-e "$file_prefix.db.gz") {
            system("gunzip $file_prefix.db.gz");             system("gunzip $file_prefix.db.gz");
    if (-e "$file_prefix.hist.gz") {     if (-e "$file_prefix.hist.gz") {
        system("gunzip $file_prefix.hist.gz");         system("gunzip $file_prefix.hist.gz");
    }     }
 # all set, unlock  
            unlink("$file_prefix.db.lock");  
        }         }
   # Change access mode to non-blocking
          $how=$how|&GDBM_NOLOCK();
  my ($lock);  # Go ahead and tie the hash
              return &_do_hash_tie($file_prefix,$namespace,$how,$loghead,$what);
  if ($how eq &GDBM_READER()) {  
     $lock=LOCK_SH;  
     $how=$how|&GDBM_NOLOCK();  
     #if the db doesn't exist we can't read from it  
     if (! -e "$file_prefix.db") {  
  $! = 2;  
  return undef;  
     }  
  } elsif ($how eq &GDBM_WRCREAT()) {  
     $lock=LOCK_EX;  
     $how=$how|&GDBM_NOLOCK();  
     if (! -e "$file_prefix.db") {  
  # doesn't exist but we need it to in order to successfully  
                 # lock it so bring it into existance  
  open(TOUCH,">>$file_prefix.db");  
  close(TOUCH);  
     }  
  } else {  
     &logthis("Unknown method $how for $file_prefix");  
     die();  
  }  
       
  $sym=&Symbol::gensym();  
  open($sym,"$file_prefix.db");  
  my $failed=0;  
  eval {  
     local $SIG{__DIE__}='DEFAULT';  
     local $SIG{ALRM}=sub {   
  $failed=1;  
  die("failed lock");  
     };  
     alarm($lond_max_wait_time);  
     flock($sym,$lock);  
     alarm(0);  
  };  
  if ($failed) {  
     $! = 100; # throwing error # 100  
     return undef;  
  }  
  return &_do_hash_tie($file_prefix,$namespace,$how,$loghead,$what);  
     }      }
   
     sub _locking_hash_untie {      sub _locking_hash_untie {
Line 6668  to the client, and the connection is clo Line 6643  to the client, and the connection is clo
 IO::Socket  IO::Socket
 IO::File  IO::File
 Apache::File  Apache::File
 Symbol  
 POSIX  POSIX
 Crypt::IDEA  Crypt::IDEA
 LWP::UserAgent()  LWP::UserAgent()

Removed from v.1.326  
changed lines
  Added in v.1.327


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