loncom/lond - diff

Return to lond CVS log

Up to [LON-CAPA] / loncom

Diff for /loncom/lond between versions 1.527 and 1.532

version 1.527, 2016/09/20 23:50:09	version 1.532, 2017/02/28 05:42:06
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 6720 sub UpdateHosts {	Line 6824 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 6834 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 7124 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 7258 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 7286 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 7344 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 7359 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 7217 sub make_new_child {	Line 7399 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 7456 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.
#	#

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

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