version 1.178.2.8, 2004/03/16 10:52:30
|
version 1.178.2.14, 2004/04/07 09:39:18
|
Line 162 sub isClient {
|
Line 162 sub isClient {
|
return (($ConnectionType eq "client") || ($ConnectionType eq "both")); |
return (($ConnectionType eq "client") || ($ConnectionType eq "both")); |
} |
} |
# |
# |
# Ties a resource file to a hash. If necessary, an appropriate history |
# Ties a domain level resource file to a hash. |
|
# If requested a history entry is created in the associated hist file. |
|
# |
|
# Parameters: |
|
# domain - Name of the domain in which the resource file lives. |
|
# namespace - Name of the hash within that domain. |
|
# how - How to tie the hash (e.g. GDBM_WRCREAT()). |
|
# loghead - Optional parameter, if present a log entry is created |
|
# in the associated history file and this is the first part |
|
# of that entry. |
|
# logtail - Goes along with loghead, The actual logentry is of the |
|
# form $loghead:<timestamp>:logtail. |
|
# Returns: |
|
# Reference to a hash bound to the db file or alternatively undef |
|
# if the tie failed. |
|
# |
|
sub TieDomainHash { |
|
my $domain = shift; |
|
my $namespace = shift; |
|
my $how = shift; |
|
|
|
# Filter out any whitespace in the domain name: |
|
|
|
$domain =~ s/\W//g; |
|
|
|
# We have enough to go on to tie the hash: |
|
|
|
my $UserTopDir = $perlvar{'lonUsersDir'}; |
|
my $DomainDir = $UserTopDir."/$domain"; |
|
my $ResourceFile = $DomainDir."/$namespace.db"; |
|
my %hash; |
|
if(tie(%hash, 'GDBM_File', $ResourceFile, $how, 0640)) { |
|
if (scalar @_) { # Need to log the operation. |
|
my $logFh = IO::File->new(">>$DomainDir/$namespace.hist"); |
|
if($logFh) { |
|
my $TimeStamp = time; |
|
my ($loghead, $logtail) = @_; |
|
print $logFh "$loghead:$TimeStamp:$logtail\n"; |
|
} |
|
} |
|
return \%hash; # Return the tied hash. |
|
} |
|
else { |
|
return undef; # Tie failed. |
|
} |
|
} |
|
|
|
# |
|
# Ties a user's resource file to a hash. |
|
# If necessary, an appropriate history |
# log file entry is made as well. |
# log file entry is made as well. |
# This sub factors out common code from the subs that manipulate |
# This sub factors out common code from the subs that manipulate |
# the various gdbm files that keep keyword value pairs. |
# the various gdbm files that keep keyword value pairs. |
Line 179 sub isClient {
|
Line 228 sub isClient {
|
# hash to which the database is tied. It's up to the caller to untie. |
# hash to which the database is tied. It's up to the caller to untie. |
# undef if the has could not be tied. |
# undef if the has could not be tied. |
# |
# |
sub TieResourceHash { |
sub TieUserHash { |
my $domain = shift; |
my $domain = shift; |
my $user = shift; |
my $user = shift; |
my $namespace = shift; |
my $namespace = shift; |
my $how = shift; |
my $how = shift; |
|
|
$namespace=~s/\//\_/g; # / -> _ |
$namespace=~s/\//\_/g; # / -> _ |
$namespace=~s/\W//g; # whitespace eliminated. |
$namespace=~s/\W//g; # whitespace eliminated. |
my $proname = propath($domain, $user); |
my $proname = propath($domain, $user); |
|
|
# If this is a namespace for which a history is kept, |
# If this is a namespace for which a history is kept, |
# make the history log entry: |
# make the history log entry: |
|
|
|
|
unless ($namespace =~/^nohist\_/ && (scalar @_ > 0)) { |
unless ($namespace =~/^nohist\_/ && (scalar @_ > 0)) { |
my $hfh = IO::File->new(">>$proname/$namespace.hist"); |
my $hfh = IO::File->new(">>$proname/$namespace.hist"); |
if($hfh) { |
if($hfh) { |
my $now = time; |
my $now = time; |
my $loghead = shift; |
my $loghead = shift; |
my $what = shift; |
my $what = shift; |
print $hfh "$loghead:$now:$what\n"; |
print $hfh "$loghead:$now:$what\n"; |
} |
} |
} |
} |
# Tie the database. |
# Tie the database. |
|
|
my %hash; |
my %hash; |
if(tie(%hash, 'GDBM_FILE', "$proname/$namespace.db", |
if(tie(%hash, 'GDBM_File', "$proname/$namespace.db", |
$how, 0640)) { |
$how, 0640)) { |
return \%hash; |
return \%hash; |
} |
} |
else { |
else { |
return undef; |
return undef; |
} |
} |
|
|
} |
} |
|
|
# |
# |
Line 676 sub AuthenticateHandler {
|
Line 725 sub AuthenticateHandler {
|
my $cmd = shift; |
my $cmd = shift; |
my $tail = shift; |
my $tail = shift; |
my $client = shift; |
my $client = shift; |
|
|
# Regenerate the full input line |
# Regenerate the full input line |
|
|
my $userinput = $cmd.":".$tail; |
my $userinput = $cmd.":".$tail; |
|
|
# udom - User's domain. |
# udom - User's domain. |
# uname - Username. |
# uname - Username. |
# upass - User's password. |
# upass - User's password. |
|
|
my ($udom,$uname,$upass)=split(/:/,$tail); |
my ($udom,$uname,$upass)=split(/:/,$tail); |
Debug(" Authenticate domain = $udom, user = $uname, password = $upass"); |
Debug(" Authenticate domain = $udom, user = $uname, password = $upass"); |
chomp($upass); |
chomp($upass); |
$upass=unescape($upass); |
$upass=unescape($upass); |
|
|
# Fetch the user authentication information: |
my $pwdcorrect = ValidateUser($udom, $uname, $upass); |
|
if($pwdcorrect) { |
my $realpasswd = GetAuthType($udom, $uname); |
Reply( $client, "authorized\n", $userinput); |
if($realpasswd ne "nouser") { # nouser means no passwd file. |
|
my ($howpwd,$contentpwd)=split(/:/,$realpasswd); |
|
my $pwdcorrect=0; |
|
# |
|
# Authenticate against password stored in the internal file. |
|
# |
|
Debug("Authenticating via $howpwd"); |
|
if ($howpwd eq 'internal') { |
|
&Debug("Internal auth"); |
|
$pwdcorrect= (crypt($upass,$contentpwd) eq $contentpwd); |
|
# |
|
# Authenticate against the unix password file. |
|
# |
|
} elsif ($howpwd eq 'unix') { |
|
&Debug("Unix auth"); |
|
if((getpwnam($uname))[1] eq "") { #no such user! |
|
$pwdcorrect = 0; |
|
} else { |
|
$contentpwd=(getpwnam($uname))[1]; |
|
my $pwauth_path="/usr/local/sbin/pwauth"; |
|
unless ($contentpwd eq 'x') { # Not in shadow file. |
|
$pwdcorrect= (crypt($upass,$contentpwd) eq $contentpwd); |
|
} 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; |
|
$pwdcorrect=!$?; |
|
} |
|
} |
|
# |
|
# Authenticate against a Kerberos 4 server: |
|
# |
|
} elsif ($howpwd eq 'krb4') { |
|
my $null=pack("C",0); |
|
unless ($upass=~/$null/) { |
|
my $krb4_error = &Authen::Krb4::get_pw_in_tkt($uname, |
|
"", |
|
$contentpwd, |
|
'krbtgt', |
|
$contentpwd, |
|
1, |
|
$upass); |
|
if (!$krb4_error) { |
|
$pwdcorrect = 1; |
|
} else { |
|
$pwdcorrect=0; |
|
# log error if it is not a bad password |
|
if ($krb4_error != 62) { |
|
&logthis('krb4:'.$uname.','.$contentpwd.','. |
|
&Authen::Krb4::get_err_txt($Authen::Krb4::error)); |
|
} |
|
} |
|
} |
|
# |
|
# Authenticate against a Kerberos 5 server: |
|
# |
|
} elsif ($howpwd eq 'krb5') { |
|
my $null=pack("C",0); |
|
unless ($upass=~/$null/) { |
|
my $krbclient=&Authen::Krb5::parse_name($uname.'@'.$contentpwd); |
|
my $krbservice="krbtgt/".$contentpwd."\@".$contentpwd; |
|
my $krbserver=&Authen::Krb5::parse_name($krbservice); |
|
my $credentials=&Authen::Krb5::cc_default(); |
|
$credentials->initialize($krbclient); |
|
my $krbreturn = &Authen::Krb5::get_in_tkt_with_password($krbclient, |
|
$krbserver, |
|
$upass, |
|
$credentials); |
|
$pwdcorrect = ($krbreturn == 1); |
|
} else { |
|
$pwdcorrect=0; |
|
} |
|
# |
|
# Finally, the user may have written in an authentication module. |
|
# in that case, if requested, authenticate against it. |
|
# |
|
} elsif ($howpwd eq 'localauth') { |
|
$pwdcorrect=&localauth::localauth($uname,$upass,$contentpwd); |
|
} |
|
# |
# |
# Successfully authorized. |
# Bad credentials: Failed to authorize |
# |
# |
if ($pwdcorrect) { |
|
Reply( $client, "authorized\n", $userinput); |
|
# |
|
# Bad credentials: Failed to authorize |
|
# |
|
} else { |
|
Failure( $client, "non_authorized\n", $userinput); |
|
} |
|
# Used to be unknown_user but that allows crackers to |
|
# distinguish between bad username and bad password so... |
|
# |
|
} else { |
} else { |
Failure( $client, "non_authorized\n", $userinput); |
Failure( $client, "non_authorized\n", $userinput); |
} |
} |
|
|
return 1; |
return 1; |
} |
} |
RegisterHandler("auth", \&AuthenticateHandler, 1, 1, 0); |
RegisterHandler("auth", \&AuthenticateHandler, 1, 1, 0); |
Line 833 sub ChangePasswordHandler {
|
Line 792 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 $realpasswd = GetAuthType($udom, $uname); |
|
if ($realpasswd ne "nouser") { |
# First require that the user can be authenticated with their |
|
# old password: |
|
|
|
my $validated = ValidUser($udom, $uname, $upass); |
|
if($validated) { |
|
my $realpasswd = GetAuthType($udom, $uname); # Defined since authd. |
|
|
my ($howpwd,$contentpwd)=split(/:/,$realpasswd); |
my ($howpwd,$contentpwd)=split(/:/,$realpasswd); |
if ($howpwd eq 'internal') { |
if ($howpwd eq 'internal') { |
&Debug("internal auth"); |
&Debug("internal auth"); |
if (crypt($upass,$contentpwd) eq $contentpwd) { |
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")) { |
if(RewritePwFile($udom, $uname, "internal:$ncpass")) { |
&logthis("Result of password change for " |
&logthis("Result of password change for " |
."$uname: pwchange_success"); |
."$uname: pwchange_success"); |
Reply($client, "ok\n", $userinput); |
Reply($client, "ok\n", $userinput); |
|
} else { |
|
&logthis("Unable to open $uname passwd " |
|
."to change password"); |
|
Failure( $client, "non_authorized\n",$userinput); |
|
} |
|
} else { |
} else { |
Failure($client, "non_authorized\n", $userinput); |
&logthis("Unable to open $uname passwd " |
|
."to change password"); |
|
Failure( $client, "non_authorized\n",$userinput); |
} |
} |
} elsif ($howpwd eq 'unix') { |
} elsif ($howpwd eq 'unix') { |
# Unix means we have to access /etc/password |
# Unix means we have to access /etc/password |
# one way or another. |
|
# First: Make sure the current password is |
|
# correct |
|
&Debug("auth is unix"); |
&Debug("auth is unix"); |
$contentpwd=(getpwnam($uname))[1]; |
my $execdir=$perlvar{'lonDaemons'}; |
my $pwdcorrect = "0"; |
&Debug("Opening lcpasswd pipeline"); |
my $pwauth_path="/usr/local/sbin/pwauth"; |
my $pf = IO::File->new("|$execdir/lcpasswd > " |
unless ($contentpwd eq 'x') { |
."$perlvar{'lonDaemons'}" |
$pwdcorrect= (crypt($upass,$contentpwd) eq $contentpwd); |
."/logs/lcpasswd.log"); |
} elsif (-e $pwauth_path) { |
print $pf "$uname\n$npass\n$npass\n"; |
open PWAUTH, "|$pwauth_path" or |
close $pf; |
die "Cannot invoke authentication"; |
my $err = $?; |
print PWAUTH "$uname\n$upass\n"; |
my $result = ($err>0 ? 'pwchange_failure' : 'ok'); |
close PWAUTH; |
&logthis("Result of password change for $uname: ". |
&Debug("exited pwauth with $? ($uname,$upass) "); |
&lcpasswdstrerror($?)); |
$pwdcorrect=($? == 0); |
Reply($client, "$result\n", $userinput); |
} |
|
if ($pwdcorrect) { |
|
my $execdir=$perlvar{'lonDaemons'}; |
|
&Debug("Opening lcpasswd pipeline"); |
|
my $pf = IO::File->new("|$execdir/lcpasswd > " |
|
."$perlvar{'lonDaemons'}" |
|
."/logs/lcpasswd.log"); |
|
print $pf "$uname\n$npass\n$npass\n"; |
|
close $pf; |
|
my $err = $?; |
|
my $result = ($err>0 ? 'pwchange_failure' : 'ok'); |
|
&logthis("Result of password change for $uname: ". |
|
&lcpasswdstrerror($?)); |
|
Reply($client, "$result\n", $userinput); |
|
} else { |
|
Reply($client, "non_authorized\n", $userinput); |
|
} |
|
} else { |
} else { |
# this just means that the current password mode is not |
# this just means that the current password mode is not |
# one we know how to change (e.g the kerberos auth modes or |
# one we know how to change (e.g the kerberos auth modes or |
Line 896 sub ChangePasswordHandler {
|
Line 837 sub ChangePasswordHandler {
|
# |
# |
Reply( $client, "auth_mode_error\n", $userinput); |
Reply( $client, "auth_mode_error\n", $userinput); |
} |
} |
} else { |
|
# used to be unknonw user but that gives out too much info.. |
} |
# so make it the same as if the initial passwd was bad. |
else { |
# |
|
Reply( $client, "non_authorized\n", $userinput); |
Reply( $client, "non_authorized\n", $userinput); |
} |
} |
|
|
return 1; |
return 1; |
} |
} |
RegisterHandler("passwd", \&ChangePasswordHandler, 1, 1, 0); |
RegisterHandler("passwd", \&ChangePasswordHandler, 1, 1, 0); |
Line 949 sub AddUserHandler {
|
Line 890 sub AddUserHandler {
|
for (my $i=3;$i<= ($#fpparts-1);$i++) { |
for (my $i=3;$i<= ($#fpparts-1);$i++) { |
$fpnow.='/'.$fpparts[$i]; |
$fpnow.='/'.$fpparts[$i]; |
unless (-e $fpnow) { |
unless (-e $fpnow) { |
|
&logthis("mkdir $fpnow"); |
unless (mkdir($fpnow,0777)) { |
unless (mkdir($fpnow,0777)) { |
$fperror="error: ".($!+0)." mkdir failed while attempting " |
$fperror="error: ".($!+0)." mkdir failed while attempting " |
."makeuser"; |
."makeuser"; |
Line 1048 sub IsHomeHandler {
|
Line 990 sub IsHomeHandler {
|
|
|
my ($udom,$uname)=split(/:/,$tail); |
my ($udom,$uname)=split(/:/,$tail); |
chomp($uname); |
chomp($uname); |
my $passfile = PasswordPath($udom, $uname); |
my $passfile = PasswordFilename($udom, $uname); |
if($passfile) { |
if($passfile) { |
Reply( $client, "found\n", $userinput); |
Reply( $client, "found\n", $userinput); |
} else { |
} else { |
Line 1259 sub UnsubscribeHandler {
|
Line 1201 sub UnsubscribeHandler {
|
} |
} |
RegisterHandler("unusb", \&UnsubscribeHandler, 0, 1, 0); |
RegisterHandler("unusb", \&UnsubscribeHandler, 0, 1, 0); |
|
|
# Subscribe to a resource. |
# Subscribe to a resource |
# |
# |
# Parameters: |
# Parameters: |
# $cmd - The command that got us here. |
# $cmd - The command that got us here. |
Line 1360 sub PutUserProfileEntry {
|
Line 1302 sub PutUserProfileEntry {
|
my $tail = shift; |
my $tail = shift; |
my $client = shift; |
my $client = shift; |
my $userinput = "$cmd:$tail"; |
my $userinput = "$cmd:$tail"; |
|
|
my ($udom,$uname,$namespace,$what) =split(/:/,$tail); |
my ($udom,$uname,$namespace,$what) =split(/:/,$tail); |
if ($namespace ne 'roles') { |
if ($namespace ne 'roles') { |
chomp($what); |
chomp($what); |
my $hashref = TieResourceHash($udom, $uname, $namespace, |
my $hashref = TieUserHash($udom, $uname, $namespace, |
&GDBM_WRCREAT(),"P",$what); |
&GDBM_WRCREAT(),"P",$what); |
if($hashref) { |
if($hashref) { |
my @pairs=split(/\&/,$what); |
my @pairs=split(/\&/,$what); |
foreach my $pair (@pairs) { |
foreach my $pair (@pairs) { |
my ($key,$value)=split(/=/,$pair); |
my ($key,$value)=split(/=/,$pair); |
$hashref->{$key}=$value; |
$hashref->{$key}=$value; |
} |
} |
if (untie(%$hashref)) { |
if (untie(%$hashref)) { |
Reply( $client, "ok\n", $userinput); |
Reply( $client, "ok\n", $userinput); |
} else { |
} else { |
Failure($client, "error: ".($!+0)." untie(GDBM) failed ". |
Failure($client, "error: ".($!+0)." untie(GDBM) failed ". |
"while attempting put\n", |
"while attempting put\n", |
$userinput); |
$userinput); |
} |
} |
} else { |
} else { |
Failure( $client, "error: ".($!)." tie(GDBM) Failed ". |
Failure( $client, "error: ".($!)." tie(GDBM) Failed ". |
"while attempting put\n", $userinput); |
"while attempting put\n", $userinput); |
} |
} |
} else { |
} else { |
Failure( $client, "refused\n", $userinput); |
Failure( $client, "refused\n", $userinput); |
} |
} |
|
|
return 1; |
return 1; |
} |
} |
RegisterHandler("put", \&PutUserProfileEntry, 0, 1, 0); |
RegisterHandler("put", \&PutUserProfileEntry, 0, 1, 0); |
|
|
Line 1415 sub IncrementUserValueHandler {
|
Line 1357 sub IncrementUserValueHandler {
|
my ($udom,$uname,$namespace,$what) =split(/:/,$tail); |
my ($udom,$uname,$namespace,$what) =split(/:/,$tail); |
if ($namespace ne 'roles') { |
if ($namespace ne 'roles') { |
chomp($what); |
chomp($what); |
my $hashref = TieResourceHash($udom, $uname, |
my $hashref = TieUserHash($udom, $uname, |
$namespace, &GDBM_WRCREAT(), |
$namespace, &GDBM_WRCREAT(), |
"P",$what); |
"P",$what); |
if ($hashref) { |
if ($hashref) { |
my @pairs=split(/\&/,$what); |
my @pairs=split(/\&/,$what); |
foreach my $pair (@pairs) { |
foreach my $pair (@pairs) { |
my ($key,$value)=split(/=/,$pair); |
my ($key,$value)=split(/=/,$pair); |
# We could check that we have a number... |
# We could check that we have a number... |
if (! defined($value) || $value eq '') { |
if (! defined($value) || $value eq '') { |
$value = 1; |
$value = 1; |
} |
} |
$hashref->{$key}+=$value; |
$hashref->{$key}+=$value; |
} |
} |
if (untie(%$hashref)) { |
if (untie(%$hashref)) { |
Reply( $client, "ok\n", $userinput); |
Reply( $client, "ok\n", $userinput); |
} else { |
} else { |
Failure($client, "error: ".($!+0)." untie(GDBM) failed ". |
Failure($client, "error: ".($!+0)." untie(GDBM) failed ". |
"while attempting inc\n", $userinput); |
"while attempting inc\n", $userinput); |
} |
} |
} else { |
} else { |
Failure($client, "error: ".($!+0)." tie(GDBM) Failed ". |
Failure($client, "error: ".($!+0)." tie(GDBM) Failed ". |
"while attempting inc\n", $userinput); |
"while attempting inc\n", $userinput); |
} |
} |
} else { |
} else { |
Failure($client, "refused\n", $userinput); |
Failure($client, "refused\n", $userinput); |
} |
} |
|
|
return 1; |
return 1; |
} |
} |
Line 1476 sub RolesPutHandler {
|
Line 1418 sub RolesPutHandler {
|
"what = ".$what); |
"what = ".$what); |
my $namespace='roles'; |
my $namespace='roles'; |
chomp($what); |
chomp($what); |
my $hashref = TieResourceHash($udom, $uname, $namespace, |
my $hashref = TieUserHash($udom, $uname, $namespace, |
&GDBM_WRCREAT(), "P", |
&GDBM_WRCREAT(), "P", |
"$exedom:$exeuser:$what"); |
"$exedom:$exeuser:$what"); |
# |
# |
# Log the attempt to set a role. The {}'s here ensure that the file |
# Log the attempt to set a role. The {}'s here ensure that the file |
# handle is open for the minimal amount of time. Since the flush |
# handle is open for the minimal amount of time. Since the flush |
Line 1533 sub RolesDeleteHandler {
|
Line 1475 sub RolesDeleteHandler {
|
"what = ".$what); |
"what = ".$what); |
my $namespace='roles'; |
my $namespace='roles'; |
chomp($what); |
chomp($what); |
my $hashref = TieResourceHash($udom, $uname, $namespace, |
my $hashref = TieUserHash($udom, $uname, $namespace, |
&GDBM_WRCREAT(), "D", |
&GDBM_WRCREAT(), "D", |
"$exedom:$exeuser:$what"); |
"$exedom:$exeuser:$what"); |
|
|
if ($hashref) { |
if ($hashref) { |
my @rolekeys=split(/\&/,$what); |
my @rolekeys=split(/\&/,$what); |
|
|
foreach my $key (@rolekeys) { |
foreach my $key (@rolekeys) { |
delete $hashref->{$key}; |
delete $hashref->{$key}; |
} |
} |
if (untie(%$hashref)) { |
if (untie(%$hashref)) { |
Reply($client, "ok\n", $userinput); |
Reply($client, "ok\n", $userinput); |
} else { |
} else { |
Failure( $client, "error: ".($!+0)." untie(GDBM) Failed ". |
Failure( $client, "error: ".($!+0)." untie(GDBM) Failed ". |
"while attempting rolesdel\n", $userinput); |
"while attempting rolesdel\n", $userinput); |
} |
} |
} else { |
} else { |
Failure( $client, "error: ".($!+0)." tie(GDBM) Failed ". |
Failure( $client, "error: ".($!+0)." tie(GDBM) Failed ". |
"while attempting rolesdel\n", $userinput); |
"while attempting rolesdel\n", $userinput); |
} |
} |
|
|
return 1; |
return 1; |
} |
} |
Line 1585 sub GetProfileEntry {
|
Line 1527 sub GetProfileEntry {
|
|
|
my ($udom,$uname,$namespace,$what) = split(/:/,$tail); |
my ($udom,$uname,$namespace,$what) = split(/:/,$tail); |
chomp($what); |
chomp($what); |
my $hashref = TieResourceHash($udom, $uname, $namespace, |
my $hashref = TieUserHash($udom, $uname, $namespace, |
&GDBM_READER()); |
&GDBM_READER()); |
if ($hashref) { |
if ($hashref) { |
my @queries=split(/\&/,$what); |
my @queries=split(/\&/,$what); |
my $qresult=''; |
my $qresult=''; |
|
|
for (my $i=0;$i<=$#queries;$i++) { |
for (my $i=0;$i<=$#queries;$i++) { |
$qresult.="$hashref->{$queries[$i]}&"; # Presumably failure gives empty string. |
$qresult.="$hashref->{$queries[$i]}&"; # Presumably failure gives empty string. |
} |
} |
Line 1640 sub GetProfileEntryEncrypted {
|
Line 1582 sub GetProfileEntryEncrypted {
|
|
|
my ($cmd,$udom,$uname,$namespace,$what) = split(/:/,$userinput); |
my ($cmd,$udom,$uname,$namespace,$what) = split(/:/,$userinput); |
chomp($what); |
chomp($what); |
my $hashref = TieResourceHash($udom, $uname, $namespace, |
my $hashref = TieUserHash($udom, $uname, $namespace, |
&GDBM_READER()); |
&GDBM_READER()); |
if ($hashref) { |
if ($hashref) { |
my @queries=split(/\&/,$what); |
my @queries=split(/\&/,$what); |
Line 1655 sub GetProfileEntryEncrypted {
|
Line 1597 sub GetProfileEntryEncrypted {
|
$qresult.=" "; |
$qresult.=" "; |
my $encqresult=''; |
my $encqresult=''; |
for(my $encidx=0;$encidx<=$cmdlength;$encidx+=8) { |
for(my $encidx=0;$encidx<=$cmdlength;$encidx+=8) { |
$encqresult.= unpack("H16", $cipher->encrypt(substr($qresult, |
$encqresult.= unpack("H16", |
$encidx, |
$cipher->encrypt(substr($qresult, |
8))); |
$encidx, |
|
8))); |
} |
} |
Reply( $client, "enc:$cmdlength:$encqresult\n", $userinput); |
Reply( $client, "enc:$cmdlength:$encqresult\n", $userinput); |
} else { |
} else { |
Line 1703 sub DeleteProfileEntry {
|
Line 1646 sub DeleteProfileEntry {
|
|
|
my ($udom,$uname,$namespace,$what) = split(/:/,$tail); |
my ($udom,$uname,$namespace,$what) = split(/:/,$tail); |
chomp($what); |
chomp($what); |
my $hashref = TieResourceHash($udom, $uname, $namespace, |
my $hashref = TieUserHash($udom, $uname, $namespace, |
&GDBM_WRCREAT(), |
&GDBM_WRCREAT(), |
"D",$what); |
"D",$what); |
if ($hashref) { |
if ($hashref) { |
Line 1747 sub GetProfileKeys {
|
Line 1690 sub GetProfileKeys {
|
|
|
my ($udom,$uname,$namespace)=split(/:/,$tail); |
my ($udom,$uname,$namespace)=split(/:/,$tail); |
my $qresult=''; |
my $qresult=''; |
my $hashref = TieResourceHash($udom, $uname, $namespace, |
my $hashref = TieUserHash($udom, $uname, $namespace, |
&GDBM_READER()); |
&GDBM_READER()); |
if ($hashref) { |
if ($hashref) { |
foreach my $key (keys %$hashref) { |
foreach my $key (keys %$hashref) { |
Line 1794 sub DumpProfileDatabase {
|
Line 1737 sub DumpProfileDatabase {
|
my $userinput = "$cmd:$tail"; |
my $userinput = "$cmd:$tail"; |
|
|
my ($udom,$uname,$namespace) = split(/:/,$tail); |
my ($udom,$uname,$namespace) = split(/:/,$tail); |
my $hashref = TieResourceHash($udom, $uname, $namespace, |
my $hashref = TieUserHash($udom, $uname, $namespace, |
&GDBM_READER()); |
&GDBM_READER()); |
if ($hashref) { |
if ($hashref) { |
# Structure of %data: |
# Structure of %data: |
Line 1802 sub DumpProfileDatabase {
|
Line 1745 sub DumpProfileDatabase {
|
# $data{$symb}->{'v.'.$parameter}=$version; |
# $data{$symb}->{'v.'.$parameter}=$version; |
# since $parameter will be unescaped, we do not |
# since $parameter will be unescaped, we do not |
# have to worry about silly parameter names... |
# have to worry about silly parameter names... |
|
|
my $qresult=''; |
my $qresult=''; |
my %data = (); # A hash of anonymous hashes.. |
my %data = (); # A hash of anonymous hashes.. |
while (my ($key,$value) = each(%$hashref)) { |
while (my ($key,$value) = each(%$hashref)) { |
Line 1875 sub DumpWithRegexp {
|
Line 1818 sub DumpWithRegexp {
|
} else { |
} else { |
$regexp='.'; |
$regexp='.'; |
} |
} |
my $hashref =TieResourceHash($udom, $uname, $namespace, |
my $hashref =TieUserHash($udom, $uname, $namespace, |
&GDBM_READER()); |
&GDBM_READER()); |
if ($hashref) { |
if ($hashref) { |
my $qresult=''; |
my $qresult=''; |
Line 1935 sub StoreHandler {
|
Line 1878 sub StoreHandler {
|
|
|
chomp($what); |
chomp($what); |
my @pairs=split(/\&/,$what); |
my @pairs=split(/\&/,$what); |
my $hashref = TieResourceHash($udom, $uname, $namespace, |
my $hashref = TieUserHash($udom, $uname, $namespace, |
&GDBM_WRCREAT(), "P", |
&GDBM_WRCREAT(), "P", |
"$rid:$what"); |
"$rid:$what"); |
if ($hashref) { |
if ($hashref) { |
Line 2214 sub PutCourseIdHandler {
|
Line 2157 sub PutCourseIdHandler {
|
|
|
my $userinput = "$cmd:$tail"; |
my $userinput = "$cmd:$tail"; |
|
|
my ($udom,$what)=split(/:/,$tail); |
my ($udom, $what) = split(/:/, $tail); |
chomp($what); |
chomp($what); |
$udom=~s/\W//g; |
|
my $proname= |
|
"$perlvar{'lonUsersDir'}/$udom/nohist_courseids"; |
|
my $now=time; |
my $now=time; |
my @pairs=split(/\&/,$what); |
my @pairs=split(/\&/,$what); |
my %hash; |
|
if (tie(%hash,'GDBM_File',"$proname.db",&GDBM_WRCREAT(),0640)) { |
my $hashref = TieDomainHash($udom, "nohist_courseids", &GDBM_WRCREAT()); |
|
if ($hashref) { |
foreach my $pair (@pairs) { |
foreach my $pair (@pairs) { |
my ($key,$value)=split(/=/,$pair); |
my ($key,$value)=split(/=/,$pair); |
$hash{$key}=$value.':'.$now; |
$hashref->{$key}=$value.':'.$now; |
} |
} |
if (untie(%hash)) { |
if (untie(%$hashref)) { |
Reply($client, "ok\n", $userinput); |
Reply($client, "ok\n", $userinput); |
} else { |
} else { |
Failure( $client, "error: ".($!+0) |
Failure( $client, "error: ".($!+0) |
Line 2282 sub DumpCourseIdHandler {
|
Line 2223 sub DumpCourseIdHandler {
|
} |
} |
unless (defined($since)) { $since=0; } |
unless (defined($since)) { $since=0; } |
my $qresult=''; |
my $qresult=''; |
my $proname = "$perlvar{'lonUsersDir'}/$udom/nohist_courseids"; |
|
my %hash; |
my $hashref = TieDomainHash($udom, "nohist_courseids", &GDBM_WRCREAT()); |
if (tie(%hash,'GDBM_File',"$proname.db",&GDBM_READER(),0640)) { |
if ($hashref) { |
while (my ($key,$value) = each(%hash)) { |
while (my ($key,$value) = each(%$hashref)) { |
my ($descr,$lasttime)=split(/\:/,$value); |
my ($descr,$lasttime)=split(/\:/,$value); |
if ($lasttime<$since) { |
if ($lasttime<$since) { |
next; |
next; |
Line 2299 sub DumpCourseIdHandler {
|
Line 2240 sub DumpCourseIdHandler {
|
} |
} |
} |
} |
} |
} |
if (untie(%hash)) { |
if (untie(%$hashref)) { |
chop($qresult); |
chop($qresult); |
Reply($client, "$qresult\n", $userinput); |
Reply($client, "$qresult\n", $userinput); |
} else { |
} else { |
Line 2340 sub PutIdHandler {
|
Line 2281 sub PutIdHandler {
|
|
|
my ($udom,$what)=split(/:/,$tail); |
my ($udom,$what)=split(/:/,$tail); |
chomp($what); |
chomp($what); |
$udom=~s/\W//g; |
|
my $proname="$perlvar{'lonUsersDir'}/$udom/ids"; |
|
my $now=time; |
|
{ |
|
my $hfh; |
|
if ($hfh=IO::File->new(">>$proname.hist")) { |
|
print $hfh "P:$now:$what\n"; |
|
} |
|
} |
|
my @pairs=split(/\&/,$what); |
my @pairs=split(/\&/,$what); |
my %hash; |
my $hashref = TieDomainHash($udom, "ids", &GDBM_WRCREAT(), |
if (tie(%hash,'GDBM_File',"$proname.db",&GDBM_WRCREAT(),0640)) { |
"P", $what); |
|
if ($hashref) { |
foreach my $pair (@pairs) { |
foreach my $pair (@pairs) { |
my ($key,$value)=split(/=/,$pair); |
my ($key,$value)=split(/=/,$pair); |
$hash{$key}=$value; |
$hashref->{$key}=$value; |
} |
} |
if (untie(%hash)) { |
if (untie(%$hashref)) { |
Reply($client, "ok\n", $userinput); |
Reply($client, "ok\n", $userinput); |
} else { |
} else { |
Failure($client, "error: ".($!+0)." untie(GDBM) Failed ". |
Failure($client, "error: ".($!+0)." untie(GDBM) Failed ". |
Line 2394 sub GetIdHandler {
|
Line 2327 sub GetIdHandler {
|
my $cmd = shift; |
my $cmd = shift; |
my $tail = shift; |
my $tail = shift; |
my $client = shift; |
my $client = shift; |
|
|
my $userinput = "$client:$tail"; |
my $userinput = "$client:$tail"; |
|
|
my ($udom,$what)=split(/:/,$tail); |
my ($udom,$what)=split(/:/,$tail); |
chomp($what); |
chomp($what); |
$udom=~s/\W//g; |
|
my $proname="$perlvar{'lonUsersDir'}/$udom/ids"; |
|
my @queries=split(/\&/,$what); |
my @queries=split(/\&/,$what); |
my $qresult=''; |
my $qresult=''; |
my %hash; |
my $hashref = TieDomainHash($udom, "ids", &GDBM_READER()); |
if (tie(%hash,'GDBM_File',"$proname.db",&GDBM_READER(),0640)) { |
if ($hashref) { |
for (my $i=0;$i<=$#queries;$i++) { |
for (my $i=0;$i<=$#queries;$i++) { |
$qresult.="$hash{$queries[$i]}&"; |
$qresult.="$hashref->{$queries[$i]}&"; |
} |
} |
if (untie(%hash)) { |
if (untie(%$hashref)) { |
$qresult=~s/\&$//; |
$qresult=~s/\&$//; |
Reply($client, "$qresult\n", $userinput); |
Reply($client, "$qresult\n", $userinput); |
} else { |
} else { |
Line 2419 sub GetIdHandler {
|
Line 2350 sub GetIdHandler {
|
Failure($client, "error: ".($!+0)." tie(GDBM) Failed ". |
Failure($client, "error: ".($!+0)." tie(GDBM) Failed ". |
"while attempting idget\n",$userinput); |
"while attempting idget\n",$userinput); |
} |
} |
|
|
return 1; |
return 1; |
} |
} |
|
|
Line 2487 sub TmpGetHandler {
|
Line 2418 sub TmpGetHandler {
|
my $id = shift; |
my $id = shift; |
my $client = shift; |
my $client = shift; |
my $userinput = "$cmd:$id"; |
my $userinput = "$cmd:$id"; |
|
|
chomp($id); |
chomp($id); |
$id=~s/\W/\_/g; |
$id=~s/\W/\_/g; |
my $store; |
my $store; |
Line 2522 sub TmpDelHandler {
|
Line 2453 sub TmpDelHandler {
|
my $cmd = shift; |
my $cmd = shift; |
my $id = shift; |
my $id = shift; |
my $client = shift; |
my $client = shift; |
|
|
my $userinput= "$cmd:$id"; |
my $userinput= "$cmd:$id"; |
|
|
chomp($id); |
chomp($id); |
$id=~s/\W/\_/g; |
$id=~s/\W/\_/g; |
my $execdir=$perlvar{'lonDaemons'}; |
my $execdir=$perlvar{'lonDaemons'}; |
Line 2534 sub TmpDelHandler {
|
Line 2465 sub TmpDelHandler {
|
Failure( $client, "error: ".($!+0)."Unlink tmp Failed ". |
Failure( $client, "error: ".($!+0)."Unlink tmp Failed ". |
"while attempting tmpdel\n", $userinput); |
"while attempting tmpdel\n", $userinput); |
} |
} |
|
|
return 1; |
return 1; |
|
|
} |
} |
Line 3862 sub subsqlreply {
|
Line 3793 sub subsqlreply {
|
|
|
sub propath { |
sub propath { |
my ($udom,$uname)=@_; |
my ($udom,$uname)=@_; |
|
Debug("Propath:$udom:$uname"); |
$udom=~s/\W//g; |
$udom=~s/\W//g; |
$uname=~s/\W//g; |
$uname=~s/\W//g; |
|
Debug("Propath2:$udom:$uname"); |
my $subdir=$uname.'__'; |
my $subdir=$uname.'__'; |
$subdir =~ s/(.)(.)(.).*/$1\/$2\/$3/; |
$subdir =~ s/(.)(.)(.).*/$1\/$2\/$3/; |
my $proname="$perlvar{'lonUsersDir'}/$udom/$subdir/$uname"; |
my $proname="$perlvar{'lonUsersDir'}/$udom/$subdir/$uname"; |
|
Debug("Propath returning $proname"); |
return $proname; |
return $proname; |
} |
} |
|
|
Line 4124 sub PasswordPath {
|
Line 4058 sub PasswordPath {
|
my $user = shift; |
my $user = shift; |
|
|
my $path = &propath($domain, $user); |
my $path = &propath($domain, $user); |
my $path .= "/passwd"; |
$path .= "/passwd"; |
|
|
return $path; |
return $path; |
} |
} |
Line 4143 sub PasswordFilename {
|
Line 4077 sub PasswordFilename {
|
my $domain = shift; |
my $domain = shift; |
my $user = shift; |
my $user = shift; |
|
|
my $path = PasswordPath($domain, $user); |
Debug ("PasswordFilename called: dom = $domain user = $user"); |
|
|
|
my $path = PasswordPath($domain, $user); |
|
Debug("PasswordFilename got path: $path"); |
if(-e $path) { |
if(-e $path) { |
return $path; |
return $path; |
} else { |
} else { |
Line 4204 sub GetAuthType {
|
Line 4140 sub GetAuthType {
|
} |
} |
} |
} |
|
|
|
# |
|
# Validate a user given their domain, name and password. This utility |
|
# function is used by both AuthenticateHandler and ChangePasswordHandler |
|
# to validate the login credentials of a user. |
|
# Parameters: |
|
# $domain - The domain being logged into (this is required due to |
|
# the capability for multihomed systems. |
|
# $user - The name of the user being validated. |
|
# $password - The user's propoposed password. |
|
# |
|
# Returns: |
|
# 1 - The domain,user,pasword triplet corresponds to a valid |
|
# user. |
|
# 0 - The domain,user,password triplet is not a valid user. |
|
# |
|
sub ValidateUser { |
|
my $domain = shift; |
|
my $user = shift; |
|
my $password= shift; |
|
|
|
# Why negative ~pi you may well ask? Well this function is about |
|
# authentication, and therefore very important to get right. |
|
# I've initialized the flag that determines whether or not I've |
|
# validated correctly to a value it's not supposed to get. |
|
# At the end of this function. I'll ensure that it's not still that |
|
# value so we don't just wind up returning some accidental value |
|
# as a result of executing an unforseen code path that |
|
# did not set $validated. |
|
|
|
my $validated = -3.14159; |
|
|
|
# How we authenticate is determined by the type of authentication |
|
# the user has been assigned. If the authentication type is |
|
# "nouser", the user does not exist so we will return 0. |
|
|
|
my $contents = GetAuthType($domain, $user); |
|
my ($howpwd, $contentpwd) = split(/:/, $contents); |
|
|
|
my $null = pack("C",0); # Used by kerberos auth types. |
|
|
|
if ($howpwd ne 'nouser') { |
|
|
|
if($howpwd eq "internal") { # Encrypted is in local password file. |
|
$validated = (crypt($password, $contentpwd) eq $contentpwd); |
|
} |
|
elsif ($howpwd eq "unix") { # User is a normal unix user. |
|
$contentpwd = (getpwnam($user))[1]; |
|
if($contentpwd) { |
|
if($contentpwd eq 'x') { # Shadow password file... |
|
my $pwauth_path = "/usr/local/sbin/pwauth"; |
|
open PWAUTH, "|$pwauth_path" or |
|
die "Cannot invoke authentication"; |
|
print PWAUTH "$user\n$password\n"; |
|
close PWAUTH; |
|
$validated = ! $?; |
|
|
|
} else { # Passwords in /etc/passwd. |
|
$validated = (crypt($password, |
|
$contentpwd) eq $contentpwd); |
|
} |
|
} else { |
|
$validated = 0; |
|
} |
|
} |
|
elsif ($howpwd eq "krb4") { # user is in kerberos 4 auth. domain. |
|
if(! ($password =~ /$null/) ) { |
|
my $k4error = &Authen::Krb4::get_pw_in_tkt($user, |
|
"", |
|
$contentpwd,, |
|
'krbtgt', |
|
$contentpwd, |
|
1, |
|
$password); |
|
if(!$k4error) { |
|
$validated = 1; |
|
} |
|
else { |
|
$validated = 0; |
|
&logthis('krb4: '.$user.', '.$contentpwd.', '. |
|
&Authen::Krb4::get_err_txt($Authen::Krb4::error)); |
|
} |
|
} |
|
else { |
|
$validated = 0; # Password has a match with null. |
|
} |
|
} |
|
elsif ($howpwd eq "krb5") { # User is in kerberos 5 auth. domain. |
|
if(!($password =~ /$null/)) { # Null password not allowed. |
|
my $krbclient = &Authen::Krb5::parse_name($user.'@' |
|
.$contentpwd); |
|
my $krbservice = "krbtgt/".$contentpwd."\@".$contentpwd; |
|
my $krbserver = &Authen::Krb5::parse_name($krbservice); |
|
my $credentials= &Authen::Krb5::cc_default(); |
|
$credentials->initialize($krbclient); |
|
my $krbreturn = &Authen::KRb5::get_in_tkt_with_password($krbclient, |
|
$krbserver, |
|
$password, |
|
$credentials); |
|
$validated = ($krbreturn == 1); |
|
} |
|
else { |
|
$validated = 0; |
|
} |
|
} |
|
elsif ($howpwd eq "localauth") { |
|
# Authenticate via installation specific authentcation method: |
|
$validated = &localauth::localauth($user, |
|
$password, |
|
$contentpwd); |
|
} |
|
else { # Unrecognized auth is also bad. |
|
$validated = 0; |
|
} |
|
} else { |
|
$validated = 0; |
|
} |
|
# |
|
# $validated has the correct stat of the authentication: |
|
# |
|
|
|
unless ($validated != -3.14159) { |
|
die "ValidateUser - failed to set the value of validated"; |
|
} |
|
return $validated; |
|
} |
|
|
|
# |
|
# Add a line to the subscription list? |
|
# |
sub addline { |
sub addline { |
my ($fname,$hostid,$ip,$newline)=@_; |
my ($fname,$hostid,$ip,$newline)=@_; |
my $contents; |
my $contents; |
Line 4223 sub addline {
|
Line 4288 sub addline {
|
$sh->close(); |
$sh->close(); |
return $found; |
return $found; |
} |
} |
|
# |
|
# Get chat messages. |
|
# |
sub getchat { |
sub getchat { |
my ($cdom,$cname,$udom,$uname)=@_; |
my ($cdom,$cname,$udom,$uname)=@_; |
my %hash; |
my %hash; |
Line 4248 sub getchat {
|
Line 4315 sub getchat {
|
} |
} |
return (@participants,@entries); |
return (@participants,@entries); |
} |
} |
|
# |
|
# Add a chat message |
|
# |
sub chatadd { |
sub chatadd { |
my ($cdom,$cname,$newchat)=@_; |
my ($cdom,$cname,$newchat)=@_; |
my %hash; |
my %hash; |
Line 4419 sub make_passwd_file {
|
Line 4488 sub make_passwd_file {
|
print $pf "localauth:$npass\n"; |
print $pf "localauth:$npass\n"; |
} |
} |
} elsif ($umode eq 'unix') { |
} elsif ($umode eq 'unix') { |
{ |
# |
my $execpath="$perlvar{'lonDaemons'}/"."lcuseradd"; |
# Don't allow the creation of privileged accounts!!! that would |
{ |
# be real bad!!! |
&Debug("Executing external: ".$execpath); |
# |
&Debug("user = ".$uname.", Password =". $npass); |
my $uid = getpwnam($uname); |
my $se = IO::File->new("|$execpath > $perlvar{'lonDaemons'}/logs/lcuseradd.log"); |
if((defined $uid) && ($uid == 0)) { |
print $se "$uname\n"; |
return "no_priv_account_error\n"; |
print $se "$npass\n"; |
|
print $se "$npass\n"; |
|
} |
|
my $useraddok = $?; |
|
if($useraddok > 0) { |
|
&logthis("Failed lcuseradd: ".&lcuseraddstrerror($useraddok)); |
|
} |
|
my $pf = IO::File->new(">$passfilename"); |
|
print $pf "unix:\n"; |
|
} |
} |
|
|
|
# |
|
my $execpath="$perlvar{'lonDaemons'}/"."lcuseradd"; |
|
|
|
&Debug("Executing external: ".$execpath); |
|
&Debug("user = ".$uname.", Password =". $npass); |
|
my $se = IO::File->new("|$execpath > $perlvar{'lonDaemons'}/logs/lcuseradd.log"); |
|
print $se "$uname\n"; |
|
print $se "$npass\n"; |
|
print $se "$npass\n"; |
|
|
|
my $useraddok = $?; |
|
if($useraddok > 0) { |
|
&logthis("Failed lcuseradd: ".&lcuseraddstrerror($useraddok)); |
|
} |
|
my $pf = IO::File->new(">$passfilename"); |
|
print $pf "unix:\n"; |
|
|
} elsif ($umode eq 'none') { |
} elsif ($umode eq 'none') { |
{ |
{ |
my $pf = IO::File->new(">$passfilename"); |
my $pf = IO::File->new(">$passfilename"); |