--- loncom/lond 2004/03/08 21:54:05 1.178.2.7 +++ loncom/lond 2004/03/16 10:52:30 1.178.2.8 @@ -2,7 +2,7 @@ # The LearningOnline Network # lond "LON Daemon" Server (port "LOND" 5663) # -# $Id: lond,v 1.178.2.7 2004/03/08 21:54:05 foxr Exp $ +# $Id: lond,v 1.178.2.8 2004/03/16 10:52:30 foxr Exp $ # # Copyright Michigan State University Board of Trustees # @@ -53,7 +53,7 @@ my $DEBUG = 1; # Non zero to ena my $status=''; my $lastlog=''; -my $VERSION='$Revision: 1.178.2.7 $'; #' stupid emacs +my $VERSION='$Revision: 1.178.2.8 $'; #' stupid emacs my $remoteVERSION; my $currenthostid; my $currentdomainid; @@ -161,7 +161,59 @@ sub isManager { sub isClient { 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: @@ -460,7 +512,16 @@ sub UserAuthorizationType { if($result eq "nouser") { Failure( $replyfd, "unknown_user\n", $userinput); } 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; @@ -628,17 +689,11 @@ sub AuthenticateHandler { Debug(" Authenticate domain = $udom, user = $uname, password = $upass"); chomp($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); - my $realpasswd=<$pf>; - chomp($realpasswd); + # Fetch the user authentication information: + + my $realpasswd = GetAuthType($udom, $uname); + if($realpasswd ne "nouser") { # nouser means no passwd file. my ($howpwd,$contentpwd)=split(/:/,$realpasswd); my $pwdcorrect=0; # @@ -658,10 +713,10 @@ sub AuthenticateHandler { } else { $contentpwd=(getpwnam($uname))[1]; 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); - } elsif (-e $pwauth_path) { - open PWAUTH, "|$pwauth_path" or + } elsif (-e $pwauth_path) { # In shadow file so + open PWAUTH, "|$pwauth_path" or # use external program die "Cannot invoke authentication"; print PWAUTH "$uname\n$upass\n"; close PWAUTH; @@ -729,14 +784,11 @@ sub AuthenticateHandler { } else { Failure( $client, "non_authorized\n", $userinput); } - # - # User bad... note it may be bad security practice to - # 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. - # + # Used to be unknown_user but that allows crackers to + # distinguish between bad username and bad password so... + # } else { - Failure( $client, "unknown_user\n", $userinput); + Failure( $client, "non_authorized\n", $userinput); } return 1; } @@ -781,15 +833,8 @@ sub ChangePasswordHandler { $upass=&unescape($upass); $npass=&unescape($npass); &Debug("Trying to change password for $uname"); - my $proname=propath($udom,$uname); - my $passfilename="$proname/passwd"; - if (-e $passfilename) { - my $realpasswd; - { - my $pf = IO::File->new($passfilename); - $realpasswd=<$pf>; - } - chomp($realpasswd); + my $realpasswd = GetAuthType($udom, $uname); + if ($realpasswd ne "nouser") { my ($howpwd,$contentpwd)=split(/:/,$realpasswd); if ($howpwd eq 'internal') { &Debug("internal auth"); @@ -797,19 +842,15 @@ sub ChangePasswordHandler { my $salt=time; $salt=substr($salt,6,2); my $ncpass=crypt($npass,$salt); - { - my $pf = IO::File->new(">$passfilename"); - if ($pf) { - print $pf "internal:$ncpass\n"; - &logthis("Result of password change for " - ."$uname: pwchange_success"); - Reply($client, "ok\n", $userinput); - } else { - &logthis("Unable to open $uname passwd " - ."to change password"); - Failure( $client, "non_authorized\n",$userinput); - } - } + if(RewritePwFile($udom, $uname, "internal:$ncpass")) { + &logthis("Result of password change for " + ."$uname: pwchange_success"); + Reply($client, "ok\n", $userinput); + } else { + &logthis("Unable to open $uname passwd " + ."to change password"); + Failure( $client, "non_authorized\n",$userinput); + } } else { Failure($client, "non_authorized\n", $userinput); } @@ -849,10 +890,17 @@ sub ChangePasswordHandler { Reply($client, "non_authorized\n", $userinput); } } 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); } } 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; } @@ -878,42 +926,48 @@ sub AddUserHandler { my $cmd = shift; my $tail = shift; my $client = shift; - - my $userinput = $cmd.":".$tail; - my $oldumask=umask(0077); my ($udom,$uname,$umode,$npass)=split(/:/,$tail); + my $userinput = $cmd.":".$tail; # Reconstruct the full request line. + &Debug("cmd =".$cmd." $udom =".$udom." uname=".$uname); - chomp($npass); - $npass=&unescape($npass); - my $proname=propath($udom,$uname); - my $passfilename="$proname/passwd"; - &Debug("Password file created will be:".$passfilename); - if (-e $passfilename) { - Failure( $client, "already_exists\n", $userinput); - } elsif ($udom ne $currentdomainid) { - Failure($client, "not_right_domain\n", $userinput); - } else { - my @fpparts=split(/\//,$proname); - my $fpnow=$fpparts[0].'/'.$fpparts[1].'/'.$fpparts[2]; - my $fperror=''; - for (my $i=3;$i<=$#fpparts;$i++) { - $fpnow.='/'.$fpparts[$i]; - unless (-e $fpnow) { - unless (mkdir($fpnow,0777)) { - $fperror="error: ".($!+0)." mkdir failed while attempting " - ."makeuser"; + + + if($udom eq $currentdomainid) { # Reject new users for other domains... + + my $oldumask=umask(0077); + chomp($npass); + $npass=&unescape($npass); + my $passfilename = PasswordPath($udom, $uname); + &Debug("Password file created will be:".$passfilename); + if (-e $passfilename) { + Failure( $client, "already_exists\n", $userinput); + } else { + my @fpparts=split(/\//,$passfilename); + my $fpnow=$fpparts[0].'/'.$fpparts[1].'/'.$fpparts[2]; + my $fperror=''; + for (my $i=3;$i<= ($#fpparts-1);$i++) { + $fpnow.='/'.$fpparts[$i]; + unless (-e $fpnow) { + 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) { - my $result=&make_passwd_file($uname, $umode,$npass, $passfilename); - Reply($client, $result, $userinput); #BUGBUG - could be fail - } else { - Failure($client, "$fperror\n", $userinput); - } + umask($oldumask); + } else { + Failure($client, "not_right_domain\n", + $userinput); # Even if we are multihomed. + } - umask($oldumask); return 1; } @@ -949,16 +1003,21 @@ sub ChangeAuthenticationHandler { my $userinput = "$cmd:$tail"; # Reconstruct user input. my ($udom,$uname,$umode,$npass)=split(/:/,$tail); - chomp($npass); &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) { Failure( $client, "not_right_domain\n", $client); } 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; } @@ -989,8 +1048,8 @@ sub IsHomeHandler { my ($udom,$uname)=split(/:/,$tail); chomp($uname); - my $proname=propath($udom,$uname); - if (-e $proname) { + my $passfile = PasswordPath($udom, $uname); + if($passfile) { Reply( $client, "found\n", $userinput); } else { Failure($client, "not_found\n", $userinput); @@ -1139,7 +1198,8 @@ RegisterHandler("fetchuserfile", \&Fetch # # 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 -# 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: # $cmd - The command that got us here. @@ -1149,9 +1209,9 @@ RegisterHandler("fetchuserfile", \&Fetch # 0 - Requested to exit, caller should shut down. # 1 - Continue processing. sub AuthenticateUserFileAccess { - my $cmd = shift; - my $tail = shift; - my $client = shift; + my $cmd = shift; + my $tail = shift; + my $client = shift; my $userinput = "$cmd:$tail"; my ($fname,$session)=split(/:/,$tail); @@ -1273,7 +1333,7 @@ sub ActivityLogEntryHandler { print $hfh "$now:$clientname:$what\n"; Reply( $client, "ok\n", $userinput); } else { - Reply($client, "error: ".($!+0)." IO::File->new Failed " + Failure($client, "error: ".($!+0)." IO::File->new Failed " ."while attempting log\n", $userinput); } @@ -1302,42 +1362,32 @@ sub PutUserProfileEntry { my $userinput = "$cmd:$tail"; my ($udom,$uname,$namespace,$what) =split(/:/,$tail); - $namespace=~s/\//\_/g; - $namespace=~s/\W//g; if ($namespace ne 'roles') { - 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:$what\n"; - } - } - my @pairs=split(/\&/,$what); - my %hash; - if (tie(%hash,'GDBM_File',"$proname/$namespace.db", - &GDBM_WRCREAT(),0640)) { - foreach my $pair (@pairs) { - my ($key,$value)=split(/=/,$pair); - $hash{$key}=$value; - } - if (untie(%hash)) { - Reply( $client, "ok\n", $userinput); - } else { - Failure($client, "error: ".($!+0)." untie(GDBM) failed ". - "while attempting put\n", - $userinput); - } - } else { - Failure( $client, "error: ".($!)." tie(GDBM) Failed ". - "while attempting put\n", $userinput); - } - } else { - Failure( $client, "refused\n", $userinput); - } - - return 1; + chomp($what); + my $hashref = TieResourceHash($udom, $uname, $namespace, + &GDBM_WRCREAT(),"P",$what); + if($hashref) { + my @pairs=split(/\&/,$what); + foreach my $pair (@pairs) { + my ($key,$value)=split(/=/,$pair); + $hashref->{$key}=$value; + } + if (untie(%$hashref)) { + Reply( $client, "ok\n", $userinput); + } else { + Failure($client, "error: ".($!+0)." untie(GDBM) failed ". + "while attempting put\n", + $userinput); + } + } else { + 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); @@ -1363,44 +1413,35 @@ sub IncrementUserValueHandler { my $userinput = "$cmd:$tail"; my ($udom,$uname,$namespace,$what) =split(/:/,$tail); - $namespace=~s/\//\_/g; - $namespace=~s/\W//g; if ($namespace ne 'roles') { - 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:$what\n"; - } - } - my @pairs=split(/\&/,$what); - my %hash; - if (tie(%hash,'GDBM_File',"$proname/$namespace.db",&GDBM_WRCREAT(), - 0640)) { - foreach my $pair (@pairs) { - my ($key,$value)=split(/=/,$pair); - # We could check that we have a number... - if (! defined($value) || $value eq '') { - $value = 1; - } - $hash{$key}+=$value; - } - if (untie(%hash)) { - Reply( $client, "ok\n", $userinput); - } else { - Failure($client, "error: ".($!+0)." untie(GDBM) failed ". - "while attempting inc\n", $userinput); - } - } else { - Failure($client, "error: ".($!+0)." tie(GDBM) Failed ". - "while attempting inc\n", $userinput); - } - } else { - Failure($client, "refused\n", $userinput); - } - + chomp($what); + my $hashref = TieResourceHash($udom, $uname, + $namespace, &GDBM_WRCREAT(), + "P",$what); + if ($hashref) { + my @pairs=split(/\&/,$what); + foreach my $pair (@pairs) { + my ($key,$value)=split(/=/,$pair); + # We could check that we have a number... + if (! defined($value) || $value eq '') { + $value = 1; + } + $hashref->{$key}+=$value; + } + if (untie(%$hashref)) { + Reply( $client, "ok\n", $userinput); + } else { + Failure($client, "error: ".($!+0)." untie(GDBM) failed ". + "while attempting inc\n", $userinput); + } + } else { + Failure($client, "error: ".($!+0)." tie(GDBM) Failed ". + "while attempting inc\n", $userinput); + } + } else { + Failure($client, "refused\n", $userinput); + } + return 1; } RegisterHandler("inc", \&IncrementUserValueHandler, 0, 1, 0); @@ -1435,29 +1476,23 @@ sub RolesPutHandler { "what = ".$what); my $namespace='roles'; chomp($what); - my $proname=propath($udom,$uname); - my $now=time; + my $hashref = TieResourceHash($udom, $uname, $namespace, + &GDBM_WRCREAT(), "P", + "$exedom:$exeuser:$what"); # # 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 # is done on close this improves the chances the log will be an un- # corrupted ordered thing. - { - my $hfh; - 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)) { + if ($hashref) { + my @pairs=split(/\&/,$what); foreach my $pair (@pairs) { my ($key,$value)=split(/=/,$pair); - &ManagePermissions($key, $udom, $uname, - &GetAuthType( $udom, $uname)); - $hash{$key}=$value; + &ManagePermissions($key, $udom, $uname, + &GetAuthType( $udom, $uname)); + $hashref->{$key}=$value; } - if (untie(%hash)) { + if (untie($hashref)) { Reply($client, "ok\n", $userinput); } else { Failure( $client, "error: ".($!+0)." untie(GDBM) Failed ". @@ -1498,36 +1533,26 @@ sub RolesDeleteHandler { "what = ".$what); my $namespace='roles'; chomp($what); - my $proname=propath($udom,$uname); - my $now=time; - # - # Log the attempt. This {}'ing is done to ensure that the - # logfile is flushed and closed as quickly as possible. Hopefully - # this preserves both time ordering and reduces the probability that - # 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) { - delete $hash{$key}; - } - if (untie(%hash)) { - Reply($client, "ok\n", $userinput); + my $hashref = TieResourceHash($udom, $uname, $namespace, + &GDBM_WRCREAT(), "D", + "$exedom:$exeuser:$what"); + + if ($hashref) { + my @rolekeys=split(/\&/,$what); + + foreach my $key (@rolekeys) { + delete $hashref->{$key}; + } + if (untie(%$hashref)) { + Reply($client, "ok\n", $userinput); } else { - Failure( $client, "error: ".($!+0)." untie(GDBM) Failed ". - "while attempting rolesdel\n", $userinput); + Failure( $client, "error: ".($!+0)." untie(GDBM) Failed ". + "while attempting rolesdel\n", $userinput); } - } else { - Failure( $client, "error: ".($!+0)." tie(GDBM) Failed ". + } else { + Failure( $client, "error: ".($!+0)." tie(GDBM) Failed ". "while attempting rolesdel\n", $userinput); - } + } return 1; } @@ -1559,19 +1584,18 @@ sub GetProfileEntry { my $userinput= "$cmd:$tail"; my ($udom,$uname,$namespace,$what) = split(/:/,$tail); - $namespace=~s/\//\_/g; - $namespace=~s/\W//g; chomp($what); - my @queries=split(/\&/,$what); - my $proname=propath($udom,$uname); - my $qresult=''; - my %hash; - if (tie(%hash,'GDBM_File',"$proname/$namespace.db", &GDBM_READER(),0640)) { + my $hashref = TieResourceHash($udom, $uname, $namespace, + &GDBM_READER()); + if ($hashref) { + my @queries=split(/\&/,$what); + my $qresult=''; + 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); } else { Failure($client, "error: ".($!+0)." untie(GDBM) Failed ". @@ -1615,18 +1639,16 @@ sub GetProfileEntryEncrypted { my $userinput = "$cmd:$tail"; my ($cmd,$udom,$uname,$namespace,$what) = split(/:/,$userinput); - $namespace=~s/\//\_/g; - $namespace=~s/\W//g; chomp($what); - my @queries=split(/\&/,$what); - my $proname=propath($udom,$uname); - my $qresult=''; - my %hash; - if (tie(%hash,'GDBM_File',"$proname/$namespace.db",&GDBM_READER(),0640)) { + my $hashref = TieResourceHash($udom, $uname, $namespace, + &GDBM_READER()); + if ($hashref) { + my @queries=split(/\&/,$what); + my $qresult=''; for (my $i=0;$i<=$#queries;$i++) { - $qresult.="$hash{$queries[$i]}&"; + $qresult.="$hashref->{$queries[$i]}&"; } - if (untie(%hash)) { + if (untie(%$hashref)) { $qresult=~s/\&$//; if ($cipher) { my $cmdlength=length($qresult); @@ -1680,24 +1702,16 @@ sub DeleteProfileEntry { my $userinput = "cmd:$tail"; my ($udom,$uname,$namespace,$what) = split(/:/,$tail); - $namespace=~s/\//\_/g; - $namespace=~s/\W//g; 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 "D:$now:$what\n"; - } - } - my @keys=split(/\&/,$what); - my %hash; - if (tie(%hash,'GDBM_File',"$proname/$namespace.db",&GDBM_WRCREAT(),0640)) { + my $hashref = TieResourceHash($udom, $uname, $namespace, + &GDBM_WRCREAT(), + "D",$what); + if ($hashref) { + my @keys=split(/\&/,$what); foreach my $key (@keys) { - delete($hash{$key}); + delete($hashref->{$key}); } - if (untie(%hash)) { + if (untie(%$hashref)) { Reply($client, "ok\n", $userinput); } else { Failure($client, "error: ".($!+0)." untie(GDBM) Failed ". @@ -1732,16 +1746,14 @@ sub GetProfileKeys { my $userinput = "$cmd:$tail"; my ($udom,$uname,$namespace)=split(/:/,$tail); - $namespace=~s/\//\_/g; - $namespace=~s/\W//g; - my $proname=propath($udom,$uname); my $qresult=''; - my %hash; - if (tie(%hash,'GDBM_File',"$proname/$namespace.db",&GDBM_READER(),0640)) { - foreach my $key (keys %hash) { + my $hashref = TieResourceHash($udom, $uname, $namespace, + &GDBM_READER()); + if ($hashref) { + foreach my $key (keys %$hashref) { $qresult.="$key&"; } - if (untie(%hash)) { + if (untie(%$hashref)) { $qresult=~s/\&$//; Reply($client, "$qresult\n", $userinput); } else { @@ -1782,19 +1794,18 @@ sub DumpProfileDatabase { my $userinput = "$cmd:$tail"; my ($udom,$uname,$namespace) = split(/:/,$tail); - $namespace=~s/\//\_/g; - $namespace=~s/\W//g; - my $qresult=''; - my $proname=propath($udom,$uname); - my %hash; - if (tie(%hash,'GDBM_File',"$proname/$namespace.db", &GDBM_READER(),0640)) { + my $hashref = TieResourceHash($udom, $uname, $namespace, + &GDBM_READER()); + if ($hashref) { # Structure of %data: # $data{$symb}->{$parameter}=$value; # $data{$symb}->{'v.'.$parameter}=$version; # 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.. - while (my ($key,$value) = each(%hash)) { + while (my ($key,$value) = each(%$hashref)) { my ($v,$symb,$param) = split(/:/,$key); next if ($v eq 'version' || $symb eq 'keys'); next if (exists($data{$symb}) && @@ -1803,7 +1814,7 @@ sub DumpProfileDatabase { $data{$symb}->{$param}=$value; $data{$symb}->{'v.'.$param}=$v; } - if (untie(%hash)) { + if (untie(%$hashref)) { while (my ($symb,$param_hash) = each(%data)) { while(my ($param,$value) = each (%$param_hash)){ next if ($param =~ /^v\./); # Ignore versions... @@ -1859,19 +1870,16 @@ sub DumpWithRegexp { my $userinput = "$cmd:$tail"; my ($udom,$uname,$namespace,$regexp)=split(/:/,$tail); - $namespace=~s/\//\_/g; - $namespace=~s/\W//g; if (defined($regexp)) { $regexp=&unescape($regexp); } else { $regexp='.'; } - my $qresult=''; - my $proname=propath($udom,$uname); - my %hash; - if (tie(%hash,'GDBM_File',"$proname/$namespace.db", - &GDBM_READER(),0640)) { - while (my ($key,$value) = each(%hash)) { + my $hashref =TieResourceHash($udom, $uname, $namespace, + &GDBM_READER()); + if ($hashref) { + my $qresult=''; + while (my ($key,$value) = each(%$hashref)) { if ($regexp eq '.') { $qresult.=$key.'='.$value.'&'; } else { @@ -1881,7 +1889,7 @@ sub DumpWithRegexp { } } } - if (untie(%hash)) { + if (untie(%$hashref)) { chop($qresult); Reply($client, "$qresult\n", $userinput); } else { @@ -1923,36 +1931,29 @@ sub StoreHandler { my $userinput = "$cmd:$tail"; my ($udom,$uname,$namespace,$rid,$what) =split(/:/,$tail); - $namespace=~s/\//\_/g; - $namespace=~s/\W//g; if ($namespace ne 'roles') { + 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 %hash; - if (tie(%hash,'GDBM_File',"$proname/$namespace.db", - &GDBM_WRCREAT(),0640)) { - my @previouskeys=split(/&/,$hash{"keys:$rid"}); + my $hashref = TieResourceHash($udom, $uname, $namespace, + &GDBM_WRCREAT(), "P", + "$rid:$what"); + if ($hashref) { + my $now = time; + my @previouskeys=split(/&/,$hashref->{"keys:$rid"}); my $key; - $hash{"version:$rid"}++; - my $version=$hash{"version:$rid"}; + $hashref->{"version:$rid"}++; + my $version=$hashref->{"version:$rid"}; my $allkeys=''; foreach my $pair (@pairs) { my ($key,$value)=split(/=/,$pair); $allkeys.=$key.':'; - $hash{"$version:$rid:$key"}=$value; + $hashref->{"$version:$rid:$key"}=$value; } - $hash{"$version:$rid:timestamp"}=$now; + $hashref->{"$version:$rid:timestamp"}=$now; $allkeys.='timestamp'; - $hash{"$version:keys:$rid"}=$allkeys; - if (untie(%hash)) { + $hashref->{"$version:keys:$rid"}=$allkeys; + if (untie($hashref)) { Reply($client, "ok\n", $userinput); } else { Failure($client, "error: ".($!+0)." untie(GDBM) Failed ". @@ -4109,6 +4110,77 @@ sub ManagePermissions { 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. @@ -4119,21 +4191,13 @@ sub GetAuthType { my $user = shift; Debug("GetAuthType( $domain, $user ) \n"); - my $proname = &propath($domain, $user); - my $passwdfile = "$proname/passwd"; - if( -e $passwdfile ) { + my $passwdfile = PasswordFilename($domain, $user); + if( defined $passwdfile ) { my $pf = IO::File->new($passwdfile); my $realpassword = <$pf>; chomp($realpassword); Debug("Password info = $realpassword\n"); - my ($authtype, $contentpwd) = split(/:/, $realpassword); - Debug("Authtype = $authtype, content = $contentpwd\n"); - my $availinfo = ''; - if($authtype eq 'krb4' or $authtype eq 'krb5') { - $availinfo = $contentpwd; - } - - return "$authtype:$availinfo"; + return $realpassword; } else { Debug("Returning nouser"); return "nouser";