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

Diff for /loncom/lond between versions 1.178.2.9 and 1.178.2.10

version 1.178.2.9, 2004/03/22 09:05:11 version 1.178.2.10, 2004/03/22 09:16:26
Line 182  sub TieDomainHash { Line 182  sub TieDomainHash {
     my $domain    = shift;      my $domain    = shift;
     my $namespace = shift;      my $namespace = shift;
     my $how       = shift;      my $how       = shift;
       
     # Filter out any whitespace in the domain name:      # Filter out any whitespace in the domain name:
       
     $domain =~ s/\W//g;      $domain =~ s/\W//g;
       
     # We have enough to go on to tie the hash:      # We have enough to go on to tie the hash:
       
     my $UserTopDir   = $perlvar('lonUsersDir');      my $UserTopDir   = $perlvar{'lonUsersDir'};
     my $DomainDir    = $UserTopDir."/$domain";      my $DomainDir    = $UserTopDir."/$domain";
     my $ResourceFile = $DomainDir."/$namespace.db";      my $ResourceFile = $DomainDir."/$namespace.db";
     my %hash;      my %hash;
     if(tie(%hash, 'GDBM_File', $ResourceFile, $how, 0640)) {      if(tie(%hash, 'GDBM_File', $ResourceFile, $how, 0640)) {
  if (scalar @_) { # Need to log the operation.   if (scalar @_) { # Need to log the operation.
     my $logFh = IO::File->new(">>$DomainDir/$namespace.hist");      my $logFh = IO::File->new(">>$DomainDir/$namespace.hist");
     if($logFH) {      if($logFh) {
  my $TimeStamp = time;   my $TimeStamp = time;
  my ($loghead, $logtail) = @_;   my ($loghead, $logtail) = @_;
  print $logFH "$loghead:$TimeStamp:$logtail\n";   print $logFh "$loghead:$TimeStamp:$logtail\n";
     }      }
  }   }
  return \%hash; # Return the tied hash.   return \%hash; # Return the tied hash.
Line 229  sub TieDomainHash { Line 229  sub TieDomainHash {
 #   undef if the has could not be tied.  #   undef if the has could not be tied.
 #  #
 sub TieUserHash {  sub TieUserHash {
   my $domain      = shift;      my $domain      = shift;
   my $user        = shift;      my $user        = shift;
   my $namespace   = shift;      my $namespace   = shift;
   my $how         = shift;      my $how         = shift;
       
   $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,      # If this is a namespace for which a history is kept,
   # make the history log entry:      # make the history log entry:
       
       
   unless ($namespace =~/^nohist\_/ && (scalar @_ > 0)) {      unless ($namespace =~/^nohist\_/ && (scalar @_ > 0)) {
     my $hfh = IO::File->new(">>$proname/$namespace.hist");    my $hfh = IO::File->new(">>$proname/$namespace.hist"); 
     if($hfh) {   if($hfh) {
       my $now = time;      my $now = time;
       my $loghead  = shift;      my $loghead  = shift;
       my $what    = shift;      my $what    = shift;
       print $hfh "$loghead:$now:$what\n";      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)) {
     return \%hash;   return \%hash;
   }      }
   else {      else {
     return undef;   return undef;
   }      }
         
 }  }
   
 #  #
Line 725  sub AuthenticateHandler { Line 725  sub AuthenticateHandler {
     my $cmd        = shift;      my $cmd        = shift;
     my $tail       = shift;      my $tail       = shift;
     my $client     = shift;      my $client     = shift;
          
     #  Regenerate the full input line       #  Regenerate the full input line 
          
     my $userinput  = $cmd.":".$tail;      my $userinput  = $cmd.":".$tail;
       
     #  udom    - User's domain.      #  udom    - User's domain.
     #  uname   - Username.      #  uname   - Username.
     #  upass   - User's password.      #  upass   - User's password.
          
     my ($udom,$uname,$upass)=split(/:/,$tail);      my ($udom,$uname,$upass)=split(/:/,$tail);
     Debug(" Authenticate domain = $udom, user = $uname, password = $upass");      Debug(" Authenticate domain = $udom, user = $uname, password = $upass");
     chomp($upass);      chomp($upass);
Line 1409  sub PutUserProfileEntry { Line 1409  sub PutUserProfileEntry {
     my $tail      = shift;      my $tail      = shift;
     my $client    = shift;      my $client    = shift;
     my $userinput = "$cmd:$tail";      my $userinput = "$cmd:$tail";
       
     my ($udom,$uname,$namespace,$what) =split(/:/,$tail);      my ($udom,$uname,$namespace,$what) =split(/:/,$tail);
     if ($namespace ne 'roles') {      if ($namespace ne 'roles') {
        chomp($what);   chomp($what);
        my $hashref = TieUserHash($udom, $uname, $namespace,   my $hashref = TieUserHash($udom, $uname, $namespace,
      &GDBM_WRCREAT(),"P",$what);    &GDBM_WRCREAT(),"P",$what);
        if($hashref) {   if($hashref) {
  my @pairs=split(/\&/,$what);      my @pairs=split(/\&/,$what);
  foreach my $pair (@pairs) {      foreach my $pair (@pairs) {
     my ($key,$value)=split(/=/,$pair);   my ($key,$value)=split(/=/,$pair);
     $hashref->{$key}=$value;   $hashref->{$key}=$value;
   }      }
   if (untie(%$hashref)) {      if (untie(%$hashref)) {
      Reply( $client, "ok\n", $userinput);   Reply( $client, "ok\n", $userinput);
   } else {      } else {
      Failure($client, "error: ".($!+0)." untie(GDBM) failed ".   Failure($client, "error: ".($!+0)." untie(GDBM) failed ".
      "while attempting put\n",    "while attempting put\n", 
      $userinput);   $userinput);
   }      }
        } else {   } else {
   Failure( $client, "error: ".($!)." tie(GDBM) Failed ".      Failure( $client, "error: ".($!)." tie(GDBM) Failed ".
    "while attempting put\n", $userinput);       "while attempting put\n", $userinput);
        }   }
      } else {      } else {
         Failure( $client, "refused\n", $userinput);          Failure( $client, "refused\n", $userinput);
      }      }
           
      return 1;      return 1;
 }  }
 RegisterHandler("put", \&PutUserProfileEntry, 0, 1, 0);  RegisterHandler("put", \&PutUserProfileEntry, 0, 1, 0);
   
Line 1465  sub IncrementUserValueHandler { Line 1465  sub IncrementUserValueHandler {
     if ($namespace ne 'roles') {      if ($namespace ne 'roles') {
         chomp($what);          chomp($what);
  my $hashref = TieUserHash($udom, $uname,   my $hashref = TieUserHash($udom, $uname,
       $namespace, &GDBM_WRCREAT(),    $namespace, &GDBM_WRCREAT(),
       "P",$what);    "P",$what);
  if ($hashref) {   if ($hashref) {
    my @pairs=split(/\&/,$what);      my @pairs=split(/\&/,$what);
    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...
      if (! defined($value) || $value eq '') {   if (! defined($value) || $value eq '') {
         $value = 1;      $value = 1;
      }   }
      $hashref->{$key}+=$value;   $hashref->{$key}+=$value;
    }      }
    if (untie(%$hashref)) {      if (untie(%$hashref)) {
       Reply( $client, "ok\n", $userinput);   Reply( $client, "ok\n", $userinput);
    } else {      } else {
       Failure($client, "error: ".($!+0)." untie(GDBM) failed ".   Failure($client, "error: ".($!+0)." untie(GDBM) failed ".
       "while attempting inc\n", $userinput);   "while attempting inc\n", $userinput);
    }      }
  } else {   } else {
    Failure($client, "error: ".($!+0)." tie(GDBM) Failed ".      Failure($client, "error: ".($!+0)." tie(GDBM) Failed ".
    "while attempting inc\n", $userinput);      "while attempting inc\n", $userinput);
  }   }
       } else {      } else {
  Failure($client, "refused\n", $userinput);   Failure($client, "refused\n", $userinput);
       }      }
           
     return 1;      return 1;
 }  }
Line 1526  sub RolesPutHandler { Line 1526  sub RolesPutHandler {
     my $namespace='roles';      my $namespace='roles';
     chomp($what);      chomp($what);
     my $hashref = TieUserHash($udom, $uname, $namespace,      my $hashref = TieUserHash($udom, $uname, $namespace,
   &GDBM_WRCREAT(), "P",        &GDBM_WRCREAT(), "P",
   "$exedom:$exeuser:$what");        "$exedom:$exeuser:$what");
     #      #
     #  Log the attempt to set a role.  The {}'s here ensure that the file       #  Log the attempt to set a role.  The {}'s here ensure that the file 
     #  handle is open for the minimal amount of time.  Since the flush      #  handle is open for the minimal amount of time.  Since the flush
Line 1583  sub RolesDeleteHandler { Line 1583  sub RolesDeleteHandler {
     my $namespace='roles';      my $namespace='roles';
     chomp($what);      chomp($what);
     my $hashref = TieUserHash($udom, $uname, $namespace,      my $hashref = TieUserHash($udom, $uname, $namespace,
   &GDBM_WRCREAT(), "D",        &GDBM_WRCREAT(), "D",
   "$exedom:$exeuser:$what");        "$exedom:$exeuser:$what");
       
     if ($hashref) {      if ($hashref) {
        my @rolekeys=split(/\&/,$what);   my @rolekeys=split(/\&/,$what);
          
        foreach my $key (@rolekeys) {   foreach my $key (@rolekeys) {
   delete $hashref->{$key};      delete $hashref->{$key};
        }   }
        if (untie(%$hashref)) {   if (untie(%$hashref)) {
   Reply($client, "ok\n", $userinput);      Reply($client, "ok\n", $userinput);
  } else {   } else {
    Failure( $client, "error: ".($!+0)." untie(GDBM) Failed ".      Failure( $client, "error: ".($!+0)." untie(GDBM) Failed ".
     "while attempting rolesdel\n", $userinput);       "while attempting rolesdel\n", $userinput);
  }   }
      } else {      } else {
         Failure( $client, "error: ".($!+0)." tie(GDBM) Failed ".          Failure( $client, "error: ".($!+0)." tie(GDBM) Failed ".
  "while attempting rolesdel\n", $userinput);   "while attempting rolesdel\n", $userinput);
      }      }
           
     return 1;      return 1;
 }  }
Line 1635  sub GetProfileEntry { Line 1635  sub GetProfileEntry {
     my ($udom,$uname,$namespace,$what) = split(/:/,$tail);      my ($udom,$uname,$namespace,$what) = split(/:/,$tail);
     chomp($what);      chomp($what);
     my $hashref = TieUserHash($udom, $uname, $namespace,      my $hashref = TieUserHash($udom, $uname, $namespace,
  &GDBM_READER());        &GDBM_READER());
     if ($hashref) {      if ($hashref) {
         my @queries=split(/\&/,$what);          my @queries=split(/\&/,$what);
         my $qresult='';          my $qresult='';
   
  for (my $i=0;$i<=$#queries;$i++) {   for (my $i=0;$i<=$#queries;$i++) {
     $qresult.="$hashref->{$queries[$i]}&";    # Presumably failure gives empty string.      $qresult.="$hashref->{$queries[$i]}&";    # Presumably failure gives empty string.
  }   }
Line 1704  sub GetProfileEntryEncrypted { Line 1704  sub GetProfileEntryEncrypted {
  $qresult.="         ";   $qresult.="         ";
  my $encqresult='';   my $encqresult='';
  for(my $encidx=0;$encidx<=$cmdlength;$encidx+=8) {   for(my $encidx=0;$encidx<=$cmdlength;$encidx+=8) {
     $encqresult.= unpack("H16", $cipher->encrypt(substr($qresult,      $encqresult.= unpack("H16", 
  $encidx,   $cipher->encrypt(substr($qresult,
  8)));   $encidx,
    8)));
  }   }
  Reply( $client, "enc:$cmdlength:$encqresult\n", $userinput);   Reply( $client, "enc:$cmdlength:$encqresult\n", $userinput);
     } else {      } else {
Line 1851  sub DumpProfileDatabase { Line 1852  sub DumpProfileDatabase {
  # $data{$symb}->{'v.'.$parameter}=$version;   # $data{$symb}->{'v.'.$parameter}=$version;
  # since $parameter will be unescaped, we do not   # since $parameter will be unescaped, we do not
   # have to worry about silly parameter names...    # have to worry about silly parameter names...
   
         my $qresult='';          my $qresult='';
  my %data = ();                     # A hash of anonymous hashes..   my %data = ();                     # A hash of anonymous hashes..
  while (my ($key,$value) = each(%$hashref)) {   while (my ($key,$value) = each(%$hashref)) {
Line 2263  sub PutCourseIdHandler { Line 2264  sub PutCourseIdHandler {
   
     my $userinput = "$cmd:$tail";      my $userinput = "$cmd:$tail";
   
       my ($udom, $what) = split(/:/, $tail);
     chomp($what);      chomp($what);
     my $now=time;      my $now=time;
     my @pairs=split(/\&/,$what);      my @pairs=split(/\&/,$what);
Line 2432  sub GetIdHandler { Line 2434  sub GetIdHandler {
     my $cmd    = shift;      my $cmd    = shift;
     my $tail   = shift;      my $tail   = shift;
     my $client = shift;      my $client = shift;
       
     my $userinput = "$client:$tail";      my $userinput = "$client:$tail";
       
     my ($udom,$what)=split(/:/,$tail);      my ($udom,$what)=split(/:/,$tail);
     chomp($what);      chomp($what);
     my @queries=split(/\&/,$what);      my @queries=split(/\&/,$what);
Line 2455  sub GetIdHandler { Line 2457  sub GetIdHandler {
  Failure($client, "error: ".($!+0)." tie(GDBM) Failed ".   Failure($client, "error: ".($!+0)." tie(GDBM) Failed ".
  "while attempting idget\n",$userinput);   "while attempting idget\n",$userinput);
     }      }
       
     return 1;      return 1;
 }  }
   
Line 2523  sub TmpGetHandler { Line 2525  sub TmpGetHandler {
     my $id        = shift;      my $id        = shift;
     my $client    = shift;      my $client    = shift;
     my $userinput = "$cmd:$id";       my $userinput = "$cmd:$id"; 
       
     chomp($id);      chomp($id);
     $id=~s/\W/\_/g;      $id=~s/\W/\_/g;
     my $store;      my $store;
Line 2558  sub TmpDelHandler { Line 2560  sub TmpDelHandler {
     my $cmd      = shift;      my $cmd      = shift;
     my $id       = shift;      my $id       = shift;
     my $client   = shift;      my $client   = shift;
       
     my $userinput= "$cmd:$id";      my $userinput= "$cmd:$id";
       
     chomp($id);      chomp($id);
     $id=~s/\W/\_/g;      $id=~s/\W/\_/g;
     my $execdir=$perlvar{'lonDaemons'};      my $execdir=$perlvar{'lonDaemons'};
Line 2570  sub TmpDelHandler { Line 2572  sub TmpDelHandler {
  Failure( $client, "error: ".($!+0)."Unlink tmp Failed ".   Failure( $client, "error: ".($!+0)."Unlink tmp Failed ".
  "while attempting tmpdel\n", $userinput);   "while attempting tmpdel\n", $userinput);
     }      }
       
     return 1;      return 1;
   
 }  }
Removed from v.1.178.2.9  
changed lines
  Added in v.1.178.2.10

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