|
version 1.178.2.10, 2004/03/22 09:16:26
|
version 1.178.2.23, 2004/05/07 17:57:18
|
|
Line 237 sub TieUserHash {
|
Line 237 sub TieUserHash {
|
| $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)) { |
if (($namespace =~/^nohist\_/) && (scalar @_ > 0)) { |
| |
my $args = scalar @_; |
| |
Debug(" Opening history: $namespace $args"); |
| 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; |
|
Line 254 sub TieUserHash {
|
Line 256 sub TieUserHash {
|
| # 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; |
| } |
} |
|
Line 739 sub AuthenticateHandler {
|
Line 741 sub AuthenticateHandler {
|
| 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. |
# Bad credentials: Failed to authorize |
| # |
# |
| 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. |
|
| # |
|
| 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 878 sub ChangePasswordHandler {
|
Line 790 sub ChangePasswordHandler {
|
| # npass - New password. |
# npass - New password. |
| |
|
| my ($udom,$uname,$upass,$npass)=split(/:/,$tail); |
my ($udom,$uname,$upass,$npass)=split(/:/,$tail); |
| chomp($npass); |
|
| $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 = ValidateUser($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 945 sub ChangePasswordHandler {
|
Line 839 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 998 sub AddUserHandler {
|
Line 892 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 1097 sub IsHomeHandler {
|
Line 992 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 1135 sub UpdateResourceHandler {
|
Line 1030 sub UpdateResourceHandler {
|
| |
|
| my $userinput = "$cmd:$tail"; |
my $userinput = "$cmd:$tail"; |
| |
|
| my $fname=$tail; |
my $fname= $tail; # This allows interactive testing |
| |
|
| |
|
| my $ownership=ishome($fname); |
my $ownership=ishome($fname); |
| if ($ownership eq 'not_owner') { |
if ($ownership eq 'not_owner') { |
| if (-e $fname) { |
if (-e $fname) { |
|
Line 1245 sub FetchUserFileHandler {
|
Line 1142 sub FetchUserFileHandler {
|
| } |
} |
| RegisterHandler("fetchuserfile", \&FetchUserFileHandler, 0, 1, 0); |
RegisterHandler("fetchuserfile", \&FetchUserFileHandler, 0, 1, 0); |
| # |
# |
| # Authenticate access to a user file. Question? The token for athentication |
# Authenticate access to a user file. |
| # 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?? |
|
| # |
# |
| # Parameters: |
# Parameters: |
| # $cmd - The command that got us here. |
# $cmd - The command that got us here. |
|
Line 1298 sub UnsubscribeHandler {
|
Line 1192 sub UnsubscribeHandler {
|
| my $client = shift; |
my $client = shift; |
| my $userinput= "$cmd:$tail"; |
my $userinput= "$cmd:$tail"; |
| |
|
| my $fname = $tail; |
my ($fname) = $tail; |
| |
|
| |
Debug("Unsubscribing $fname"); |
| if (-e $fname) { |
if (-e $fname) { |
| Reply($client, &unsub($client,$fname,$clientip), $userinput); |
Debug("Exists"); |
| |
Reply($client, &unsub($fname,$clientip), $userinput); |
| } else { |
} else { |
| Failure($client, "not_found\n", $userinput); |
Failure($client, "not_found\n", $userinput); |
| } |
} |
| return 1; |
return 1; |
| } |
} |
| RegisterHandler("unusb", \&UnsubscribeHandler, 0, 1, 0); |
RegisterHandler("unsub", \&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 1520 sub RolesPutHandler {
|
Line 1417 sub RolesPutHandler {
|
| my $client = shift; |
my $client = shift; |
| my $userinput = "$cmd:$tail"; |
my $userinput = "$cmd:$tail"; |
| |
|
| my ($exedom,$exeuser,$udom,$uname,$what) =split(/:/,$tail); |
my ( $exedom, $exeuser, $udom, $uname, $what) = split(/:/,$tail); |
| &Debug("cmd = ".$cmd." exedom= ".$exedom."user = ".$exeuser." udom=".$udom. |
|
| "what = ".$what); |
|
| my $namespace='roles'; |
my $namespace='roles'; |
| chomp($what); |
chomp($what); |
| my $hashref = TieUserHash($udom, $uname, $namespace, |
my $hashref = TieUserHash($udom, $uname, $namespace, |
|
Line 1724 sub GetProfileEntryEncrypted {
|
Line 1621 sub GetProfileEntryEncrypted {
|
| |
|
| return 1; |
return 1; |
| } |
} |
| RegisterHandler("eget", \&GetProfileEncrypted, 0, 1, 0); |
RegisterHandler("eget", \&GetProfileEntryEncrypted, 0, 1, 0); |
| |
|
| # |
# |
| # Deletes a key in a user profile database. |
# Deletes a key in a user profile database. |
|
Line 1955 sub DumpWithRegexp {
|
Line 1852 sub DumpWithRegexp {
|
| } |
} |
| RegisterHandler("dump", \&DumpWithRegexp, 0, 1, 0); |
RegisterHandler("dump", \&DumpWithRegexp, 0, 1, 0); |
| |
|
| # Store an aitem in any database but the roles database. |
# Store a set of key=value pairs associated with a versioned name. |
| # |
# |
| # Parameters: |
# Parameters: |
| # $cmd - Request command keyword. |
# $cmd - Request command keyword. |
|
Line 2021 sub StoreHandler {
|
Line 1918 sub StoreHandler {
|
| } |
} |
| RegisterHandler("store", \&StoreHandler, 0, 1, 0); |
RegisterHandler("store", \&StoreHandler, 0, 1, 0); |
| # |
# |
| # Restore a prior version of a resource. |
# Dump out all versions of a resource that has key=value pairs associated |
| |
# with it for each version. These resources are built up via the store |
| |
# command. |
| # |
# |
| # Parameters: |
# Parameters: |
| # $cmd - Command keyword. |
# $cmd - Command keyword. |
|
Line 2035 RegisterHandler("store", \&StoreHandler,
|
Line 1934 RegisterHandler("store", \&StoreHandler,
|
| # 1 indicating the caller should not yet exit. |
# 1 indicating the caller should not yet exit. |
| # Side-effects: |
# Side-effects: |
| # Writes a reply to the client. |
# Writes a reply to the client. |
| |
# The reply is a string of the following shape: |
| |
# version=current&version:keys=k1:k2...&1:k1=v1&1:k2=v2... |
| |
# Where the 1 above represents version 1. |
| |
# this continues for all pairs of keys in all versions. |
| |
# |
| |
# |
| |
# |
| # |
# |
| sub RestoreHandler { |
sub RestoreHandler { |
| my $cmd = shift; |
my $cmd = shift; |
|
Line 2330 sub DumpCourseIdHandler {
|
Line 2236 sub DumpCourseIdHandler {
|
| } |
} |
| unless (defined($since)) { $since=0; } |
unless (defined($since)) { $since=0; } |
| my $qresult=''; |
my $qresult=''; |
| |
logthis(" Looking for $description since $since"); |
| my $hashref = TieDomainHash($udom, "nohist_courseids", &GDBM_WRCREAT()); |
my $hashref = TieDomainHash($udom, "nohist_courseids", &GDBM_WRCREAT()); |
| if ($hashref) { |
if ($hashref) { |
| while (my ($key,$value) = each(%$hashref)) { |
while (my ($key,$value) = each(%$hashref)) { |
| my ($descr,$lasttime)=split(/\:/,$value); |
my ($descr,$lasttime)=split(/\:/,$value); |
| |
logthis("Got: key = $key descr = $descr time: $lasttime"); |
| if ($lasttime<$since) { |
if ($lasttime<$since) { |
| |
logthis("Skipping .. too early"); |
| next; |
next; |
| } |
} |
| if ($description eq '.') { |
if ($description eq '.') { |
| |
logthis("Adding wildcard match"); |
| $qresult.=$key.'='.$descr.'&'; |
$qresult.=$key.'='.$descr.'&'; |
| } else { |
} else { |
| my $unescapeVal = &unescape($descr); |
my $unescapeVal = &unescape($descr); |
| if (eval('$unescapeVal=~/$description/i')) { |
logthis("Matching with $unescapeVal"); |
| |
if (eval('$unescapeVal=~/\Q$description\E/i')) { |
| |
logthis("Adding on match"); |
| $qresult.="$key=$descr&"; |
$qresult.="$key=$descr&"; |
| } |
} |
| } |
} |
|
Line 2526 sub TmpGetHandler {
|
Line 2437 sub TmpGetHandler {
|
| my $client = shift; |
my $client = shift; |
| my $userinput = "$cmd:$id"; |
my $userinput = "$cmd:$id"; |
| |
|
| chomp($id); |
|
| $id=~s/\W/\_/g; |
$id=~s/\W/\_/g; |
| my $store; |
my $store; |
| my $execdir=$perlvar{'lonDaemons'}; |
my $execdir=$perlvar{'lonDaemons'}; |
|
Line 2600 sub LsHandler {
|
Line 2511 sub LsHandler {
|
| |
|
| my $userinput = "$cmd:$ulsdir"; |
my $userinput = "$cmd:$ulsdir"; |
| |
|
| |
chomp($ulsdir); |
| |
|
| my $ulsout=''; |
my $ulsout=''; |
| my $ulsfn; |
my $ulsfn; |
| |
logthis("ls for '$ulsdir'"); |
| if (-e $ulsdir) { |
if (-e $ulsdir) { |
| |
logthis("ls - directory exists"); |
| if(-d $ulsdir) { |
if(-d $ulsdir) { |
| |
logthis("ls $ulsdir is a file"); |
| if (opendir(LSDIR,$ulsdir)) { |
if (opendir(LSDIR,$ulsdir)) { |
| while ($ulsfn=readdir(LSDIR)) { |
while ($ulsfn=readdir(LSDIR)) { |
| my @ulsstats=stat($ulsdir.'/'.$ulsfn); |
my @ulsstats=stat($ulsdir.'/'.$ulsfn); |
|
Line 2787 sub ProcessRequest {
|
Line 2703 sub ProcessRequest {
|
| # Split off the request keyword from the rest of the stuff. |
# Split off the request keyword from the rest of the stuff. |
| |
|
| my ($command, $tail) = split(/:/, $userinput, 2); |
my ($command, $tail) = split(/:/, $userinput, 2); |
| |
chomp($command); |
| |
chomp($tail); |
| |
$tail =~ s/(\r)//; # This helps people debugging with e.g. telnet. |
| |
|
| Debug("Command received: $command, encoded = $wasenc"); |
Debug("Command received: $command, encoded = $wasenc"); |
| |
|
|
Line 2828 sub ProcessRequest {
|
Line 2747 sub ProcessRequest {
|
| $KeepGoing = &$Handler($command, $tail, $client); |
$KeepGoing = &$Handler($command, $tail, $client); |
| } else { |
} else { |
| Debug("Refusing to dispatch because ok is false"); |
Debug("Refusing to dispatch because ok is false"); |
| Failure($client, "refused", $userinput); |
Failure($client, "refused\n", $userinput); |
| } |
} |
| |
|
| |
|
|
Line 3900 sub subsqlreply {
|
Line 3819 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 3912 sub propath {
|
Line 3834 sub propath {
|
| |
|
| sub ishome { |
sub ishome { |
| my $author=shift; |
my $author=shift; |
| |
Debug("ishome: $author"); |
| $author=~s/\/home\/httpd\/html\/res\/([^\/]*)\/([^\/]*).*/$1\/$2/; |
$author=~s/\/home\/httpd\/html\/res\/([^\/]*)\/([^\/]*).*/$1\/$2/; |
| |
Debug(" after big regsub: $author"); |
| my ($udom,$uname)=split(/\//,$author); |
my ($udom,$uname)=split(/\//,$author); |
| |
Debug(" domain: $udom user: $uname"); |
| my $proname=propath($udom,$uname); |
my $proname=propath($udom,$uname); |
| |
Debug(" path = $proname"); |
| if (-e $proname) { |
if (-e $proname) { |
| return 'owner'; |
return 'owner'; |
| } else { |
} else { |
|
Line 4140 sub ManagePermissions {
|
Line 4066 sub ManagePermissions {
|
| my $authtype= shift; |
my $authtype= shift; |
| |
|
| # See if the request is of the form /$domain/_au |
# See if the request is of the form /$domain/_au |
| &logthis("ruequest is $request"); |
&logthis("request is $request"); |
| if($request =~ /^(\/$domain\/_au)$/) { # It's an author rolesput... |
if($request =~ /^(\/$domain\/_au)$/) { # It's an author rolesput... |
| my $execdir = $perlvar{'lonDaemons'}; |
my $execdir = $perlvar{'lonDaemons'}; |
| my $userhome= "/home/$user" ; |
my $userhome= "/home/$user" ; |
|
Line 4162 sub PasswordPath {
|
Line 4088 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 4181 sub PasswordFilename {
|
Line 4107 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 4242 sub GetAuthType {
|
Line 4170 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 4249 sub addline {
|
Line 4306 sub addline {
|
| my $expr='^'.$hostid.':'.$ip.':'; |
my $expr='^'.$hostid.':'.$ip.':'; |
| $expr =~ s/\./\\\./g; |
$expr =~ s/\./\\\./g; |
| my $sh; |
my $sh; |
| |
Debug("Looking for $expr"); |
| if ($sh=IO::File->new("$fname.subscription")) { |
if ($sh=IO::File->new("$fname.subscription")) { |
| while (my $subline=<$sh>) { |
while (my $subline=<$sh>) { |
| if ($subline !~ /$expr/) {$contents.= $subline;} else {$found=1;} |
Debug("addline: line: $subline"); |
| |
if ($subline !~ /$expr/) { |
| |
$contents.= $subline; |
| |
} else { |
| |
Debug("Found $subline"); |
| |
$found=1; |
| |
} |
| } |
} |
| $sh->close(); |
$sh->close(); |
| } |
} |
| $sh=IO::File->new(">$fname.subscription"); |
$sh=IO::File->new(">$fname.subscription"); |
| if ($contents) { print $sh $contents; } |
if ($contents) { print $sh $contents; } |
| if ($newline) { print $sh $newline; } |
if ($newline) { |
| |
Debug("Appending $newline"); |
| |
print $sh $newline; |
| |
} |
| $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 4286 sub getchat {
|
Line 4355 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 4326 sub chatadd {
|
Line 4397 sub chatadd {
|
| sub unsub { |
sub unsub { |
| my ($fname,$clientip)=@_; |
my ($fname,$clientip)=@_; |
| my $result; |
my $result; |
| |
my $unsubs = 0; # Number of successful unsubscribes: |
| |
|
| |
|
| |
# An old way subscriptions were handled was to have a |
| |
# subscription marker file: |
| |
|
| |
Debug("Attempting unlink of $fname.$clientname"); |
| if (unlink("$fname.$clientname")) { |
if (unlink("$fname.$clientname")) { |
| $result="ok\n"; |
$unsubs++; # Successful unsub via marker file. |
| } else { |
} |
| $result="not_subscribed\n"; |
|
| } |
# The more modern way to do it is to have a subscription list |
| |
# file: |
| |
|
| if (-e "$fname.subscription") { |
if (-e "$fname.subscription") { |
| my $found=&addline($fname,$clientname,$clientip,''); |
my $found=&addline($fname,$clientname,$clientip,''); |
| if ($found) { $result="ok\n"; } |
if ($found) { |
| |
$unsubs++; |
| |
} |
| |
} |
| |
|
| |
# If either or both of these mechanisms succeeded in unsubscribing a |
| |
# resource we can return ok: |
| |
|
| |
if($unsubs) { |
| |
$result = "ok\n"; |
| } else { |
} else { |
| if ($result != "ok\n") { $result="not_subscribed\n"; } |
$result = "not_subscribed\n"; |
| } |
} |
| |
|
| return $result; |
return $result; |
| } |
} |
| |
|
|
Line 4388 sub thisversion {
|
Line 4478 sub thisversion {
|
| |
|
| sub subscribe { |
sub subscribe { |
| my ($userinput,$clientip)=@_; |
my ($userinput,$clientip)=@_; |
| |
chomp($userinput); |
| my $result; |
my $result; |
| my ($cmd,$fname)=split(/:/,$userinput); |
my ($cmd,$fname)=split(/:/,$userinput); |
| my $ownership=&ishome($fname); |
my $ownership=&ishome($fname); |
| |
Debug("subscribe: Owner = $ownership file: '$fname'"); |
| if ($ownership eq 'owner') { |
if ($ownership eq 'owner') { |
| # explitly asking for the current version? |
# explitly asking for the current version? |
| unless (-e $fname) { |
unless (-e $fname) { |
| |
Debug("subscribe - does not exist"); |
| my $currentversion=¤tversion($fname); |
my $currentversion=¤tversion($fname); |
| if (&thisversion($fname)==$currentversion) { |
if (&thisversion($fname)==$currentversion) { |
| if ($fname=~/^(.+)\.\d+\.(\w+(?:\.meta)*)$/) { |
if ($fname=~/^(.+)\.\d+\.(\w+(?:\.meta)*)$/) { |
|
Line 4409 sub subscribe {
|
Line 4502 sub subscribe {
|
| } |
} |
| } |
} |
| if (-e $fname) { |
if (-e $fname) { |
| |
Debug("subscribe - exists"); |
| if (-d $fname) { |
if (-d $fname) { |
| $result="directory\n"; |
$result="directory\n"; |
| } else { |
} else { |
|
Line 4457 sub make_passwd_file {
|
Line 4551 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"; |
&logthis(">>>Attempted add of privileged account blocked<<<"); |
| print $se "$npass\n"; |
return "no_priv_account_error\n"; |
| print $se "$npass\n"; |
} |
| } |
|
| my $useraddok = $?; |
# |
| if($useraddok > 0) { |
my $execpath="$perlvar{'lonDaemons'}/"."lcuseradd"; |
| &logthis("Failed lcuseradd: ".&lcuseraddstrerror($useraddok)); |
|
| } |
&Debug("Executing external: ".$execpath); |
| my $pf = IO::File->new(">$passfilename"); |
&Debug("user = ".$uname.", Password =". $npass); |
| print $pf "unix:\n"; |
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) { |
| |
my $lcstring = lcuseraddstrerror($useraddok); |
| |
&logthis("Failed lcuseradd: $lcstring"); |
| |
return "error: lcuseradd failed: $lcstring\n"; |
| } |
} |
| |
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"); |
|
Line 4487 sub make_passwd_file {
|
Line 4593 sub make_passwd_file {
|
| |
|
| sub sethost { |
sub sethost { |
| my ($remotereq) = @_; |
my ($remotereq) = @_; |
| |
Debug("sethost got $remotereq"); |
| my (undef,$hostid)=split(/:/,$remotereq); |
my (undef,$hostid)=split(/:/,$remotereq); |
| if (!defined($hostid)) { $hostid=$perlvar{'lonHostID'}; } |
if (!defined($hostid)) { $hostid=$perlvar{'lonHostID'}; } |
| |
Debug("sethost attempting to set host $hostid"); |
| if ($hostip{$perlvar{'lonHostID'}} eq $hostip{$hostid}) { |
if ($hostip{$perlvar{'lonHostID'}} eq $hostip{$hostid}) { |
| $currenthostid=$hostid; |
$currenthostid=$hostid; |
| $currentdomainid=$hostdom{$hostid}; |
$currentdomainid=$hostdom{$hostid}; |
![[BACK]](/icons/back.gif){kind=icon}
Return to lond CVS log ![[TXT]](/icons/text.gif){kind=icon}
![[DIR]](/icons/dir.gif){kind=icon}
Up to [LON-CAPA] / loncom