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

Diff for /loncom/lond between versions 1.208 and 1.211

version 1.208, 2004/07/23 13:36:29 version 1.211, 2004/07/23 16:14:19
Line 955  sub EditFile { Line 955  sub EditFile {
 #    Reference to a hash bound to the db file or alternatively undef  #    Reference to a hash bound to the db file or alternatively undef
 #    if the tie failed.  #    if the tie failed.
 #  #
 sub TieDomainHash {  sub tie_domain_hash {
     my ($domain,       my ($domain,$namespace,$how,$loghead,$logtail) = @_;
  $namespace,  
  $how)     = @_;  
           
     # Filter out any whitespace in the domain name:      # Filter out any whitespace in the domain name:
           
Line 971  sub TieDomainHash { Line 969  sub TieDomainHash {
     my $resource_file  = $domain_dir."/$namespace.db";      my $resource_file  = $domain_dir."/$namespace.db";
     my %hash;      my %hash;
     if(tie(%hash, 'GDBM_File', $resource_file, $how, 0640)) {      if(tie(%hash, 'GDBM_File', $resource_file, $how, 0640)) {
  if (scalar @_) { # Need to log the operation.   if (defined($loghead)) { # Need to log the operation.
     my $logFh = IO::File->new(">>domain_dir/$namespace.hist");      my $logFh = IO::File->new(">>$domain_dir/$namespace.hist");
     if($logFh) {      if($logFh) {
  my $timestamp = time;   my $timestamp = time;
  my ($loghead, $logtail) = @_;  
  print $logFh "$loghead:$timestamp:$logtail\n";   print $logFh "$loghead:$timestamp:$logtail\n";
     }      }
       $logFh->close;
  }   }
  return \%hash; # Return the tied hash.   return \%hash; # Return the tied hash.
     }      } else {
     else {  
  return undef; # Tie failed.   return undef; # Tie failed.
     }      }
 }  }
Line 1005  sub TieDomainHash { Line 1002  sub TieDomainHash {
 #   hash to which the database is tied.  It's up to the caller to untie.  #   hash to which the database is tied.  It's up to the caller to untie.
 #   undef if the has could not be tied.  #   undef if the has could not be tied.
 #  #
 sub TieUserHash {  sub tie_user_hash {
     my ($domain,      my ($domain,$user,$namespace,$how,$loghead,$what) = @_;
  $user,  
  $namespace,  
  $how)       = @_;  
   
       
     $namespace=~s/\//\_/g; # / -> _      $namespace=~s/\//\_/g; # / -> _
     $namespace=~s/\W//g; # whitespace eliminated.      $namespace=~s/\W//g; # whitespace eliminated.
     my $proname     = propath($domain, $user);      my $proname     = propath($domain, $user);
         
     # If this is a namespace for which a history is kept,  
     # make the history log entry:  
       
       
     if (($namespace =~/^nohist\_/) && (scalar @_ > 0)) {  
  my $args = scalar @_;  
  Debug(" Opening history: $namespace $args");  
  my $hfh = IO::File->new(">>$proname/$namespace.hist");   
  if($hfh) {  
     my $now = time;  
     my $loghead  = shift;  
     my $what    = shift;  
     print $hfh "$loghead:$now:$what\n";  
  }  
     }  
     #  Tie the database.      #  Tie the database.
           
     my %hash;      my %hash;
     if(tie(%hash, 'GDBM_File', "$proname/$namespace.db",      if(tie(%hash, 'GDBM_File', "$proname/$namespace.db",
    $how, 0640)) {     $how, 0640)) {
    # If this is a namespace for which a history is kept,
    # make the history log entry:    
    if (($namespace =~/^nohist\_/) && (defined($loghead))) {
       my $args = scalar @_;
       Debug(" Opening history: $namespace $args");
       my $hfh = IO::File->new(">>$proname/$namespace.hist"); 
       if($hfh) {
    my $now = time;
    print $hfh "$loghead:$now:$what\n";
       }
       $hfh->close;
    }
  return \%hash;   return \%hash;
     }      } else {
     else {  
  return undef;   return undef;
     }      }
           
Line 1054  sub TieUserHash { Line 1043  sub TieUserHash {
 #   is defined as a 'line' of text.  We remove the new line  #   is defined as a 'line' of text.  We remove the new line
 #   from the text line.    #   from the text line.  
 #     #   
 sub GetRequest {  sub get_request {
     my $input = <$client>;      my $input = <$client>;
     chomp($input);      chomp($input);
   
Line 1073  sub GetRequest { Line 1062  sub GetRequest {
 #  Implicit input:  #  Implicit input:
 #     cipher  - This global holds the negotiated encryption key.  #     cipher  - This global holds the negotiated encryption key.
 #  #
 sub Decipher {  sub decipher {
     my ($input)  = @_;      my ($input)  = @_;
     my $output = '';      my $output = '';
         
Line 1117  sub Decipher { Line 1106  sub Decipher {
 #      - On failure, the program will die as it's a bad internal bug to try to   #      - On failure, the program will die as it's a bad internal bug to try to 
 #        register a duplicate command handler.  #        register a duplicate command handler.
 #  #
 sub RegisterHandler {  sub register_handler {
     my ($request_name,      my ($request_name,
  $procedure,   $procedure,
  $must_encode,   $must_encode,
Line 2495  sub make_new_child { Line 2484  sub make_new_child {
     chomp($what);      chomp($what);
     my $proname=propath($udom,$uname);      my $proname=propath($udom,$uname);
     my $now=time;      my $now=time;
     unless ($namespace=~/^nohist\_/) {  
  my $hfh;  
  if (  
     $hfh=IO::File->new(">>$proname/$namespace.hist")  
     ) { print $hfh "P:$now:$what\n"; }  
     }  
     my @pairs=split(/\&/,$what);      my @pairs=split(/\&/,$what);
     my %hash;      my %hash;
     if (tie(%hash,'GDBM_File',      if (tie(%hash,'GDBM_File',
     "$proname/$namespace.db",      "$proname/$namespace.db",
     &GDBM_WRCREAT(),0640)) {      &GDBM_WRCREAT(),0640)) {
    unless ($namespace=~/^nohist\_/) {
       my $hfh;
       if ($hfh=IO::File->new(">>$proname/$namespace.hist")) { print $hfh "P:$now:$what\n"; }
    }
   
  foreach my $pair (@pairs) {   foreach my $pair (@pairs) {
     my ($key,$value)=split(/=/,$pair);      my ($key,$value)=split(/=/,$pair);
     $hash{$key}=$value;      $hash{$key}=$value;
Line 2540  sub make_new_child { Line 2528  sub make_new_child {
     chomp($what);      chomp($what);
     my $proname=propath($udom,$uname);      my $proname=propath($udom,$uname);
     my $now=time;      my $now=time;
     unless ($namespace=~/^nohist\_/) {  
  my $hfh;  
  if (  
     $hfh=IO::File->new(">>$proname/$namespace.hist")  
     ) { print $hfh "P:$now:$what\n"; }  
     }  
     my @pairs=split(/\&/,$what);      my @pairs=split(/\&/,$what);
     my %hash;      my %hash;
     if (tie(%hash,'GDBM_File',      if (tie(%hash,'GDBM_File',
     "$proname/$namespace.db",      "$proname/$namespace.db",
     &GDBM_WRCREAT(),0640)) {      &GDBM_WRCREAT(),0640)) {
    unless ($namespace=~/^nohist\_/) {
       my $hfh;
       if ($hfh=IO::File->new(">>$proname/$namespace.hist")) { print $hfh "P:$now:$what\n"; }
    }
  foreach my $pair (@pairs) {   foreach my $pair (@pairs) {
     my ($key,$value)=split(/=/,$pair);      my ($key,$value)=split(/=/,$pair);
                                     # We could check that we have a number...                                      # We could check that we have a number...
Line 2592  sub make_new_child { Line 2578  sub make_new_child {
     chomp($what);      chomp($what);
     my $proname=propath($udom,$uname);      my $proname=propath($udom,$uname);
     my $now=time;      my $now=time;
     {  
  my $hfh;  
  if (  
     $hfh=IO::File->new(">>$proname/$namespace.hist")  
     ) {   
     print $hfh "P:$now:$exedom:$exeuser:$what\n";  
  }  
     }  
     my @pairs=split(/\&/,$what);      my @pairs=split(/\&/,$what);
     my %hash;      my %hash;
     if (tie(%hash,'GDBM_File',"$proname/$namespace.db",&GDBM_WRCREAT(),0640)) {      if (tie(%hash,'GDBM_File',"$proname/$namespace.db",&GDBM_WRCREAT(),0640)) {
    {
       my $hfh;
       if ($hfh=IO::File->new(">>$proname/$namespace.hist")) { 
    print $hfh "P:$now:$exedom:$exeuser:$what\n";
       }
    }
   
  foreach my $pair (@pairs) {   foreach my $pair (@pairs) {
     my ($key,$value)=split(/=/,$pair);      my ($key,$value)=split(/=/,$pair);
     &ManagePermissions($key, $udom, $uname,      &ManagePermissions($key, $udom, $uname,
Line 2643  sub make_new_child { Line 2628  sub make_new_child {
     chomp($what);      chomp($what);
     my $proname=propath($udom,$uname);      my $proname=propath($udom,$uname);
     my $now=time;      my $now=time;
     {  
  my $hfh;  
  if (  
     $hfh=IO::File->new(">>$proname/$namespace.hist")  
     ) {   
     print $hfh "D:$now:$exedom:$exeuser:$what\n";  
  }  
     }  
     my @rolekeys=split(/\&/,$what);      my @rolekeys=split(/\&/,$what);
     my %hash;      my %hash;
     if (tie(%hash,'GDBM_File',"$proname/$namespace.db",&GDBM_WRCREAT(),0640)) {      if (tie(%hash,'GDBM_File',"$proname/$namespace.db",&GDBM_WRCREAT(),0640)) {
    {
       my $hfh;
       if ($hfh=IO::File->new(">>$proname/$namespace.hist")) { 
    print $hfh "D:$now:$exedom:$exeuser:$what\n";
       }
    }
  foreach my $key (@rolekeys) {   foreach my $key (@rolekeys) {
     delete $hash{$key};      delete $hash{$key};
  }   }
Line 2770  sub make_new_child { Line 2753  sub make_new_child {
  chomp($what);   chomp($what);
  my $proname=propath($udom,$uname);   my $proname=propath($udom,$uname);
  my $now=time;   my $now=time;
  unless ($namespace=~/^nohist\_/) {  
     my $hfh;  
     if (  
  $hfh=IO::File->new(">>$proname/$namespace.hist")  
  ) { print $hfh "D:$now:$what\n"; }  
  }  
  my @keys=split(/\&/,$what);   my @keys=split(/\&/,$what);
  my %hash;   my %hash;
  if (tie(%hash,'GDBM_File',"$proname/$namespace.db",&GDBM_WRCREAT(),0640)) {   if (tie(%hash,'GDBM_File',"$proname/$namespace.db",&GDBM_WRCREAT(),0640)) {
       unless ($namespace=~/^nohist\_/) {
    my $hfh;
    if ($hfh=IO::File->new(">>$proname/$namespace.hist")) { print $hfh "D:$now:$what\n"; }
       }
     foreach my $key (@keys) {      foreach my $key (@keys) {
  delete($hash{$key});   delete($hash{$key});
     }      }
Line 2933  sub make_new_child { Line 2914  sub make_new_child {
     chomp($what);      chomp($what);
     my $proname=propath($udom,$uname);      my $proname=propath($udom,$uname);
     my $now=time;      my $now=time;
     unless ($namespace=~/^nohist\_/) {  
  my $hfh;  
  if (  
     $hfh=IO::File->new(">>$proname/$namespace.hist")  
     ) { print $hfh "P:$now:$rid:$what\n"; }  
     }  
     my @pairs=split(/\&/,$what);      my @pairs=split(/\&/,$what);
     my %hash;      my %hash;
     if (tie(%hash,'GDBM_File',"$proname/$namespace.db",&GDBM_WRCREAT(),0640)) {      if (tie(%hash,'GDBM_File',"$proname/$namespace.db",&GDBM_WRCREAT(),0640)) {
    unless ($namespace=~/^nohist\_/) {
       my $hfh;
       if ($hfh=IO::File->new(">>$proname/$namespace.hist")) {
    print $hfh "P:$now:$rid:$what\n";
       }
    }
  my @previouskeys=split(/&/,$hash{"keys:$rid"});   my @previouskeys=split(/&/,$hash{"keys:$rid"});
  my $key;   my $key;
  $hash{"version:$rid"}++;   $hash{"version:$rid"}++;
Line 3167  sub make_new_child { Line 3148  sub make_new_child {
  $udom=~s/\W//g;   $udom=~s/\W//g;
  my $proname="$perlvar{'lonUsersDir'}/$udom/ids";   my $proname="$perlvar{'lonUsersDir'}/$udom/ids";
  my $now=time;   my $now=time;
  {  
     my $hfh;  
     if (  
  $hfh=IO::File->new(">>$proname.hist")  
  ) { print $hfh "P:$now:$what\n"; }  
  }  
  my @pairs=split(/\&/,$what);   my @pairs=split(/\&/,$what);
  my %hash;   my %hash;
  if (tie(%hash,'GDBM_File',"$proname.db",&GDBM_WRCREAT(),0640)) {   if (tie(%hash,'GDBM_File',"$proname.db",&GDBM_WRCREAT(),0640)) {
       {
    my $hfh;
    if ($hfh=IO::File->new(">>$proname.hist")) {
       print $hfh "P:$now:$what\n";
    }
       }
     foreach my $pair (@pairs) {      foreach my $pair (@pairs) {
  my ($key,$value)=split(/=/,$pair);   my ($key,$value)=split(/=/,$pair);
  $hash{$key}=$value;   $hash{$key}=$value;
Removed from v.1.208  
changed lines
  Added in v.1.211

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