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

Diff for /loncom/lond between versions 1.178.2.5 and 1.178.2.11

version 1.178.2.5, 2004/02/24 16:52:16 version 1.178.2.11, 2004/03/22 09:41:53
Line 161  sub isManager { Line 161  sub isManager {
 sub isClient {  sub isClient {
     return (($ConnectionType eq "client") || ($ConnectionType eq "both"));      return (($ConnectionType eq "client") || ($ConnectionType eq "both"));
 }  }
   #
   #  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.
   #   This sub factors out common code from the subs that manipulate
   #   the various gdbm files that keep keyword value pairs.
   # Parameters:
   #   domain       - Name of the domain the user is in.
   #   user         - Name of the 'current user'.
   #   namespace    - Namespace representing the file to tie.
   #   how          - What the tie is done to (e.g. GDBM_WRCREAT().
   #   loghead      - Optional first part of log entry if there may be a
   #                  history file.
   #   what         - Optional tail of log entry if there may be a history
   #                  file.
   # Returns:
   #   hash to which the database is tied.  It's up to the caller to untie.
   #   undef if the has could not be tied.
   #
   sub TieUserHash {
       my $domain      = shift;
       my $user        = shift;
       my $namespace   = shift;
       my $how         = shift;
       
       $namespace=~s/\//\_/g; # / -> _
       $namespace=~s/\W//g; # whitespace eliminated.
       my $proname     = propath($domain, $user);
       
       # If this is a namespace for which a history is kept,
       # make the history log entry:
       
       
       unless ($namespace =~/^nohist\_/ && (scalar @_ > 0)) {
    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.
       
       my %hash;
       if(tie(%hash, 'GDBM_FILE', "$proname/$namespace.db",
      $how, 0640)) {
    return \%hash;
       }
       else {
    return undef;
       }
       
   }
   
 #  #
 #   Get a Request:  #   Get a Request:
Line 460  sub UserAuthorizationType { Line 561  sub UserAuthorizationType {
     if($result eq "nouser") {      if($result eq "nouser") {
  Failure( $replyfd, "unknown_user\n", $userinput);   Failure( $replyfd, "unknown_user\n", $userinput);
     } else {      } else {
  Reply( $replyfd, "$result\n", $userinput);   #
    # We only want to pass the second field from GetAuthType
    # for ^krb.. otherwise we'll be handing out the encrypted
    # password for internals e.g.
    #
    my ($type,$otherinfo) = split(/:/,$result);
    if($type =~ /^krb/) {
       $type = $result;
    }
    Reply( $replyfd, "$type\n", $userinput);
     }      }
       
     return 1;      return 1;
Line 615  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);
     $upass=unescape($upass);      $upass=unescape($upass);
     my $proname=propath($udom,$uname);  
     my $passfilename="$proname/passwd";  
      
     #   The user's 'personal' loncapa passworrd file describes how to authenticate:  
      
     if (-e $passfilename) {  
  Debug("Located password file: $passfilename");  
   
  my $pf = IO::File->new($passfilename);      # Fetch the user authentication information:
  my $realpasswd=<$pf>;     
  chomp($realpasswd);      my $realpasswd = GetAuthType($udom, $uname);
       if($realpasswd ne "nouser") { # nouser means no passwd file.
  my ($howpwd,$contentpwd)=split(/:/,$realpasswd);   my ($howpwd,$contentpwd)=split(/:/,$realpasswd);
  my $pwdcorrect=0;   my $pwdcorrect=0;
  #   #
Line 658  sub AuthenticateHandler { Line 762  sub AuthenticateHandler {
     } else {      } else {
  $contentpwd=(getpwnam($uname))[1];   $contentpwd=(getpwnam($uname))[1];
  my $pwauth_path="/usr/local/sbin/pwauth";   my $pwauth_path="/usr/local/sbin/pwauth";
  unless ($contentpwd eq 'x') {   unless ($contentpwd eq 'x') { # Not in shadow file.
     $pwdcorrect= (crypt($upass,$contentpwd) eq $contentpwd);      $pwdcorrect= (crypt($upass,$contentpwd) eq $contentpwd);
  } elsif (-e $pwauth_path) {   } elsif (-e $pwauth_path) { # In shadow file so
     open PWAUTH, "|$pwauth_path" or      open PWAUTH, "|$pwauth_path" or # use external program
  die "Cannot invoke authentication";   die "Cannot invoke authentication";
     print PWAUTH "$uname\n$upass\n";      print PWAUTH "$uname\n$upass\n";
     close PWAUTH;      close PWAUTH;
Line 729  sub AuthenticateHandler { Line 833  sub AuthenticateHandler {
  } else {   } else {
     Failure( $client, "non_authorized\n", $userinput);      Failure( $client, "non_authorized\n", $userinput);
  }   }
  #   #  Used to be unknown_user but that allows crackers to 
  #  User bad... note it may be bad security practice to   #  distinguish between bad username and bad password so...
  #  differntiate to the caller a bad user from a bad   #  
  #  passwd... since that supplies covert channel information  
  #  (you have a good user but bad password e.g.) to guessers.  
  #  
     } else {      } else {
  Failure( $client, "unknown_user\n", $userinput);   Failure( $client, "non_authorized\n", $userinput);
     }      }
     return 1;      return 1;
 }  }
Line 781  sub ChangePasswordHandler { Line 882  sub ChangePasswordHandler {
     $upass=&unescape($upass);      $upass=&unescape($upass);
     $npass=&unescape($npass);      $npass=&unescape($npass);
     &Debug("Trying to change password for $uname");      &Debug("Trying to change password for $uname");
     my $proname=propath($udom,$uname);      my $realpasswd  = GetAuthType($udom, $uname);
     my $passfilename="$proname/passwd";      if ($realpasswd ne "nouser") {
     if (-e $passfilename) {  
  my $realpasswd;  
  {   
     my $pf = IO::File->new($passfilename);  
     $realpasswd=<$pf>;   
  }  
  chomp($realpasswd);  
  my ($howpwd,$contentpwd)=split(/:/,$realpasswd);   my ($howpwd,$contentpwd)=split(/:/,$realpasswd);
  if ($howpwd eq 'internal') {   if ($howpwd eq 'internal') {
     &Debug("internal auth");      &Debug("internal auth");
Line 797  sub ChangePasswordHandler { Line 891  sub ChangePasswordHandler {
  my $salt=time;   my $salt=time;
  $salt=substr($salt,6,2);   $salt=substr($salt,6,2);
  my $ncpass=crypt($npass,$salt);   my $ncpass=crypt($npass,$salt);
  {   if(RewritePwFile($udom, $uname, "internal:$ncpass")) {
     my $pf = IO::File->new(">$passfilename");      &logthis("Result of password change for "
     if ($pf) {       ."$uname: pwchange_success");
  print $pf "internal:$ncpass\n";      Reply($client, "ok\n", $userinput);
  &logthis("Result of password change for "   } else {
  ."$uname: pwchange_success");      &logthis("Unable to open $uname passwd "               
  Reply($client, "ok\n", $userinput);       ."to change password");
     } else {      Failure( $client, "non_authorized\n",$userinput);
  &logthis("Unable to open $uname passwd "                  }
  ."to change password");  
  Failure( $client, "non_authorized\n",$userinput);  
     }  
  }               
     } else {      } else {
  Failure($client, "non_authorized\n", $userinput);   Failure($client, "non_authorized\n", $userinput);
     }      }
Line 849  sub ChangePasswordHandler { Line 939  sub ChangePasswordHandler {
  Reply($client, "non_authorized\n", $userinput);   Reply($client, "non_authorized\n", $userinput);
     }      }
  } else {   } else {
       # this just means that the current password mode is not
       # one we know how to change (e.g the kerberos auth modes or
       # locally written auth handler).
       #
     Reply( $client, "auth_mode_error\n", $userinput);      Reply( $client, "auth_mode_error\n", $userinput);
  }     }  
     } else {      } else {
  Reply( $client, "unknown_user\n", $userinput);   #  used to be unknonw user but that gives out too much info..
    #  so make it the same as if the initial passwd was bad.
    #
    Reply( $client, "non_authorized\n", $userinput);
     }      }
     return 1;      return 1;
 }  }
Line 878  sub AddUserHandler { Line 975  sub AddUserHandler {
     my $cmd     = shift;      my $cmd     = shift;
     my $tail    = shift;      my $tail    = shift;
     my $client  = shift;      my $client  = shift;
       
     my $userinput = $cmd.":".$tail;     
   
     my $oldumask=umask(0077);  
     my ($udom,$uname,$umode,$npass)=split(/:/,$tail);      my ($udom,$uname,$umode,$npass)=split(/:/,$tail);
       my $userinput = $cmd.":".$tail; # Reconstruct the full request line.
   
     &Debug("cmd =".$cmd." $udom =".$udom." uname=".$uname);      &Debug("cmd =".$cmd." $udom =".$udom." uname=".$uname);
     chomp($npass);  
     $npass=&unescape($npass);  
     my $proname=propath($udom,$uname);      if($udom eq $currentdomainid) { # Reject new users for other domains...
     my $passfilename="$proname/passwd";  
     &Debug("Password file created will be:".$passfilename);   my $oldumask=umask(0077);
     if (-e $passfilename) {   chomp($npass);
  Failure( $client, "already_exists\n", $userinput);   $npass=&unescape($npass);
     } elsif ($udom ne $currentdomainid) {   my $passfilename  = PasswordPath($udom, $uname);
  Failure($client, "not_right_domain\n", $userinput);   &Debug("Password file created will be:".$passfilename);
     } else {   if (-e $passfilename) {
  my @fpparts=split(/\//,$proname);      Failure( $client, "already_exists\n", $userinput);
  my $fpnow=$fpparts[0].'/'.$fpparts[1].'/'.$fpparts[2];   } else {
  my $fperror='';      my @fpparts=split(/\//,$passfilename);
  for (my $i=3;$i<=$#fpparts;$i++) {      my $fpnow=$fpparts[0].'/'.$fpparts[1].'/'.$fpparts[2];
     $fpnow.='/'.$fpparts[$i];       my $fperror='';
     unless (-e $fpnow) {      for (my $i=3;$i<= ($#fpparts-1);$i++) {
  unless (mkdir($fpnow,0777)) {   $fpnow.='/'.$fpparts[$i]; 
     $fperror="error: ".($!+0)." mkdir failed while attempting "   unless (-e $fpnow) {
  ."makeuser";      unless (mkdir($fpnow,0777)) {
    $fperror="error: ".($!+0)." mkdir failed while attempting "
       ."makeuser";
       }
  }   }
     }      }
       unless ($fperror) {
    my $result=&make_passwd_file($uname, $umode,$npass, $passfilename);
    Reply($client, $result, $userinput);     #BUGBUG - could be fail
       } else {
    Failure($client, "$fperror\n", $userinput);
       }
  }   }
  unless ($fperror) {   umask($oldumask);
     my $result=&make_passwd_file($uname, $umode,$npass, $passfilename);      }  else {
     Reply($client, $result, $userinput);     #BUGBUG - could be fail   Failure($client, "not_right_domain\n",
  } else {   $userinput); # Even if we are multihomed.
     Failure($client, "$fperror\n", $userinput);      
  }  
     }      }
     umask($oldumask);  
     return 1;      return 1;
   
 }  }
Line 949  sub ChangeAuthenticationHandler { Line 1052  sub ChangeAuthenticationHandler {
     my $userinput  = "$cmd:$tail";              # Reconstruct user input.      my $userinput  = "$cmd:$tail";              # Reconstruct user input.
   
     my ($udom,$uname,$umode,$npass)=split(/:/,$tail);      my ($udom,$uname,$umode,$npass)=split(/:/,$tail);
     chomp($npass);  
     &Debug("cmd = ".$cmd." domain= ".$udom."uname =".$uname." umode= ".$umode);      &Debug("cmd = ".$cmd." domain= ".$udom."uname =".$uname." umode= ".$umode);
     $npass=&unescape($npass);  
     my $proname=&propath($udom,$uname);  
     my $passfilename="$proname/passwd";  
     if ($udom ne $currentdomainid) {      if ($udom ne $currentdomainid) {
  Failure( $client, "not_right_domain\n", $client);   Failure( $client, "not_right_domain\n", $client);
     } else {      } else {
  my $result=&make_passwd_file($uname, $umode,$npass,$passfilename);  
  Reply($client, $result, $userinput);   chomp($npass);
   
    $npass=&unescape($npass);
    my $passfilename = PasswordPath($udom, $uname);
    if ($passfilename) { # Not allowed to create a new user!!
       my $result=&make_passwd_file($uname, $umode,$npass,$passfilename);
       Reply($client, $result, $userinput);
    } else {       
       Failure($client, "non_authorized", $userinput); # Fail the user now.
    }
     }      }
     return 1;      return 1;
 }  }
Line 989  sub IsHomeHandler { Line 1097  sub IsHomeHandler {
         
     my ($udom,$uname)=split(/:/,$tail);      my ($udom,$uname)=split(/:/,$tail);
     chomp($uname);      chomp($uname);
     my $proname=propath($udom,$uname);      my $passfile = PasswordPath($udom, $uname);
     if (-e $proname) {      if($passfile) {
  Reply( $client, "found\n", $userinput);   Reply( $client, "found\n", $userinput);
     } else {      } else {
  Failure($client, "not_found\n", $userinput);   Failure($client, "not_found\n", $userinput);
Line 1139  RegisterHandler("fetchuserfile", \&Fetch Line 1247  RegisterHandler("fetchuserfile", \&Fetch
 #  #
 #   Authenticate access to a user file.  Question?   The token for athentication  #   Authenticate access to a user file.  Question?   The token for athentication
 #   is allowed to be sent as cleartext is this really what we want?  This token  #   is allowed to be sent as cleartext is this really what we want?  This token
 #   represents the user's session id.  Once it is forged does this allow too much access??  #   represents the user's session id.  Once it is forged does this allow too much 
   #   access??
 #  #
 # Parameters:  # Parameters:
 #    $cmd      - The command that got us here.  #    $cmd      - The command that got us here.
Line 1149  RegisterHandler("fetchuserfile", \&Fetch Line 1258  RegisterHandler("fetchuserfile", \&Fetch
 #     0        - Requested to exit, caller should shut down.  #     0        - Requested to exit, caller should shut down.
 #     1        - Continue processing.  #     1        - Continue processing.
 sub AuthenticateUserFileAccess {  sub AuthenticateUserFileAccess {
     my $cmd   = shift;      my $cmd       = shift;
     my $tail    = shift;      my $tail      = shift;
     my $client = shift;      my $client    = shift;
     my $userinput = "$cmd:$tail";      my $userinput = "$cmd:$tail";
   
     my ($fname,$session)=split(/:/,$tail);      my ($fname,$session)=split(/:/,$tail);
Line 1273  sub ActivityLogEntryHandler { Line 1382  sub ActivityLogEntryHandler {
  print $hfh "$now:$clientname:$what\n";   print $hfh "$now:$clientname:$what\n";
  Reply( $client, "ok\n", $userinput);    Reply( $client, "ok\n", $userinput); 
     } else {      } else {
  Reply($client, "error: ".($!+0)." IO::File->new Failed "   Failure($client, "error: ".($!+0)." IO::File->new Failed "
       ."while attempting log\n",         ."while attempting log\n", 
       $userinput);        $userinput);
     }      }
Line 1300  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);
     $namespace=~s/\//\_/g;  
     $namespace=~s/\W//g;  
     if ($namespace ne 'roles') {      if ($namespace ne 'roles') {
  chomp($what);   chomp($what);
  my $proname=propath($udom,$uname);   my $hashref = TieUserHash($udom, $uname, $namespace,
  my $now=time;    &GDBM_WRCREAT(),"P",$what);
  unless ($namespace=~/^nohist\_/) {   if($hashref) {
     my $hfh;      my @pairs=split(/\&/,$what);
     if ($hfh=IO::File->new(">>$proname/$namespace.hist")) {   
  print $hfh "P:$now:$what\n";   
     }  
  }  
  my @pairs=split(/\&/,$what);  
  my %hash;  
  if (tie(%hash,'GDBM_File',"$proname/$namespace.db",  
  &GDBM_WRCREAT(),0640)) {  
     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 1334  sub PutUserProfileEntry { Line 1433  sub PutUserProfileEntry {
      "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 1360  sub IncrementUserValueHandler { Line 1459  sub IncrementUserValueHandler {
     my $cmd         = shift;      my $cmd         = shift;
     my $tail        = shift;      my $tail        = shift;
     my $client      = shift;      my $client      = shift;
     my $userinput   = shift;      my $userinput   = "$cmd:$tail";
   
     my ($udom,$uname,$namespace,$what) =split(/:/,$tail);      my ($udom,$uname,$namespace,$what) =split(/:/,$tail);
     $namespace=~s/\//\_/g;  
     $namespace=~s/\W//g;  
     if ($namespace ne 'roles') {      if ($namespace ne 'roles') {
  chomp($what);          chomp($what);
  my $proname=propath($udom,$uname);   my $hashref = TieUserHash($udom, $uname,
  my $now=time;    $namespace, &GDBM_WRCREAT(),
  unless ($namespace=~/^nohist\_/) {    "P",$what);
     my $hfh;   if ($hashref) {
     if ($hfh=IO::File->new(">>$proname/$namespace.hist")) {       my @pairs=split(/\&/,$what);
  print $hfh "P:$now:$what\n";  
     }  
  }  
  my @pairs=split(/\&/,$what);  
  my %hash;  
  if (tie(%hash,'GDBM_File',"$proname/$namespace.db",&GDBM_WRCREAT(),  
  0640)) {  
     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;
  }   }
  $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 ".
  "while attempting put\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 put\n", $userinput);      "while attempting inc\n", $userinput);
  }   }
     } else {      } else {
  Failure($client, "refused\n", $userinput);   Failure($client, "refused\n", $userinput);
     }      }
       
     return 1;      return 1;
 }  }
 RegisterHandler("inc", \&IncrementUserValueHandler, 0, 1, 0);  RegisterHandler("inc", \&IncrementUserValueHandler, 0, 1, 0);
Line 1435  sub RolesPutHandler { Line 1525  sub RolesPutHandler {
    "what = ".$what);     "what = ".$what);
     my $namespace='roles';      my $namespace='roles';
     chomp($what);      chomp($what);
     my $proname=propath($udom,$uname);      my $hashref = TieUserHash($udom, $uname, $namespace,
     my $now=time;        &GDBM_WRCREAT(), "P",
         "$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
     #  is done on close this improves the chances the log will be an un-      #  is done on close this improves the chances the log will be an un-
     #  corrupted ordered thing.      #  corrupted ordered thing.
     {      if ($hashref) {
  my $hfh;   my @pairs=split(/\&/,$what);
  if ($hfh=IO::File->new(">>$proname/$namespace.hist")) {   
     print $hfh "P:$now:$exedom:$exeuser:$what\n";  
  }  
     }  
     my @pairs=split(/\&/,$what);  
     my %hash;  
     if (tie(%hash,'GDBM_File',"$proname/$namespace.db", &GDBM_WRCREAT(),0640)) {  
  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,
                                &GetAuthType( $udom, $uname));         &GetAuthType( $udom, $uname));
             $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 1498  sub RolesDeleteHandler { Line 1582  sub RolesDeleteHandler {
    "what = ".$what);     "what = ".$what);
     my $namespace='roles';      my $namespace='roles';
     chomp($what);      chomp($what);
     my $proname=propath($udom,$uname);      my $hashref = TieUserHash($udom, $uname, $namespace,
     my $now=time;        &GDBM_WRCREAT(), "D",
     #        "$exedom:$exeuser:$what");
     #   Log the attempt. This {}'ing is done to ensure that the      
     #   logfile is flushed and closed as quickly as possible.  Hopefully      if ($hashref) {
     #   this preserves both time ordering and reduces the probability that   my @rolekeys=split(/\&/,$what);
     #   messages will be interleaved.  
     #  
     {  
  my $hfh;  
  if ($hfh=IO::File->new(">>$proname/$namespace.hist")) {   
     print $hfh "D:$now:$exedom:$exeuser:$what\n";  
  }  
     }  
     my @rolekeys=split(/\&/,$what);  
     my %hash;  
     if (tie(%hash,'GDBM_File',"$proname/$namespace.db", &GDBM_WRCREAT(),0640)) {  
  foreach my $key (@rolekeys) {   foreach my $key (@rolekeys) {
     delete $hash{$key};      delete $hashref->{$key};
  }   }
  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 ".
      "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);
     }      }
           
Line 1559  sub GetProfileEntry { Line 1633  sub GetProfileEntry {
     my $userinput= "$cmd:$tail";      my $userinput= "$cmd:$tail";
         
     my ($udom,$uname,$namespace,$what) = split(/:/,$tail);      my ($udom,$uname,$namespace,$what) = split(/:/,$tail);
     $namespace=~s/\//\_/g;  
     $namespace=~s/\W//g;  
     chomp($what);      chomp($what);
     my @queries=split(/\&/,$what);      my $hashref = TieUserHash($udom, $uname, $namespace,
     my $proname=propath($udom,$uname);        &GDBM_READER());
     my $qresult='';      if ($hashref) {
     my %hash;          my @queries=split(/\&/,$what);
     if (tie(%hash,'GDBM_File',"$proname/$namespace.db", &GDBM_READER(),0640)) {          my $qresult='';
   
  for (my $i=0;$i<=$#queries;$i++) {   for (my $i=0;$i<=$#queries;$i++) {
     $qresult.="$hash{$queries[$i]}&";    # Presumably failure gives empty string.      $qresult.="$hashref->{$queries[$i]}&";    # Presumably failure gives empty string.
  }   }
  if (untie(%hash)) {   $qresult=~s/\&$//;              # Remove trailing & from last lookup.
     $qresult=~s/\&$//;              # Remove trailing & from last lookup.   if (untie(%$hashref)) {
     Reply($client, "$qresult\n", $userinput);      Reply($client, "$qresult\n", $userinput);
  } else {   } else {
     Failure($client, "error: ".($!+0)." untie(GDBM) Failed ".      Failure($client, "error: ".($!+0)." untie(GDBM) Failed ".
Line 1615  sub GetProfileEntryEncrypted { Line 1688  sub GetProfileEntryEncrypted {
     my $userinput = "$cmd:$tail";      my $userinput = "$cmd:$tail";
         
     my ($cmd,$udom,$uname,$namespace,$what) = split(/:/,$userinput);      my ($cmd,$udom,$uname,$namespace,$what) = split(/:/,$userinput);
     $namespace=~s/\//\_/g;  
     $namespace=~s/\W//g;  
     chomp($what);      chomp($what);
     my @queries=split(/\&/,$what);      my $hashref = TieUserHash($udom, $uname, $namespace,
     my $proname=propath($udom,$uname);    &GDBM_READER());
     my $qresult='';      if ($hashref) {
     my %hash;          my @queries=split(/\&/,$what);
     if (tie(%hash,'GDBM_File',"$proname/$namespace.db",&GDBM_READER(),0640)) {          my $qresult='';
  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/\&$//;
     if ($cipher) {      if ($cipher) {
  my $cmdlength=length($qresult);   my $cmdlength=length($qresult);
  $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 1672  RegisterHandler("eget", \&GetProfileEncr Line 1744  RegisterHandler("eget", \&GetProfileEncr
 #     0   - Exit server.  #     0   - Exit server.
 #  #
 #  #
 sub DeletProfileEntry {  
   sub DeleteProfileEntry {
     my $cmd      = shift;      my $cmd      = shift;
     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);
     $namespace=~s/\//\_/g;  
     $namespace=~s/\W//g;  
     chomp($what);      chomp($what);
     my $proname=propath($udom,$uname);      my $hashref = TieUserHash($udom, $uname, $namespace,
     my $now=time;    &GDBM_WRCREAT(),
     unless ($namespace=~/^nohist\_/) {    "D",$what);
  my $hfh;      if ($hashref) {
  if ($hfh=IO::File->new(">>$proname/$namespace.hist")) {           my @keys=split(/\&/,$what);
     print $hfh "D:$now:$what\n";   
  }  
     }  
     my @keys=split(/\&/,$what);  
     my %hash;  
     if (tie(%hash,'GDBM_File',"$proname/$namespace.db",&GDBM_WRCREAT(),0640)) {  
  foreach my $key (@keys) {   foreach my $key (@keys) {
     delete($hash{$key});      delete($hashref->{$key});
  }   }
  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 1731  sub GetProfileKeys { Line 1796  sub GetProfileKeys {
     my $userinput = "$cmd:$tail";      my $userinput = "$cmd:$tail";
   
     my ($udom,$uname,$namespace)=split(/:/,$tail);      my ($udom,$uname,$namespace)=split(/:/,$tail);
     $namespace=~s/\//\_/g;  
     $namespace=~s/\W//g;  
     my $proname=propath($udom,$uname);  
     my $qresult='';      my $qresult='';
     my %hash;      my $hashref = TieUserHash($udom, $uname, $namespace,
     if (tie(%hash,'GDBM_File',"$proname/$namespace.db",&GDBM_READER(),0640)) {    &GDBM_READER());
  foreach my $key (keys %hash) {      if ($hashref) {
    foreach my $key (keys %$hashref) {
     $qresult.="$key&";      $qresult.="$key&";
  }   }
  if (untie(%hash)) {   if (untie(%$hashref)) {
     $qresult=~s/\&$//;      $qresult=~s/\&$//;
     Reply($client, "$qresult\n", $userinput);      Reply($client, "$qresult\n", $userinput);
  } else {   } else {
Line 1781  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);
     $namespace=~s/\//\_/g;      my $hashref = TieUserHash($udom, $uname, $namespace,
     $namespace=~s/\W//g;    &GDBM_READER());
     my $qresult='';      if ($hashref) {
     my $proname=propath($udom,$uname);  
     my %hash;  
     if (tie(%hash,'GDBM_File',"$proname/$namespace.db", &GDBM_READER(),0640)) {  
  # Structure of %data:   # Structure of %data:
  # $data{$symb}->{$parameter}=$value;   # $data{$symb}->{$parameter}=$value;
  # $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 %data = ();                     # A hash of anonymous hashes..   my %data = ();                     # A hash of anonymous hashes..
  while (my ($key,$value) = each(%hash)) {   while (my ($key,$value) = each(%$hashref)) {
     my ($v,$symb,$param) = split(/:/,$key);      my ($v,$symb,$param) = split(/:/,$key);
     next if ($v eq 'version' || $symb eq 'keys');      next if ($v eq 'version' || $symb eq 'keys');
     next if (exists($data{$symb}) &&       next if (exists($data{$symb}) && 
Line 1802  sub DumpProfileDatabase { Line 1864  sub DumpProfileDatabase {
     $data{$symb}->{$param}=$value;      $data{$symb}->{$param}=$value;
     $data{$symb}->{'v.'.$param}=$v;      $data{$symb}->{'v.'.$param}=$v;
  }   }
  if (untie(%hash)) {   if (untie(%$hashref)) {
     while (my ($symb,$param_hash) = each(%data)) {      while (my ($symb,$param_hash) = each(%data)) {
  while(my ($param,$value) = each (%$param_hash)){   while(my ($param,$value) = each (%$param_hash)){
     next if ($param =~ /^v\./);       # Ignore versions...      next if ($param =~ /^v\./);       # Ignore versions...
Line 1858  sub DumpWithRegexp { Line 1920  sub DumpWithRegexp {
     my $userinput = "$cmd:$tail";      my $userinput = "$cmd:$tail";
   
     my ($udom,$uname,$namespace,$regexp)=split(/:/,$tail);      my ($udom,$uname,$namespace,$regexp)=split(/:/,$tail);
     $namespace=~s/\//\_/g;  
     $namespace=~s/\W//g;  
     if (defined($regexp)) {      if (defined($regexp)) {
  $regexp=&unescape($regexp);   $regexp=&unescape($regexp);
     } else {      } else {
  $regexp='.';   $regexp='.';
     }      }
     my $qresult='';      my $hashref =TieUserHash($udom, $uname, $namespace,
     my $proname=propath($udom,$uname);   &GDBM_READER());
     my %hash;      if ($hashref) {
     if (tie(%hash,'GDBM_File',"$proname/$namespace.db",          my $qresult='';
     &GDBM_READER(),0640)) {   while (my ($key,$value) = each(%$hashref)) {
  while (my ($key,$value) = each(%hash)) {  
     if ($regexp eq '.') {      if ($regexp eq '.') {
  $qresult.=$key.'='.$value.'&';   $qresult.=$key.'='.$value.'&';
     } else {      } else {
Line 1880  sub DumpWithRegexp { Line 1939  sub DumpWithRegexp {
  }   }
     }      }
  }   }
  if (untie(%hash)) {   if (untie(%$hashref)) {
     chop($qresult);      chop($qresult);
     Reply($client, "$qresult\n", $userinput);      Reply($client, "$qresult\n", $userinput);
  } else {   } else {
Line 1922  sub StoreHandler { Line 1981  sub StoreHandler {
     my $userinput = "$cmd:$tail";      my $userinput = "$cmd:$tail";
   
     my ($udom,$uname,$namespace,$rid,$what) =split(/:/,$tail);      my ($udom,$uname,$namespace,$rid,$what) =split(/:/,$tail);
     $namespace=~s/\//\_/g;  
     $namespace=~s/\W//g;  
     if ($namespace ne 'roles') {      if ($namespace ne 'roles') {
   
  chomp($what);   chomp($what);
  my $proname=propath($udom,$uname);  
  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 $hashref  = TieUserHash($udom, $uname, $namespace,
  if (tie(%hash,'GDBM_File',"$proname/$namespace.db",         &GDBM_WRCREAT(), "P",
  &GDBM_WRCREAT(),0640)) {         "$rid:$what");
     my @previouskeys=split(/&/,$hash{"keys:$rid"});   if ($hashref) {
       my $now = time;
       my @previouskeys=split(/&/,$hashref->{"keys:$rid"});
     my $key;      my $key;
     $hash{"version:$rid"}++;      $hashref->{"version:$rid"}++;
     my $version=$hash{"version:$rid"};      my $version=$hashref->{"version:$rid"};
     my $allkeys='';       my $allkeys=''; 
     foreach my $pair (@pairs) {      foreach my $pair (@pairs) {
  my ($key,$value)=split(/=/,$pair);   my ($key,$value)=split(/=/,$pair);
  $allkeys.=$key.':';   $allkeys.=$key.':';
  $hash{"$version:$rid:$key"}=$value;   $hashref->{"$version:$rid:$key"}=$value;
     }      }
     $hash{"$version:$rid:timestamp"}=$now;      $hashref->{"$version:$rid:timestamp"}=$now;
     $allkeys.='timestamp';      $allkeys.='timestamp';
     $hash{"$version:keys:$rid"}=$allkeys;      $hashref->{"$version:keys:$rid"}=$allkeys;
     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 2028  sub RestoreHandler { Line 2080  sub RestoreHandler {
   
   
 }  }
 RegisterHandler("restor", \&RestoreHandler, 0,1,0);  RegisterHandler("restore", \&RestoreHandler, 0,1,0);
   
 #  #
 #   Add a chat message to to a discussion board.  #   Add a chat message to to a discussion board.
Line 2212  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 2280  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 2297  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 2338  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 2392  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 2417  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 2485  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 2520  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 2532  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 3860  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 4108  sub ManagePermissions { Line 4151  sub ManagePermissions {
  system("$execdir/lchtmldir $userhome $user $authtype");   system("$execdir/lchtmldir $userhome $user $authtype");
     }      }
 }  }
   
   #
   #  Return the full path of a user password file, whether it exists or not.
   # Parameters:
   #   domain     - Domain in which the password file lives.
   #   user       - name of the user.
   # Returns:
   #    Full passwd path:
   #
   sub PasswordPath {
       my $domain = shift;
       my $user   = shift;
   
       my $path   = &propath($domain, $user);
       $path  .= "/passwd";
   
       return $path;
   }
   
   #   Password Filename
   #   Returns the path to a passwd file given domain and user... only if
   #  it exists.
   # Parameters:
   #   domain    - Domain in which to search.
   #   user      - username.
   # Returns:
   #   - If the password file exists returns its path.
   #   - If the password file does not exist, returns undefined.
   #
   sub PasswordFilename {
       my $domain    = shift;
       my $user      = shift;
   
       Debug ("PasswordFilename called: dom = $domain user = $user");
   
       my $path  = PasswordPath($domain, $user);
       Debug("PasswordFilename got path: $path");
       if(-e $path) {
    return $path;
       } else {
    return undef;
       }
   }
   
   #
   #   Rewrite the contents of the user's passwd file.
   #  Parameters:
   #    domain    - domain of the user.
   #    name      - User's name.
   #    contents  - New contents of the file.
   # Returns:
   #   0    - Failed.
   #   1    - Success.
   #
   sub RewritePwFile {
       my $domain   = shift;
       my $user     = shift;
       my $contents = shift;
   
       my $file = PasswordFilename($domain, $user);
       if (defined $file) {
    my $pf = IO::File->new(">$file");
    if($pf) {
       print $pf "$contents\n";
       return 1;
    } else {
       return 0;
    }
       } else {
    return 0;
       }
   
   }
 #  #
 #   GetAuthType - Determines the authorization type of a user in a domain.  #   GetAuthType - Determines the authorization type of a user in a domain.
   
Line 4118  sub GetAuthType { Line 4234  sub GetAuthType {
     my $user   = shift;      my $user   = shift;
   
     Debug("GetAuthType( $domain, $user ) \n");      Debug("GetAuthType( $domain, $user ) \n");
     my $proname    = &propath($domain, $user);       my $passwdfile = PasswordFilename($domain, $user);
     my $passwdfile = "$proname/passwd";      if( defined $passwdfile ) {
     if( -e $passwdfile ) {  
  my $pf = IO::File->new($passwdfile);   my $pf = IO::File->new($passwdfile);
  my $realpassword = <$pf>;   my $realpassword = <$pf>;
  chomp($realpassword);   chomp($realpassword);
  Debug("Password info = $realpassword\n");   Debug("Password info = $realpassword\n");
  my ($authtype, $contentpwd) = split(/:/, $realpassword);   return $realpassword;
  Debug("Authtype = $authtype, content = $contentpwd\n");  
  my $availinfo = '';  
  if($authtype eq 'krb4' or $authtype eq 'krb5') {  
     $availinfo = $contentpwd;  
  }  
   
  return "$authtype:$availinfo";  
     } else {      } else {
  Debug("Returning nouser");   Debug("Returning nouser");
  return "nouser";   return "nouser";
Removed from v.1.178.2.5  
changed lines
  Added in v.1.178.2.11

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