loncom/lond - diff

Return to lond CVS log

Up to [LON-CAPA] / loncom

Diff for /loncom/lond between versions 1.527 and 1.533

version 1.527, 2016/09/20 23:50:09	version 1.533, 2017/03/13 18:30:02
Line 35 use LONCAPA;	Line 35 use LONCAPA;
use LONCAPA::Configuration;	use LONCAPA::Configuration;
use LONCAPA::Lond;	use LONCAPA::Lond;

	use Socket;
use IO::Socket;	use IO::Socket;
use IO::File;	use IO::File;
#use Apache::File;	#use Apache::File;
Line 75 my $clientname; # LonCAPA name of clie	Line 76 my $clientname; # LonCAPA name of clie
my $clientversion; # LonCAPA version running on client.	my $clientversion; # LonCAPA version running on client.
my $clienthomedom; # LonCAPA domain of homeID for client.	my $clienthomedom; # LonCAPA domain of homeID for client.
my $clientintdom; # LonCAPA "internet domain" for client.	my $clientintdom; # LonCAPA "internet domain" for client.
	my $clientsamedom; # LonCAPA domain same for this host
	# and client.
my $clientsameinst; # LonCAPA "internet domain" same for	my $clientsameinst; # LonCAPA "internet domain" same for
# this host and client.	# this host and client.
my $clientremoteok; # Client allowed to host domain's users.	my $clientremoteok; # Client allowed to host domain's users.
Line 102 my %managers; # Ip -> manager names	Line 105 my %managers; # Ip -> manager names

my %perlvar; # Will have the apache conf defined perl vars.	my %perlvar; # Will have the apache conf defined perl vars.

	my %secureconf; # Will have requirements for security
	# of lond connections

my $dist;	my $dist;

#	#
Line 267 my %trust = (	Line 273 my %trust = (
restore => {remote => 1, enroll => 1, reqcrs => 1,},	restore => {remote => 1, enroll => 1, reqcrs => 1,},
rolesdel => {remote => 1, enroll => 1, domroles => 1, coaurem => 1},	rolesdel => {remote => 1, enroll => 1, domroles => 1, coaurem => 1},
rolesput => {remote => 1, enroll => 1, domroles => 1, coaurem => 1},	rolesput => {remote => 1, enroll => 1, domroles => 1, coaurem => 1},
serverdistarch => {manageronly => 1},
servercerts => {institutiononly => 1},	servercerts => {institutiononly => 1},
	serverdistarch => {anywhere => 1},
serverhomeID => {anywhere => 1},	serverhomeID => {anywhere => 1},
serverloncaparev => {anywhere => 1},	serverloncaparev => {anywhere => 1},
servertimezone => {remote => 1, enroll => 1},	servertimezone => {remote => 1, enroll => 1},
Line 445 sub InsecureConnection {	Line 451 sub InsecureConnection {
my $Socket = shift;	my $Socket = shift;

# Don't even start if insecure connections are not allowed.	# Don't even start if insecure connections are not allowed.
	# return 0 if Insecure connections not allowed.
if(! $perlvar{londAllowInsecure}) { # Insecure connections not allowed.	#
	if (ref($secureconf{'connfrom'}) eq 'HASH') {
	if ($clientsamedom) {
	if ($secureconf{'connfrom'}{'dom'} eq 'req') {
	return 0;
	}
	} elsif ($clientsameinst) {
	if ($secureconf{'connfrom'}{'intdom'} eq 'req') {
	return 0;
	}
	} else {
	if ($secureconf{'connfrom'}{'other'} eq 'req') {
	return 0;
	}
	}
	} elsif (!$perlvar{londAllowInsecure}) {
return 0;	return 0;
}	}

Line 1568 sub du2_handler {	Line 1589 sub du2_handler {
# selected directory the filename followed by the full output of	# selected directory the filename followed by the full output of
# the stat function is returned. The returned info for each	# the stat function is returned. The returned info for each
# file are separated by ':'. The stat fields are separated by &'s.	# file are separated by ':'. The stat fields are separated by &'s.
	#
	# If the requested path contains /../ or is:
	#
	# 1. for a directory, and the path does not begin with one of:
	# (a) /home/httpd/html/res/<domain>
	# (b) /home/httpd/html/res/userfiles/
	# (c) /home/httpd/lonUsers/<domain>/<1>/<2>/<3>/<username>/userfiles
	# or is:
	#
	# 2. for a file, and the path (after prepending) does not begin with:
	# /home/httpd/lonUsers/<domain>/<1>/<2>/<3>/<username>/
	#
	# the response will be "refused".
	#
# Parameters:	# Parameters:
# $cmd - The command that dispatched us (ls).	# $cmd - The command that dispatched us (ls).
# $ulsdir - The directory path to list... I'm not sure what this	# $ulsdir - The directory path to list... I'm not sure what this
Line 1589 sub ls_handler {	Line 1624 sub ls_handler {
my $rights;	my $rights;
my $ulsout='';	my $ulsout='';
my $ulsfn;	my $ulsfn;
	if ($ulsdir =~m{/\.\./}) {
	&Failure($client,"refused\n",$userinput);
	return 1;
	}
if (-e $ulsdir) {	if (-e $ulsdir) {
if(-d $ulsdir) {	if(-d $ulsdir) {
	unless (($ulsdir =~ m{/home/httpd/html/(res/$LONCAPA::match_domain\|userfiles/)}) \|\|
	($ulsdir =~ m{/home/httpd/lonUsers/$LONCAPA::match_domain(?:/[\w\-.@]){3}/$LONCAPA::match_username/userfiles/})) {
	&Failure($client,"refused\n",$userinput);
	return 1;
	}
if (opendir(LSDIR,$ulsdir)) {	if (opendir(LSDIR,$ulsdir)) {
while ($ulsfn=readdir(LSDIR)) {	while ($ulsfn=readdir(LSDIR)) {
undef($obs);	undef($obs);
Line 1614 sub ls_handler {	Line 1658 sub ls_handler {
closedir(LSDIR);	closedir(LSDIR);
}	}
} else {	} else {
	unless ($ulsdir =~ m{/home/httpd/lonUsers/$LONCAPA::match_domain(?:/[\w\-.@]){3}/$LONCAPA::match_username/}) {
	&Failure($client,"refused\n",$userinput);
	return 1;
	}
my @ulsstats=stat($ulsdir);	my @ulsstats=stat($ulsdir);
$ulsout.=$ulsfn.'&'.join('&',@ulsstats).':';	$ulsout.=$ulsfn.'&'.join('&',@ulsstats).':';
}	}
Line 1638 sub ls_handler {	Line 1686 sub ls_handler {
# selected directory the filename followed by the full output of	# selected directory the filename followed by the full output of
# the stat function is returned. The returned info for each	# the stat function is returned. The returned info for each
# file are separated by ':'. The stat fields are separated by &'s.	# file are separated by ':'. The stat fields are separated by &'s.
	#
	# If the requested path contains /../ or is:
	#
	# 1. for a directory, and the path does not begin with one of:
	# (a) /home/httpd/html/res/<domain>
	# (b) /home/httpd/html/res/userfiles/
	# (c) /home/httpd/lonUsers/<domain>/<1>/<2>/<3>/<username>/userfiles
	# or is:
	#
	# 2. for a file, and the path (after prepending) does not begin with:
	# /home/httpd/lonUsers/<domain>/<1>/<2>/<3>/<username>/
	#
	# the response will be "refused".
	#
# Parameters:	# Parameters:
# $cmd - The command that dispatched us (ls).	# $cmd - The command that dispatched us (ls).
# $ulsdir - The directory path to list... I'm not sure what this	# $ulsdir - The directory path to list... I'm not sure what this
Line 1658 sub ls2_handler {	Line 1720 sub ls2_handler {
my $rights;	my $rights;
my $ulsout='';	my $ulsout='';
my $ulsfn;	my $ulsfn;
	if ($ulsdir =~m{/\.\./}) {
	&Failure($client,"refused\n",$userinput);
	return 1;
	}
if (-e $ulsdir) {	if (-e $ulsdir) {
if(-d $ulsdir) {	if(-d $ulsdir) {
	unless (($ulsdir =~ m{/home/httpd/html/(res/$LONCAPA::match_domain\|userfiles/)}) \|\|
	($ulsdir =~ m{/home/httpd/lonUsers/$LONCAPA::match_domain(?:/[\w\-.@]){3}/$LONCAPA::match_username/userfiles/})) {
	&Failure($client,"refused\n","$userinput");
	return 1;
	}
if (opendir(LSDIR,$ulsdir)) {	if (opendir(LSDIR,$ulsdir)) {
while ($ulsfn=readdir(LSDIR)) {	while ($ulsfn=readdir(LSDIR)) {
undef($obs);	undef($obs);
Line 1684 sub ls2_handler {	Line 1755 sub ls2_handler {
closedir(LSDIR);	closedir(LSDIR);
}	}
} else {	} else {
	unless ($ulsdir =~ m{/home/httpd/lonUsers/$LONCAPA::match_domain(?:/[\w\-.@]){3}/$LONCAPA::match_username/}) {
	&Failure($client,"refused\n",$userinput);
	return 1;
	}
my @ulsstats=stat($ulsdir);	my @ulsstats=stat($ulsdir);
$ulsout.=$ulsfn.'&'.join('&',@ulsstats).':';	$ulsout.=$ulsfn.'&'.join('&',@ulsstats).':';
}	}
Line 1700 sub ls2_handler {	Line 1775 sub ls2_handler {
# selected directory the filename followed by the full output of	# selected directory the filename followed by the full output of
# the stat function is returned. The returned info for each	# the stat function is returned. The returned info for each
# file are separated by ':'. The stat fields are separated by &'s.	# file are separated by ':'. The stat fields are separated by &'s.
	#
	# If the requested path (after prepending) contains /../ or is:
	#
	# 1. for a directory, and the path does not begin with one of:
	# (a) /home/httpd/html/res/<domain>
	# (b) /home/httpd/html/res/userfiles/
	# (c) /home/httpd/lonUsers/<domain>/<1>/<2>/<3>/<username>/userfiles
	# (d) /home/httpd/html/priv/<domain>/ and client is the homeserver
	#
	# or is:
	#
	# 2. for a file, and the path (after prepending) does not begin with:
	# /home/httpd/lonUsers/<domain>/<1>/<2>/<3>/<username>/
	#
	# the response will be "refused".
	#
# Parameters:	# Parameters:
# $cmd - The command that dispatched us (ls).	# $cmd - The command that dispatched us (ls).
# $tail - The tail of the request that invoked us.	# $tail - The tail of the request that invoked us.
Line 1739 sub ls3_handler {	Line 1830 sub ls3_handler {
}	}

my $dir_root = $perlvar{'lonDocRoot'};	my $dir_root = $perlvar{'lonDocRoot'};
if ($getpropath) {	if (($getpropath) \|\| ($getuserdir)) {
if (($uname =~ /^$LONCAPA::match_name$/) && ($udom =~ /^$LONCAPA::match_domain$/)) {	if (($uname =~ /^$LONCAPA::match_name$/) && ($udom =~ /^$LONCAPA::match_domain$/)) {
$dir_root = &propath($udom,$uname);	$dir_root = &propath($udom,$uname);
$dir_root =~ s/\/$//;	$dir_root =~ s/\/$//;
} else {	} else {
&Failure($client,"refused\n","$cmd:$tail");	&Failure($client,"refused\n",$userinput);
return 1;
}
} elsif ($getuserdir) {
if (($uname =~ /^$LONCAPA::match_name$/) && ($udom =~ /^$LONCAPA::match_domain$/)) {
my $subdir=$uname.'__';
$subdir =~ s/(.)(.)(.).*/$1\/$2\/$3/;
$dir_root = $Apache::lonnet::perlvar{'lonUsersDir'}
."/$udom/$subdir/$uname";
} else {
&Failure($client,"refused\n","$cmd:$tail");
return 1;	return 1;
}	}
} elsif ($alternate_root ne '') {	} elsif ($alternate_root ne '') {
Line 1767 sub ls3_handler {	Line 1848 sub ls3_handler {
$ulsdir = $dir_root.'/'.$ulsdir;	$ulsdir = $dir_root.'/'.$ulsdir;
}	}
}	}
	if ($ulsdir =~m{/\.\./}) {
	&Failure($client,"refused\n",$userinput);
	return 1;
	}
	my $islocal;
	my @machine_ids = &Apache::lonnet::current_machine_ids();
	if (grep(/^\Q$clientname\E$/,@machine_ids)) {
	$islocal = 1;
	}
my $obs;	my $obs;
my $rights;	my $rights;
my $ulsout='';	my $ulsout='';
my $ulsfn;	my $ulsfn;
if (-e $ulsdir) {	if (-e $ulsdir) {
if(-d $ulsdir) {	if(-d $ulsdir) {
	unless (($getpropath) \|\| ($getuserdir) \|\|
	($ulsdir =~ m{/home/httpd/html/(res/$LONCAPA::match_domain\|userfiles/)}) \|\|
	($ulsdir =~ m{/home/httpd/lonUsers/$LONCAPA::match_domain(?:/[\w\-.@]){3}/$LONCAPA::match_username/userfiles/}) \|\|
	(($ulsdir =~ m{/home/httpd/html/priv/$LONCAPA::match_domain/}) && ($islocal))) {
	&Failure($client,"refused\n",$userinput);
	return 1;
	}
if (opendir(LSDIR,$ulsdir)) {	if (opendir(LSDIR,$ulsdir)) {
while ($ulsfn=readdir(LSDIR)) {	while ($ulsfn=readdir(LSDIR)) {
undef($obs);	undef($obs);
Line 1797 sub ls3_handler {	Line 1894 sub ls3_handler {
closedir(LSDIR);	closedir(LSDIR);
}	}
} else {	} else {
	unless (($getpropath) \|\| ($getuserdir) \|\|
	($ulsdir =~ m{/home/httpd/lonUsers/$LONCAPA::match_domain(?:/[\w\-.@]){3}/$LONCAPA::match_username/})) {
	&Failure($client,"refused\n",$userinput);
	return 1;
	}
my @ulsstats=stat($ulsdir);	my @ulsstats=stat($ulsdir);
$ulsout.=$ulsfn.'&'.join('&',@ulsstats).':';	$ulsout.=$ulsfn.'&'.join('&',@ulsstats).':';
}	}
Line 1820 sub read_lonnet_global {	Line 1922 sub read_lonnet_global {
);	);
my %limit_to = (	my %limit_to = (
perlvar => {	perlvar => {
lonOtherAuthen => 1,	lonOtherAuthen => 1,
lonBalancer => 1,	lonBalancer => 1,
lonVersion => 1,	lonVersion => 1,
lonSysEMail => 1,	lonAdmEMail => 1,
lonHostID => 1,	lonSupportEMail => 1,
lonRole => 1,	lonSysEMail => 1,
lonDefDomain => 1,	lonHostID => 1,
lonLoadLim => 1,	lonRole => 1,
lonUserLoadLim => 1,	lonDefDomain => 1,
	lonLoadLim => 1,
	lonUserLoadLim => 1,
}	}
);	);
if (ref($requested) eq 'HASH') {	if (ref($requested) eq 'HASH') {
Line 2219 sub hash_passwd {	Line 2323 sub hash_passwd {
my $plainsalt = substr($rest[1],0,22);	my $plainsalt = substr($rest[1],0,22);
$salt = Crypt::Eksblowfish::Bcrypt::de_base64($plainsalt);	$salt = Crypt::Eksblowfish::Bcrypt::de_base64($plainsalt);
} else {	} else {
my $defaultcost;	my %domdefaults = &Apache::lonnet::get_domain_defaults($domain);
my %domconfig =	my $defaultcost = $domdefaults{'intauth_cost'};
&Apache::lonnet::get_dom('configuration',['password'],$domain);
if (ref($domconfig{'password'}) eq 'HASH') {
$defaultcost = $domconfig{'password'}{'cost'};
}
if (($defaultcost eq '') \|\| ($defaultcost =~ /D/)) {	if (($defaultcost eq '') \|\| ($defaultcost =~ /D/)) {
$cost = 10;	$cost = 10;
} else {	} else {
Line 6720 sub UpdateHosts {	Line 6820 sub UpdateHosts {
# will take care of new and changed hosts as connections come into being.	# will take care of new and changed hosts as connections come into being.

&Apache::lonnet::reset_hosts_info();	&Apache::lonnet::reset_hosts_info();
	my %active;

foreach my $child (keys(%children)) {	foreach my $child (keys(%children)) {
my $childip = $children{$child};	my $childip = $children{$child};
Line 6729 sub UpdateHosts {	Line 6830 sub UpdateHosts {
." $child for ip $childip </font>");	." $child for ip $childip </font>");
kill('INT', $child);	kill('INT', $child);
} else {	} else {
	$active{$child} = $childip;
logthis('<font color="green"> keeping child for ip '	logthis('<font color="green"> keeping child for ip '
." $childip (pid=$child) </font>");	." $childip (pid=$child) </font>");
}	}
}	}

	my %oldconf = %secureconf;
	my %connchange;
	if (lonssl::Read_Connect_Config(\%secureconf,\%perlvar) eq 'ok') {
	logthis('<font color="blue"> Reloaded SSL connection rules </font>');
	} else {
	logthis('<font color="yellow"> Failed to reload SSL connection rules </font>');
	}
	if ((ref($oldconf{'connfrom'}) eq 'HASH') && (ref($secureconf{'connfrom'}) eq 'HASH')) {
	foreach my $type ('dom','intdom','other') {
	if ((($oldconf{'connfrom'}{$type} eq 'no') && ($secureconf{'connfrom'}{$type} eq 'req')) \|\|
	(($oldconf{'connfrom'}{$type} eq 'req') && ($secureconf{'connfrom'}{$type} eq 'no'))) {
	$connchange{$type} = 1;
	}
	}
	}
	if (keys(%connchange)) {
	foreach my $child (keys(%active)) {
	my $childip = $active{$child};
	if ($childip ne '127.0.0.1') {
	my $childhostname = gethostbyaddr(Socket::inet_aton($childip),AF_INET);
	if ($childhostname ne '') {
	my $childlonhost = &Apache::lonnet::get_server_homeID($childhostname);
	my ($samedom,$sameinst) = &set_client_info($childlonhost);
	if ($samedom) {
	if ($connchange{'dom'}) {
	logthis('<font color="blue"> UpdateHosts killing child '
	." $child for ip $childip </font>");
	kill('INT', $child);
	}
	} elsif ($sameinst) {
	if ($connchange{'intdom'}) {
	logthis('<font color="blue"> UpdateHosts killing child '
	." $child for ip $childip </font>");
	kill('INT', $child);
	}
	} else {
	if ($connchange{'other'}) {
	logthis('<font color="blue"> UpdateHosts killing child '
	." $child for ip $childip </font>");
	kill('INT', $child);
	}
	}
	}
	}
	}
	}
ReloadApache;	ReloadApache;
&status("Finished reloading hosts.tab");	&status("Finished reloading hosts.tab");
}	}


sub checkchildren {	sub checkchildren {
&status("Checking on the children (sending signals)");	&status("Checking on the children (sending signals)");
&initnewstatus();	&initnewstatus();
Line 6972 if ($arch eq 'unknown') {	Line 7120 if ($arch eq 'unknown') {
chomp($arch);	chomp($arch);
}	}

	unless (lonssl::Read_Connect_Config(\%secureconf,\%perlvar) eq 'ok') {
	&logthis('<font color="blue">No connectionrules table. Will fallback to loncapa.conf</font>');
	}

# --------------------------------------------------------------	# --------------------------------------------------------------
# Accept connections. When a connection comes in, it is validated	# Accept connections. When a connection comes in, it is validated
# and if good, a child process is created to process transactions	# and if good, a child process is created to process transactions
Line 7102 sub make_new_child {	Line 7254 sub make_new_child {
$ConnectionType = "manager";	$ConnectionType = "manager";
$clientname = $managers{$outsideip};	$clientname = $managers{$outsideip};
}	}
my $clientok;	my ($clientok,$clientinfoset);

if ($clientrec \|\| $ismanager) {	if ($clientrec \|\| $ismanager) {
&status("Waiting for init from $clientip $clientname");	&status("Waiting for init from $clientip $clientname");
Line 7130 sub make_new_child {	Line 7282 sub make_new_child {
# If the connection type is ssl, but I didn't get my	# If the connection type is ssl, but I didn't get my
# certificate files yet, then I'll drop back to	# certificate files yet, then I'll drop back to
# insecure (if allowed).	# insecure (if allowed).

	if ($inittype eq "ssl") {
	my $context;
	if ($clientsamedom) {
	$context = 'dom';
	if ($secureconf{'connfrom'}{'dom'} eq 'no') {
	$inittype = "";
	}
	} elsif ($clientsameinst) {
	$context = 'intdom';
	if ($secureconf{'connfrom'}{'intdom'} eq 'no') {
	$inittype = "";
	}
	} else {
	$context = 'other';
	if ($secureconf{'connfrom'}{'other'} eq 'no') {
	$inittype = "";
	}
	}
	if ($inittype eq '') {
	&logthis("<font color=\"blue\"> Domain config set "
	."to no ssl for $clientname (context: $context)"
	." -- trying insecure auth</font>");
	}
	}

if($inittype eq "ssl") {	if($inittype eq "ssl") {
my ($ca, $cert) = lonssl::CertificateFile;	my ($ca, $cert) = lonssl::CertificateFile;
my $kfile = lonssl::KeyFile;	my $kfile = lonssl::KeyFile;
Line 7163 sub make_new_child {	Line 7340 sub make_new_child {
close $client;	close $client;
}	}
} elsif ($inittype eq "ssl") {	} elsif ($inittype eq "ssl") {
my $key = SSLConnection($client);	my $key = SSLConnection($client,$clientname);
if ($key) {	if ($key) {
$clientok = 1;	$clientok = 1;
my $cipherkey = pack("H32", $key);	my $cipherkey = pack("H32", $key);
Line 7178 sub make_new_child {	Line 7355 sub make_new_child {
}	}

} else {	} else {
	$clientinfoset = &set_client_info();
my $ok = InsecureConnection($client);	my $ok = InsecureConnection($client);
if($ok) {	if($ok) {
$clientok = 1;	$clientok = 1;
Line 7190 sub make_new_child {	Line 7368 sub make_new_child {
."Attempted insecure connection disallowed </font>");	."Attempted insecure connection disallowed </font>");
close $client;	close $client;
$clientok = 0;	$clientok = 0;

}	}
}	}
} else {	} else {
Line 7199 sub make_new_child {	Line 7376 sub make_new_child {
."$clientip failed to initialize: >$remotereq< </font>");	."$clientip failed to initialize: >$remotereq< </font>");
&status('No init '.$clientip);	&status('No init '.$clientip);
}	}

} else {	} else {
&logthis(	&logthis(
"<font color='blue'>WARNING: Unknown client $clientip</font>");	"<font color='blue'>WARNING: Unknown client $clientip</font>");
Line 7217 sub make_new_child {	Line 7393 sub make_new_child {
# ------------------------------------------------------------ Process requests	# ------------------------------------------------------------ Process requests
my $keep_going = 1;	my $keep_going = 1;
my $user_input;	my $user_input;
my $clienthost = &Apache::lonnet::hostname($clientname);	unless ($clientinfoset) {
my $clientserverhomeID = &Apache::lonnet::get_server_homeID($clienthost);	$clientinfoset = &set_client_info();
$clienthomedom = &Apache::lonnet::host_domain($clientserverhomeID);
$clientintdom = &Apache::lonnet::internet_dom($clientserverhomeID);
$clientsameinst = 0;
if ($clientintdom ne '') {
my $internet_names = &Apache::lonnet::get_internet_names($currenthostid);
if (ref($internet_names) eq 'ARRAY') {
if (grep(/^\Q$clientintdom\E$/,@{$internet_names})) {
$clientsameinst = 1;
}
}
}	}
$clientremoteok = 0;	$clientremoteok = 0;
unless ($clientsameinst) {	unless ($clientsameinst) {
Line 7284 sub make_new_child {	Line 7450 sub make_new_child {
exit;	exit;

}	}

	#
	# Used to determine if a particular client is from the same domain
	# as the current server, or from the same internet domain.
	#
	# Optional input -- the client to check for domain and internet domain.
	# If not specified, defaults to the package variable: $clientname
	#
	# If called in array context will not set package variables, but will
	# instead return an array of two values - (a) true if client is in the
	# same domain as the server, and (b) true if client is in the same internet
	# domain.
	#
	# If called in scalar context, sets package variables for current client:
	#
	# $clienthomedom - LonCAPA domain of homeID for client.
	# $clientsamedom - LonCAPA domain same for this host and client.
	# $clientintdom - LonCAPA "internet domain" for client.
	# $clientsameinst - LonCAPA "internet domain" same for this host & client.
	#
	# returns 1 to indicate package variables have been set for current client.
	#

	sub set_client_info {
	my ($lonhost) = @_;
	$lonhost \|\|= $clientname;
	my $clienthost = &Apache::lonnet::hostname($lonhost);
	my $clientserverhomeID = &Apache::lonnet::get_server_homeID($clienthost);
	my $homedom = &Apache::lonnet::host_domain($clientserverhomeID);
	my $samedom = 0;
	if ($perlvar{'lonDefDom'} eq $homedom) {
	$samedom = 1;
	}
	my $intdom = &Apache::lonnet::internet_dom($clientserverhomeID);
	my $sameinst = 0;
	if ($intdom ne '') {
	my $internet_names = &Apache::lonnet::get_internet_names($currenthostid);
	if (ref($internet_names) eq 'ARRAY') {
	if (grep(/^\Q$intdom\E$/,@{$internet_names})) {
	$sameinst = 1;
	}
	}
	}
	if (wantarray) {
	return ($samedom,$sameinst);
	} else {
	$clienthomedom = $homedom;
	$clientsamedom = $samedom;
	$clientintdom = $intdom;
	$clientsameinst = $sameinst;
	return 1;
	}
	}

#	#
# Determine if a user is an author for the indicated domain.	# Determine if a user is an author for the indicated domain.
#	#
Line 7392 sub password_filename {	Line 7612 sub password_filename {
# domain - domain of the user.	# domain - domain of the user.
# name - User's name.	# name - User's name.
# contents - New contents of the file.	# contents - New contents of the file.
	# saveold - (optional). If true save old file in a passwd.bak file.
# Returns:	# Returns:
# 0 - Failed.	# 0 - Failed.
# 1 - Success.	# 1 - Success.
#	#
sub rewrite_password_file {	sub rewrite_password_file {
my ($domain, $user, $contents) = @_;	my ($domain, $user, $contents, $saveold) = @_;

my $file = &password_filename($domain, $user);	my $file = &password_filename($domain, $user);
if (defined $file) {	if (defined $file) {
	if ($saveold) {
	my $bakfile = $file.'.bak';
	if (CopyFile($file,$bakfile)) {
	chmod(0400,$bakfile);
	&logthis("Old password saved in passwd.bak for internally authenticated user: $user:$domain");
	} else {
	&logthis("Failed to save old password in passwd.bak for internally authenticated user: $user:$domain");
	}
	}
my $pf = IO::File->new(">$file");	my $pf = IO::File->new(">$file");
if($pf) {	if($pf) {
print $pf "$contents\n";	print $pf "$contents\n";
Line 7491 sub validate_user {	Line 7721 sub validate_user {
$contentpwd = $domdefaults{'auth_arg_def'};	$contentpwd = $domdefaults{'auth_arg_def'};
}	}
}	}
}	}
if ($howpwd ne 'nouser') {	if ($howpwd ne 'nouser') {
if($howpwd eq "internal") { # Encrypted is in local password file.	if($howpwd eq "internal") { # Encrypted is in local password file.
if (length($contentpwd) == 13) {	if (length($contentpwd) == 13) {
$validated = (crypt($password,$contentpwd) eq $contentpwd);	$validated = (crypt($password,$contentpwd) eq $contentpwd);
if ($validated) {	if ($validated) {
my $ncpass = &hash_passwd($domain,$password);	my %domdefaults = &Apache::lonnet::get_domain_defaults($domain);
if (&rewrite_password_file($domain,$user,"$howpwd:$ncpass")) {	if ($domdefaults{'intauth_switch'}) {
&update_passwd_history($user,$domain,$howpwd,'conversion');	my $ncpass = &hash_passwd($domain,$password);
&logthis("Validated password hashed with bcrypt for $user:$domain");	my $saveold;
	if ($domdefaults{'intauth_switch'} == 2) {
	$saveold = 1;
	}
	if (&rewrite_password_file($domain,$user,"$howpwd:$ncpass",$saveold)) {
	&update_passwd_history($user,$domain,$howpwd,'conversion');
	&logthis("Validated password hashed with bcrypt for $user:$domain");
	}
}	}
}	}
} else {	} else {
$validated = &check_internal_passwd($password,$contentpwd,$domain);	$validated = &check_internal_passwd($password,$contentpwd,$domain,$user);
}	}
}	}
elsif ($howpwd eq "unix") { # User is a normal unix user.	elsif ($howpwd eq "unix") { # User is a normal unix user.
Line 7574 sub validate_user {	Line 7811 sub validate_user {
}	}

sub check_internal_passwd {	sub check_internal_passwd {
my ($plainpass,$stored,$domain) = @_;	my ($plainpass,$stored,$domain,$user) = @_;
my (undef,$method,@rest) = split(/!/,$stored);	my (undef,$method,@rest) = split(/!/,$stored);
if ($method eq "bcrypt") {	if ($method eq 'bcrypt') {
my $result = &hash_passwd($domain,$plainpass,@rest);	my $result = &hash_passwd($domain,$plainpass,@rest);
if ($result ne $stored) {	if ($result ne $stored) {
return 0;	return 0;
}	}
# Upgrade to a larger number of rounds if necessary	my %domdefaults = &Apache::lonnet::get_domain_defaults($domain);
my $defaultcost;	if ($domdefaults{'intauth_check'}) {
my %domconfig =	# Upgrade to a larger number of rounds if necessary
&Apache::lonnet::get_dom('configuration',['password'],$domain);	my $defaultcost = $domdefaults{'intauth_cost'};
if (ref($domconfig{'password'}) eq 'HASH') {	if (($defaultcost eq '') \|\| ($defaultcost =~ /D/)) {
$defaultcost = $domconfig{'password'}{'cost'};	$defaultcost = 10;
}	}
if (($defaultcost eq '') \|\| ($defaultcost =~ /D/)) {	if (int($rest[0])<int($defaultcost)) {
$defaultcost = 10;	if ($domdefaults{'intauth_check'} == 1) {
	my $ncpass = &hash_passwd($domain,$plainpass);
	if (&rewrite_password_file($domain,$user,"internal:$ncpass")) {
	&update_passwd_history($user,$domain,'internal','update cost');
	&logthis("Validated password hashed with bcrypt for $user:$domain");
	}
	return 1;
	} elsif ($domdefaults{'intauth_check'} == 2) {
	return 0;
	}
	}
	} else {
	return 1;
}	}
return 1 unless($rest[0]<$defaultcost);
}	}
return 0;	return 0;
}	}

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

Removed from v.1.527
changed lines
	Added in v.1.533