[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.8

version 1.178.2.5, 2004/02/24 16:52:16 version 1.178.2.8, 2004/03/16 10:52:30
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 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 TieResourceHash {
     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 512  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 628  sub AuthenticateHandler { Line 689  sub AuthenticateHandler {
     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 713  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 784  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 833  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 842  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 890  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 926  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 1003  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 1048  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 1198  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 1209  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 1333  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 1302  sub PutUserProfileEntry { Line 1362  sub PutUserProfileEntry {
     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 = TieResourceHash($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")) {    foreach my $pair (@pairs) {
  print $hfh "P:$now:$what\n";       my ($key,$value)=split(/=/,$pair);
     }      $hashref->{$key}=$value;
  }    }
  my @pairs=split(/\&/,$what);    if (untie(%$hashref)) {
  my %hash;       Reply( $client, "ok\n", $userinput);
  if (tie(%hash,'GDBM_File',"$proname/$namespace.db",    } else {
  &GDBM_WRCREAT(),0640)) {       Failure($client, "error: ".($!+0)." untie(GDBM) failed ".
     foreach my $pair (@pairs) {       "while attempting put\n", 
  my ($key,$value)=split(/=/,$pair);       $userinput);
  $hash{$key}=$value;    }
     }         } else {
     if (untie(%hash)) {    Failure( $client, "error: ".($!)." tie(GDBM) Failed ".
  Reply( $client, "ok\n", $userinput);     "while attempting put\n", $userinput);
     } else {         }
  Failure($client, "error: ".($!+0)." untie(GDBM) failed ".       } else {
  "while attempting put\n",           Failure( $client, "refused\n", $userinput);
  $userinput);       }
     }      
  } else {       return 1;
     Failure( $client, "error: ".($!)." tie(GDBM) Failed ".  
      "while attempting put\n", $userinput);  
  }  
     } else {  
  Failure( $client, "refused\n", $userinput);  
     }  
      
     return 1;  
 }  }
 RegisterHandler("put", \&PutUserProfileEntry, 0, 1, 0);  RegisterHandler("put", \&PutUserProfileEntry, 0, 1, 0);
   
Line 1360  sub IncrementUserValueHandler { Line 1410  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 = TieResourceHash($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";     foreach my $pair (@pairs) {
     }       my ($key,$value)=split(/=/,$pair);
  }       # We could check that we have a number...
  my @pairs=split(/\&/,$what);       if (! defined($value) || $value eq '') {
  my %hash;          $value = 1;
  if (tie(%hash,'GDBM_File',"$proname/$namespace.db",&GDBM_WRCREAT(),       }
  0640)) {       $hashref->{$key}+=$value;
     foreach my $pair (@pairs) {     }
  my ($key,$value)=split(/=/,$pair);     if (untie(%$hashref)) {
  # We could check that we have a number...        Reply( $client, "ok\n", $userinput);
  if (! defined($value) || $value eq '') {     } else {
     $value = 1;        Failure($client, "error: ".($!+0)." untie(GDBM) failed ".
  }        "while attempting inc\n", $userinput);
  $hash{$key}+=$value;     }
     }   } else {
     if (untie(%hash)) {     Failure($client, "error: ".($!+0)." tie(GDBM) Failed ".
  Reply( $client, "ok\n", $userinput);     "while attempting inc\n", $userinput);
     } else {   }
  Failure($client, "error: ".($!+0)." untie(GDBM) failed ".        } else {
  "while attempting put\n", $userinput);   Failure($client, "refused\n", $userinput);
     }        }
  } else {      
     Failure($client, "error: ".($!+0)." tie(GDBM) Failed ".  
     "while attempting put\n", $userinput);  
  }  
     } else {  
  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 1476  sub RolesPutHandler {
    "what = ".$what);     "what = ".$what);
     my $namespace='roles';      my $namespace='roles';
     chomp($what);      chomp($what);
     my $proname=propath($udom,$uname);      my $hashref = TieResourceHash($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 1533  sub RolesDeleteHandler {
    "what = ".$what);     "what = ".$what);
     my $namespace='roles';      my $namespace='roles';
     chomp($what);      chomp($what);
     my $proname=propath($udom,$uname);      my $hashref = TieResourceHash($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.         
     #         foreach my $key (@rolekeys) {
     {    delete $hashref->{$key};
  my $hfh;         }
  if ($hfh=IO::File->new(">>$proname/$namespace.hist")) {          if (untie(%$hashref)) {
     print $hfh "D:$now:$exedom:$exeuser:$what\n";    Reply($client, "ok\n", $userinput);
  }  
     }  
     my @rolekeys=split(/\&/,$what);  
     my %hash;  
     if (tie(%hash,'GDBM_File',"$proname/$namespace.db", &GDBM_WRCREAT(),0640)) {  
  foreach my $key (@rolekeys) {  
     delete $hash{$key};  
  }  
  if (untie(%hash)) {  
     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 1559  sub GetProfileEntry { Line 1584  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 = TieResourceHash($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 1639  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 = TieResourceHash($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);
Line 1672  RegisterHandler("eget", \&GetProfileEncr Line 1694  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 = TieResourceHash($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 1746  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 = TieResourceHash($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 1794  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 = TieResourceHash($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 1814  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 1870  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 =TieResourceHash($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 1889  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 1931  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  = TieResourceHash($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 2030  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 4108  sub ManagePermissions { Line 4110  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);
       my $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;
   
       my $path  = PasswordPath($domain, $user);
   
       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 4191  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.8

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