loncom/lond - diff - 1.178.2.21

Return to lond CVS log

Up to [LON-CAPA] / loncom

Diff for /loncom/lond between versions 1.178.2.8 and 1.178.2.21

version 1.178.2.8, 2004/03/16 10:52:30	version 1.178.2.21, 2004/04/29 10:35:07
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 = 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 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 1086 sub UpdateResourceHandler {	Line 1028 sub UpdateResourceHandler {

my $userinput = "$cmd:$tail";	my $userinput = "$cmd:$tail";

my $fname=$tail;	my $fname=split(/:/,$tail); # This allows interactive testing
	chomp($fname); # with telnet.

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 1196 sub FetchUserFileHandler {	Line 1140 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 1249 sub UnsubscribeHandler {	Line 1190 sub UnsubscribeHandler {
my $client = shift;	my $client = shift;
my $userinput= "$cmd:$tail";	my $userinput= "$cmd:$tail";

my $fname = $tail;	my ($fname) = split(/:/,$tail); # This allows for interactive testing
	# e.g. manual telnet and unsub:res:
	# Otherwise the \r gets in the way.
	chomp($fname);
	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 1360 sub PutUserProfileEntry {	Line 1306 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 1361 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 1471 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 = 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 1479 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 1531 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 1586 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 1601 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 1674 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 1703 sub DeleteProfileEntry {	Line 1650 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 1694 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 1741 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 1749 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 1822 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 1905 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 an aitem in any resource meta data(?) or database with
	# versioning?
#	#
# Parameters:	# Parameters:
# $cmd - Request command keyword.	# $cmd - Request command keyword.
Line 1935 sub StoreHandler {	Line 1883 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 2162 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 2228 sub DumpCourseIdHandler {
}	}
unless (defined($since)) { $since=0; }	unless (defined($since)) { $since=0; }
my $qresult='';	my $qresult='';
my $proname = "$perlvar{'lonUsersDir'}/$udom/nohist_courseids";	logthis(" Looking for $description since $since");
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);
	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);
	logthis("Matching with $unescapeVal");
if (eval('$unescapeVal=~/$description/i')) {	if (eval('$unescapeVal=~/$description/i')) {
	logthis("Adding on match");
$qresult.="$key=$descr&";	$qresult.="$key=$descr&";
}	}
}	}
}	}
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 2291 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 2337 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 2360 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 2428 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 2463 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 2475 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 2562 sub LsHandler {	Line 2503 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 2749 sub ProcessRequest {	Line 2695 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);

Debug("Command received: $command, encoded = $wasenc");	Debug("Command received: $command, encoded = $wasenc");

Line 2790 sub ProcessRequest {	Line 2738 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 3862 sub subsqlreply {	Line 3810 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 3874 sub propath {	Line 3825 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 4102 sub ManagePermissions {	Line 4057 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 4124 sub PasswordPath {	Line 4079 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 4098 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 4161 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 4211 sub addline {	Line 4297 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 4248 sub getchat {	Line 4346 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 4288 sub chatadd {	Line 4388 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 4350 sub thisversion {	Line 4469 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=&currentversion($fname);	my $currentversion=&currentversion($fname);
if (&thisversion($fname)==$currentversion) {	if (&thisversion($fname)==$currentversion) {
if ($fname=~/^(.+)\.\d+\.(\w+(?:\.meta)*)$/) {	if ($fname=~/^(.+)\.\d+\.(\w+(?:\.meta)*)$/) {
Line 4371 sub subscribe {	Line 4493 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 4419 sub make_passwd_file {	Line 4542 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) {
&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) {
	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 4449 sub make_passwd_file {	Line 4584 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};

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

Removed from v.1.178.2.8
changed lines
	Added in v.1.178.2.21