Diff for /loncom/lond between versions 1.178.2.8 and 1.178.2.11

version 1.178.2.8, 2004/03/16 10:52:30 version 1.178.2.11, 2004/03/22 09:41:53
Line 162  sub isClient { Line 162  sub isClient {
     return (($ConnectionType eq "client") || ($ConnectionType eq "both"));      return (($ConnectionType eq "client") || ($ConnectionType eq "both"));
 }  }
 #  #
 #   Ties a resource file to a hash.  If necessary, an appropriate history  #  Ties a domain level resource file to a hash.
   #  If requested a history entry is created in the associated hist file.
   #
   #  Parameters:
   #     domain    - Name of the domain in which the resource file lives.
   #     namespace - Name of the hash within that domain.
   #     how       - How to tie the hash (e.g. GDBM_WRCREAT()).
   #     loghead   - Optional parameter, if present a log entry is created
   #                 in the associated history file and this is the first part
   #                  of that entry.
   #     logtail   - Goes along with loghead,  The actual logentry is of the
   #                 form $loghead:<timestamp>:logtail.
   # Returns:
   #    Reference to a hash bound to the db file or alternatively undef
   #    if the tie failed.
   #
   sub TieDomainHash {
       my $domain    = shift;
       my $namespace = shift;
       my $how       = shift;
       
       # Filter out any whitespace in the domain name:
       
       $domain =~ s/\W//g;
       
       # We have enough to go on to tie the hash:
       
       my $UserTopDir   = $perlvar{'lonUsersDir'};
       my $DomainDir    = $UserTopDir."/$domain";
       my $ResourceFile = $DomainDir."/$namespace.db";
       my %hash;
       if(tie(%hash, 'GDBM_File', $ResourceFile, $how, 0640)) {
    if (scalar @_) { # Need to log the operation.
       my $logFh = IO::File->new(">>$DomainDir/$namespace.hist");
       if($logFh) {
    my $TimeStamp = time;
    my ($loghead, $logtail) = @_;
    print $logFh "$loghead:$TimeStamp:$logtail\n";
       }
    }
    return \%hash; # Return the tied hash.
       }
       else {
    return undef; # Tie failed.
       }
   }
   
   #
   #   Ties a user's resource file to a hash.  
   #   If necessary, an appropriate history
 #   log file entry is made as well.  #   log file entry is made as well.
 #   This sub factors out common code from the subs that manipulate  #   This sub factors out common code from the subs that manipulate
 #   the various gdbm files that keep keyword value pairs.  #   the various gdbm files that keep keyword value pairs.
Line 179  sub isClient { Line 228  sub isClient {
 #   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 TieResourceHash {  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 676  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 1360  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 = TieResourceHash($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 1415  sub IncrementUserValueHandler { Line 1464  sub IncrementUserValueHandler {
     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 = TieResourceHash($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 1476  sub RolesPutHandler { Line 1525  sub RolesPutHandler {
    "what = ".$what);     "what = ".$what);
     my $namespace='roles';      my $namespace='roles';
     chomp($what);      chomp($what);
     my $hashref = TieResourceHash($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 1533  sub RolesDeleteHandler { Line 1582  sub RolesDeleteHandler {
    "what = ".$what);     "what = ".$what);
     my $namespace='roles';      my $namespace='roles';
     chomp($what);      chomp($what);
     my $hashref = TieResourceHash($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 1585  sub GetProfileEntry { Line 1634  sub GetProfileEntry {
         
     my ($udom,$uname,$namespace,$what) = split(/:/,$tail);      my ($udom,$uname,$namespace,$what) = split(/:/,$tail);
     chomp($what);      chomp($what);
     my $hashref = TieResourceHash($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 1640  sub GetProfileEntryEncrypted { Line 1689  sub GetProfileEntryEncrypted {
         
     my ($cmd,$udom,$uname,$namespace,$what) = split(/:/,$userinput);      my ($cmd,$udom,$uname,$namespace,$what) = split(/:/,$userinput);
     chomp($what);      chomp($what);
     my $hashref = TieResourceHash($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);
Line 1655  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 1703  sub DeleteProfileEntry { Line 1753  sub DeleteProfileEntry {
   
     my ($udom,$uname,$namespace,$what) = split(/:/,$tail);      my ($udom,$uname,$namespace,$what) = split(/:/,$tail);
     chomp($what);      chomp($what);
     my $hashref = TieResourceHash($udom, $uname, $namespace,      my $hashref = TieUserHash($udom, $uname, $namespace,
   &GDBM_WRCREAT(),    &GDBM_WRCREAT(),
   "D",$what);    "D",$what);
     if ($hashref) {      if ($hashref) {
Line 1747  sub GetProfileKeys { Line 1797  sub GetProfileKeys {
   
     my ($udom,$uname,$namespace)=split(/:/,$tail);      my ($udom,$uname,$namespace)=split(/:/,$tail);
     my $qresult='';      my $qresult='';
     my $hashref = TieResourceHash($udom, $uname, $namespace,      my $hashref = TieUserHash($udom, $uname, $namespace,
   &GDBM_READER());    &GDBM_READER());
     if ($hashref) {      if ($hashref) {
  foreach my $key (keys %$hashref) {   foreach my $key (keys %$hashref) {
Line 1794  sub DumpProfileDatabase { Line 1844  sub DumpProfileDatabase {
     my $userinput = "$cmd:$tail";      my $userinput = "$cmd:$tail";
         
     my ($udom,$uname,$namespace) = split(/:/,$tail);      my ($udom,$uname,$namespace) = split(/:/,$tail);
     my $hashref = TieResourceHash($udom, $uname, $namespace,      my $hashref = TieUserHash($udom, $uname, $namespace,
   &GDBM_READER());    &GDBM_READER());
     if ($hashref) {      if ($hashref) {
  # Structure of %data:   # Structure of %data:
Line 1802  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 1875  sub DumpWithRegexp { Line 1925  sub DumpWithRegexp {
     } else {      } else {
  $regexp='.';   $regexp='.';
     }      }
     my $hashref =TieResourceHash($udom, $uname, $namespace,      my $hashref =TieUserHash($udom, $uname, $namespace,
  &GDBM_READER());   &GDBM_READER());
     if ($hashref) {      if ($hashref) {
         my $qresult='';          my $qresult='';
Line 1935  sub StoreHandler { Line 1985  sub StoreHandler {
   
  chomp($what);   chomp($what);
  my @pairs=split(/\&/,$what);   my @pairs=split(/\&/,$what);
  my $hashref  = TieResourceHash($udom, $uname, $namespace,   my $hashref  = TieUserHash($udom, $uname, $namespace,
        &GDBM_WRCREAT(), "P",         &GDBM_WRCREAT(), "P",
        "$rid:$what");         "$rid:$what");
  if ($hashref) {   if ($hashref) {
Line 2214  sub PutCourseIdHandler { Line 2264  sub PutCourseIdHandler {
   
     my $userinput = "$cmd:$tail";      my $userinput = "$cmd:$tail";
   
     my ($udom,$what)=split(/:/,$tail);      my ($udom, $what) = split(/:/, $tail);
     chomp($what);      chomp($what);
     $udom=~s/\W//g;  
     my $proname=  
  "$perlvar{'lonUsersDir'}/$udom/nohist_courseids";  
     my $now=time;      my $now=time;
     my @pairs=split(/\&/,$what);      my @pairs=split(/\&/,$what);
     my %hash;  
     if (tie(%hash,'GDBM_File',"$proname.db",&GDBM_WRCREAT(),0640)) {      my $hashref = TieDomainHash($udom, "nohist_courseids", &GDBM_WRCREAT());
       if ($hashref) {
  foreach my $pair (@pairs) {   foreach my $pair (@pairs) {
     my ($key,$value)=split(/=/,$pair);      my ($key,$value)=split(/=/,$pair);
     $hash{$key}=$value.':'.$now;      $hashref->{$key}=$value.':'.$now;
  }   }
  if (untie(%hash)) {   if (untie(%$hashref)) {
     Reply($client, "ok\n", $userinput);      Reply($client, "ok\n", $userinput);
  } else {   } else {
     Failure( $client, "error: ".($!+0)      Failure( $client, "error: ".($!+0)
Line 2282  sub DumpCourseIdHandler { Line 2330  sub DumpCourseIdHandler {
     }      }
     unless (defined($since)) { $since=0; }      unless (defined($since)) { $since=0; }
     my $qresult='';      my $qresult='';
     my $proname = "$perlvar{'lonUsersDir'}/$udom/nohist_courseids";  
     my %hash;      my $hashref = TieDomainHash($udom, "nohist_courseids", &GDBM_WRCREAT());
     if (tie(%hash,'GDBM_File',"$proname.db",&GDBM_READER(),0640)) {      if ($hashref) {
  while (my ($key,$value) = each(%hash)) {   while (my ($key,$value) = each(%$hashref)) {
     my ($descr,$lasttime)=split(/\:/,$value);      my ($descr,$lasttime)=split(/\:/,$value);
     if ($lasttime<$since) {       if ($lasttime<$since) { 
  next;    next; 
Line 2299  sub DumpCourseIdHandler { Line 2347  sub DumpCourseIdHandler {
  }   }
     }      }
  }   }
  if (untie(%hash)) {   if (untie(%$hashref)) {
     chop($qresult);      chop($qresult);
     Reply($client, "$qresult\n", $userinput);      Reply($client, "$qresult\n", $userinput);
  } else {   } else {
Line 2340  sub PutIdHandler { Line 2388  sub PutIdHandler {
   
     my ($udom,$what)=split(/:/,$tail);      my ($udom,$what)=split(/:/,$tail);
     chomp($what);      chomp($what);
     $udom=~s/\W//g;  
     my $proname="$perlvar{'lonUsersDir'}/$udom/ids";  
     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 $hashref = TieDomainHash($udom, "ids", &GDBM_WRCREAT(),
     if (tie(%hash,'GDBM_File',"$proname.db",&GDBM_WRCREAT(),0640)) {   "P", $what);
       if ($hashref) {
  foreach my $pair (@pairs) {   foreach my $pair (@pairs) {
     my ($key,$value)=split(/=/,$pair);      my ($key,$value)=split(/=/,$pair);
     $hash{$key}=$value;      $hashref->{$key}=$value;
  }   }
  if (untie(%hash)) {   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 ".
Line 2394  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);
     $udom=~s/\W//g;  
     my $proname="$perlvar{'lonUsersDir'}/$udom/ids";  
     my @queries=split(/\&/,$what);      my @queries=split(/\&/,$what);
     my $qresult='';      my $qresult='';
     my %hash;      my $hashref = TieDomainHash($udom, "ids", &GDBM_READER());
     if (tie(%hash,'GDBM_File',"$proname.db",&GDBM_READER(),0640)) {      if ($hashref) {
  for (my $i=0;$i<=$#queries;$i++) {   for (my $i=0;$i<=$#queries;$i++) {
     $qresult.="$hash{$queries[$i]}&";      $qresult.="$hashref->{$queries[$i]}&";
  }   }
  if (untie(%hash)) {   if (untie(%$hashref)) {
     $qresult=~s/\&$//;      $qresult=~s/\&$//;
     Reply($client, "$qresult\n", $userinput);      Reply($client, "$qresult\n", $userinput);
  } else {   } else {
Line 2419  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 2487  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 2522  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 2534  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;
   
 }  }
Line 3862  sub subsqlreply { Line 3900  sub subsqlreply {
   
 sub propath {  sub propath {
     my ($udom,$uname)=@_;      my ($udom,$uname)=@_;
       Debug("Propath:$udom:$uname");
     $udom=~s/\W//g;      $udom=~s/\W//g;
     $uname=~s/\W//g;      $uname=~s/\W//g;
       Debug("Propath2:$udom:$uname");
     my $subdir=$uname.'__';      my $subdir=$uname.'__';
     $subdir =~ s/(.)(.)(.).*/$1\/$2\/$3/;      $subdir =~ s/(.)(.)(.).*/$1\/$2\/$3/;
     my $proname="$perlvar{'lonUsersDir'}/$udom/$subdir/$uname";      my $proname="$perlvar{'lonUsersDir'}/$udom/$subdir/$uname";
       Debug("Propath returning $proname");
     return $proname;      return $proname;
 }   } 
   
Line 4124  sub PasswordPath { Line 4165  sub PasswordPath {
     my $user   = shift;      my $user   = shift;
   
     my $path   = &propath($domain, $user);      my $path   = &propath($domain, $user);
     my $path  .= "/passwd";      $path  .= "/passwd";
   
     return $path;      return $path;
 }  }
Line 4143  sub PasswordFilename { Line 4184  sub PasswordFilename {
     my $domain    = shift;      my $domain    = shift;
     my $user      = shift;      my $user      = shift;
   
     my $path  = PasswordPath($domain, $user);      Debug ("PasswordFilename called: dom = $domain user = $user");
   
       my $path  = PasswordPath($domain, $user);
       Debug("PasswordFilename got path: $path");
     if(-e $path) {      if(-e $path) {
  return $path;   return $path;
     } else {      } else {

Removed from v.1.178.2.8  
changed lines
  Added in v.1.178.2.11


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