[BACK]Return to lond CVS log [TXT] [DIR] Up to [LON-CAPA] / loncom

Diff for /loncom/lond between versions 1.324 and 1.328

version 1.324, 2006/03/29 19:56:10 version 1.328, 2006/05/18 02:32:06
Line 31 Line 31
   
 use strict;  use strict;
 use lib '/home/httpd/lib/perl/';  use lib '/home/httpd/lib/perl/';
   use LONCAPA;
 use LONCAPA::Configuration;  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 53  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 1049  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;
  my ($lock);  # Are we reading or writing?
               if ($how eq &GDBM_READER()) {
  if ($how eq &GDBM_READER()) {  # We are reading
     $lock=LOCK_SH;             if (!open($sym,"$file_prefix.db.lock")) {
     $how=$how|&GDBM_NOLOCK();  # We don't have a lock file. This could mean
     #if the db doesn't exist we can't read from it  # - that there is no such db-file
     if (! -e "$file_prefix.db") {  # - that it does not have a lock file yet
  $! = 2;                 if ((! -e "$file_prefix.db") && (! -e "$file_prefix.db.gz")) {
  return undef;  # No such file. Forget it.                
     }                     $! = 2;
  } elsif ($how eq &GDBM_WRCREAT()) {                     return undef;
     $lock=LOCK_EX;                 }
     $how=$how|&GDBM_NOLOCK();  # Apparently just no lock file yet. Make one
     if (! -e "$file_prefix.db") {                 open($sym,">>$file_prefix.db.lock");
  # doesn't exist but we need it to in order to successfully             } 
                 # lock it so bring it into existance          } elsif ($how eq &GDBM_WRCREAT()) {
  open(TOUCH,">>$file_prefix.db");  # We are writing
  close(TOUCH);             open($sym,">>$file_prefix.db.lock");
     }  # Writing needs exclusive lock
  } else {             $lock_type=LOCK_EX;
     &logthis("Unknown method $how for $file_prefix");          } else {
     die();             &logthis("Unknown method $how for $file_prefix");
  }             die();
               }
  $sym=&Symbol::gensym();  # If this is compressed, we will also need an exclusive lock
  open($sym,"$file_prefix.db");         if (-e "$file_prefix.db.gz") { $lock_type=LOCK_EX; }
  my $failed=0;  # Okay, try to obtain the lock we want
  eval {         my $failed=0;
     local $SIG{__DIE__}='DEFAULT';         eval {
     local $SIG{ALRM}=sub {              local $SIG{__DIE__}='DEFAULT';
  $failed=1;             local $SIG{ALRM}=sub {
  die("failed lock");                 $failed=1;
     };                 die("failed lock");
     alarm($lond_max_wait_time);             };
     flock($sym,$lock);             alarm($lond_max_wait_time);
     alarm(0);             flock($sym,$lock_type);
  };             alarm(0);
  if ($failed) {         };
     $! = 100; # throwing error # 100         if ($failed) {
     return undef;             $! = 100; # throwing error # 100
  }             return undef;
  return &_do_hash_tie($file_prefix,$namespace,$how,$loghead,$what);         }
   # The file is ours!
   # If it is archived, un-archive it now
          if (-e "$file_prefix.db.gz") {
              system("gunzip $file_prefix.db.gz");
      if (-e "$file_prefix.hist.gz") {
          system("gunzip $file_prefix.hist.gz");
      }
          }
   # Change access mode to non-blocking
          $how=$how|&GDBM_NOLOCK();
   # Go ahead and tie the hash
          return &_do_hash_tie($file_prefix,$namespace,$how,$loghead,$what);
     }      }
   
     sub _locking_hash_untie {      sub _locking_hash_untie {
Line 5177  sub status { Line 5188  sub status {
     $0='lond: '.$what.' '.$local;      $0='lond: '.$what.' '.$local;
 }  }
   
 # -------------------------------------------------------- Escape Special Chars  
   
 sub escape {  
     my $str=shift;  
     $str =~ s/(\W)/"%".unpack('H2',$1)/eg;  
     return $str;  
 }  
   
 # ----------------------------------------------------- Un-Escape Special Chars  
   
 sub unescape {  
     my $str=shift;  
     $str =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;  
     return $str;  
 }  
   
 # ----------------------------------------------------------- Send USR1 to lonc  # ----------------------------------------------------------- Send USR1 to lonc
   
 sub reconlonc {  sub reconlonc {
Line 6648  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.324  
changed lines
  Added in v.1.328

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