version 1.467.2.6, 2011/11/17 18:31:49
|
version 1.486, 2012/02/28 15:54:07
|
Line 15
|
Line 15
|
# |
# |
# LON-CAPA is distributed in the hope that it will be useful, |
# LON-CAPA is distributed in the hope that it will be useful, |
# but WITHOUT ANY WARRANTY; without even the implied warranty of |
# but WITHOUT ANY WARRANTY; without even the implied warranty of |
|
|
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
# GNU General Public License for more details. |
# GNU General Public License for more details. |
# |
# |
Line 91 my %managers; # Ip -> manager names
|
Line 92 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 $dist; |
|
|
# |
# |
# The hash below is used for command dispatching, and is therefore keyed on the request keyword. |
# The hash below is used for command dispatching, and is therefore keyed on the request keyword. |
# Each element of the hash contains a reference to an array that contains: |
# Each element of the hash contains a reference to an array that contains: |
Line 600 sub InstallFile {
|
Line 603 sub InstallFile {
|
# |
# |
# ConfigFileFromSelector: converts a configuration file selector |
# ConfigFileFromSelector: converts a configuration file selector |
# into a configuration file pathname. |
# into a configuration file pathname. |
# Supports the following file selectors: |
# Supports the following file selectors: |
# hosts, domain, dns_hosts, dns_domain |
# hosts, domain, dns_hosts, dns_domain |
# |
# |
# |
# |
# Parameters: |
# Parameters: |
Line 614 sub ConfigFileFromSelector {
|
Line 617 sub ConfigFileFromSelector {
|
my $tablefile; |
my $tablefile; |
|
|
my $tabledir = $perlvar{'lonTabDir'}.'/'; |
my $tabledir = $perlvar{'lonTabDir'}.'/'; |
if (($selector eq "hosts") || ($selector eq "domain") || |
if (($selector eq "hosts") || ($selector eq "domain") || |
($selector eq "dns_hosts") || ($selector eq "dns_domain")) { |
($selector eq "dns_hosts") || ($selector eq "dns_domain")) { |
$tablefile = $tabledir.$selector.'.tab'; |
$tablefile = $tabledir.$selector.'.tab'; |
} |
} |
return $tablefile; |
return $tablefile; |
|
|
} |
} |
# |
# |
# PushFile: Called to do an administrative push of a file. |
# PushFile: Called to do an administrative push of a file. |
Line 646 sub PushFile {
|
Line 648 sub PushFile {
|
# hosts.tab ($filename eq host). |
# hosts.tab ($filename eq host). |
# domain.tab ($filename eq domain). |
# domain.tab ($filename eq domain). |
# dns_hosts.tab ($filename eq dns_host). |
# dns_hosts.tab ($filename eq dns_host). |
# dns_domain.tab ($filename eq dns_domain). |
# dns_domain.tab ($filename eq dns_domain). |
# Construct the destination filename or reject the request. |
# Construct the destination filename or reject the request. |
# |
# |
# lonManage is supposed to ensure this, however this session could be |
# lonManage is supposed to ensure this, however this session could be |
Line 677 sub PushFile {
|
Line 679 sub PushFile {
|
.$tablefile." $! </font>"); |
.$tablefile." $! </font>"); |
return "error:$!"; |
return "error:$!"; |
} else { |
} else { |
&logthis('<font color="green"> Installed new '.$tablefile |
&logthis('<font color="green"> Installed new '.$tablefile |
." - transaction by: $clientname ($clientip)</font>"); |
." - transaction by: $clientname ($clientip)</font>"); |
my $adminmail = $perlvar{'lonAdmEMail'}; |
my $adminmail = $perlvar{'lonAdmEMail'}; |
my $admindom = &Apache::lonnet::host_domain($perlvar{'lonHostID'}); |
my $admindom = &Apache::lonnet::host_domain($perlvar{'lonHostID'}); |
if ($admindom ne '') { |
if ($admindom ne '') { |
Line 1641 sub ls3_handler {
|
Line 1643 sub ls3_handler {
|
} |
} |
®ister_handler("ls3", \&ls3_handler, 0, 1, 0); |
®ister_handler("ls3", \&ls3_handler, 0, 1, 0); |
|
|
|
sub read_lonnet_global { |
|
my ($cmd,$tail,$client) = @_; |
|
my $userinput = "$cmd:$tail"; |
|
my $requested = &Apache::lonnet::thaw_unescape($tail); |
|
my $result; |
|
my %packagevars = ( |
|
spareid => \%Apache::lonnet::spareid, |
|
perlvar => \%Apache::lonnet::perlvar, |
|
); |
|
my %limit_to = ( |
|
perlvar => { |
|
lonOtherAuthen => 1, |
|
lonBalancer => 1, |
|
lonVersion => 1, |
|
lonSysEMail => 1, |
|
lonHostID => 1, |
|
lonRole => 1, |
|
lonDefDomain => 1, |
|
lonLoadLim => 1, |
|
lonUserLoadLim => 1, |
|
} |
|
); |
|
if (ref($requested) eq 'HASH') { |
|
foreach my $what (keys(%{$requested})) { |
|
my $response; |
|
my $items = {}; |
|
if (exists($packagevars{$what})) { |
|
if (ref($limit_to{$what}) eq 'HASH') { |
|
foreach my $varname (keys(%{$packagevars{$what}})) { |
|
if ($limit_to{$what}{$varname}) { |
|
$items->{$varname} = $packagevars{$what}{$varname}; |
|
} |
|
} |
|
} else { |
|
$items = $packagevars{$what}; |
|
} |
|
if ($what eq 'perlvar') { |
|
if (!exists($packagevars{$what}{'lonBalancer'})) { |
|
if ($dist =~ /^(centos|rhes|fedora|scientific)/) { |
|
my $othervarref=LONCAPA::Configuration::read_conf('httpd.conf'); |
|
if (ref($othervarref) eq 'HASH') { |
|
$items->{'lonBalancer'} = $othervarref->{'lonBalancer'}; |
|
} |
|
} |
|
} |
|
} |
|
$response = &Apache::lonnet::freeze_escape($items); |
|
} |
|
$result .= &escape($what).'='.$response.'&'; |
|
} |
|
} |
|
$result =~ s/\&$//; |
|
&Reply($client,\$result,$userinput); |
|
return 1; |
|
} |
|
®ister_handler("readlonnetglobal", \&read_lonnet_global, 0, 1, 0); |
|
|
|
sub server_devalidatecache_handler { |
|
my ($cmd,$tail,$client) = @_; |
|
my $userinput = "$cmd:$tail"; |
|
my ($name,$id) = map { &unescape($_); } split(/:/,$tail); |
|
&Apache::lonnet::devalidate_cache_new($name,$id); |
|
my $result = 'ok'; |
|
&Reply($client,\$result,$userinput); |
|
return 1; |
|
} |
|
®ister_handler("devalidatecache", \&server_devalidatecache_handler, 0, 1, 0); |
|
|
sub server_timezone_handler { |
sub server_timezone_handler { |
my ($cmd,$tail,$client) = @_; |
my ($cmd,$tail,$client) = @_; |
my $userinput = "$cmd:$tail"; |
my $userinput = "$cmd:$tail"; |
Line 2003 sub add_user_handler {
|
Line 2073 sub add_user_handler {
|
."makeuser"; |
."makeuser"; |
} |
} |
unless ($fperror) { |
unless ($fperror) { |
my $result=&make_passwd_file($uname, $umode,$npass, $passfilename); |
my $result=&make_passwd_file($uname,$udom,$umode,$npass, $passfilename); |
&Reply($client,\$result, $userinput); #BUGBUG - could be fail |
&Reply($client,\$result, $userinput); #BUGBUG - could be fail |
} else { |
} else { |
&Failure($client, \$fperror, $userinput); |
&Failure($client, \$fperror, $userinput); |
Line 2078 sub change_authentication_handler {
|
Line 2148 sub change_authentication_handler {
|
&Failure($client, \$result); |
&Failure($client, \$result); |
} |
} |
} else { |
} else { |
my $result=&make_passwd_file($uname, $umode,$npass,$passfilename); |
my $result=&make_passwd_file($uname,$udom,$umode,$npass,$passfilename); |
# |
# |
# If the current auth mode is internal, and the old auth mode was |
# If the current auth mode is internal, and the old auth mode was |
# unix, or krb*, and the user is an author for this domain, |
# unix, or krb*, and the user is an author for this domain, |
Line 2280 sub fetch_user_file_handler {
|
Line 2350 sub fetch_user_file_handler {
|
my $transname=$udir.'/'.$ufile.'.in.transit'; |
my $transname=$udir.'/'.$ufile.'.in.transit'; |
my $clientprotocol=$Apache::lonnet::protocol{$clientname}; |
my $clientprotocol=$Apache::lonnet::protocol{$clientname}; |
$clientprotocol = 'http' if ($clientprotocol ne 'https'); |
$clientprotocol = 'http' if ($clientprotocol ne 'https'); |
my $remoteurl=$clientprotocol.'://'.$clientip.'/userfiles/'.$fname; |
my $clienthost = &Apache::lonnet::hostname($clientname); |
|
my $remoteurl=$clientprotocol.'://'.$clienthost.'/userfiles/'.$fname; |
my $response; |
my $response; |
Debug("Remote URL : $remoteurl Transfername $transname Destname: $destname"); |
Debug("Remote URL : $remoteurl Transfername $transname Destname: $destname"); |
alarm(120); |
alarm(120); |
Line 5040 sub validate_course_owner_handler {
|
Line 5111 sub validate_course_owner_handler {
|
my ($cmd, $tail, $client) = @_; |
my ($cmd, $tail, $client) = @_; |
my $userinput = "$cmd:$tail"; |
my $userinput = "$cmd:$tail"; |
my ($inst_course_id, $owner, $cdom, $coowners) = split(/:/, $tail); |
my ($inst_course_id, $owner, $cdom, $coowners) = split(/:/, $tail); |
|
|
$owner = &unescape($owner); |
$owner = &unescape($owner); |
$coowners = &unescape($coowners); |
$coowners = &unescape($coowners); |
my $outcome = &localenroll::new_course($inst_course_id,$owner,$cdom,$coowners); |
my $outcome = &localenroll::new_course($inst_course_id,$owner,$cdom,$coowners); |
Line 6031 if (-e $pidfile) {
|
Line 6102 if (-e $pidfile) {
|
$server = IO::Socket::INET->new(LocalPort => $perlvar{'londPort'}, |
$server = IO::Socket::INET->new(LocalPort => $perlvar{'londPort'}, |
Type => SOCK_STREAM, |
Type => SOCK_STREAM, |
Proto => 'tcp', |
Proto => 'tcp', |
ReuseAddr => 1, |
ReuseAddr => 1, |
Listen => 10 ) |
Listen => 10 ) |
or die "making socket: $@\n"; |
or die "making socket: $@\n"; |
|
|
Line 6094 sub HUPSMAN { # sig
|
Line 6165 sub HUPSMAN { # sig
|
# a setuid perl script that can be root for us to do this job. |
# a setuid perl script that can be root for us to do this job. |
# |
# |
sub ReloadApache { |
sub ReloadApache { |
|
# --------------------------- Handle case of another apachereload process (locking) |
if (&LONCAPA::try_to_lock('/tmp/lock_apachereload')) { |
if (&LONCAPA::try_to_lock('/tmp/lock_apachereload')) { |
my $execdir = $perlvar{'lonDaemons'}; |
my $execdir = $perlvar{'lonDaemons'}; |
my $script = $execdir."/apachereload"; |
my $script = $execdir."/apachereload"; |
Line 6363 $SIG{USR2} = \&UpdateHosts;
|
Line 6435 $SIG{USR2} = \&UpdateHosts;
|
&Apache::lonnet::load_hosts_tab(); |
&Apache::lonnet::load_hosts_tab(); |
my %iphost = &Apache::lonnet::get_iphost(1); |
my %iphost = &Apache::lonnet::get_iphost(1); |
|
|
my $dist=`$perlvar{'lonDaemons'}/distprobe`; |
$dist=`$perlvar{'lonDaemons'}/distprobe`; |
|
|
my $arch = `uname -i`; |
my $arch = `uname -i`; |
chomp($arch); |
chomp($arch); |
Line 6438 sub make_new_child {
|
Line 6510 sub make_new_child {
|
#don't get intercepted |
#don't get intercepted |
$SIG{USR1}= \&logstatus; |
$SIG{USR1}= \&logstatus; |
$SIG{ALRM}= \&timeout; |
$SIG{ALRM}= \&timeout; |
|
# |
# |
# Block sigpipe as it gets thrownon socket disconnect and we want to |
# Block sigpipe as it gets thrownon socket disconnect and we want to |
# deal with that as a read faiure instead. |
# deal with that as a read faiure instead. |
# |
# |
my $blockset = POSIX::SigSet->new(SIGPIPE); |
my $blockset = POSIX::SigSet->new(SIGPIPE); |
sigprocmask(SIG_BLOCK, $blockset); |
sigprocmask(SIG_BLOCK, $blockset); |
|
|
|
$lastlog='Forked '; |
$lastlog='Forked '; |
$status='Forked'; |
$status='Forked'; |
Line 6660 sub is_author {
|
Line 6731 sub is_author {
|
} |
} |
# |
# |
# Checks to see if the input roleput request was to set |
# Checks to see if the input roleput request was to set |
# an author role. If so, invokes the lchtmldir script to set |
# an author role. If so, creates construction space |
# up a correct public_html |
|
# Parameters: |
# Parameters: |
# request - The request sent to the rolesput subchunk. |
# request - The request sent to the rolesput subchunk. |
# We're looking for /domain/_au |
# We're looking for /domain/_au |
Line 6671 sub is_author {
|
Line 6741 sub is_author {
|
# |
# |
sub manage_permissions { |
sub manage_permissions { |
my ($request, $domain, $user, $authtype) = @_; |
my ($request, $domain, $user, $authtype) = @_; |
|
|
&Debug("manage_permissions: $request $domain $user $authtype"); |
|
|
|
# See if the request is of the form /$domain/_au |
# See if the request is of the form /$domain/_au |
if($request =~ /^(\/\Q$domain\E\/_au)$/) { # It's an author rolesput... |
if($request =~ /^(\/\Q$domain\E\/_au)$/) { # It's an author rolesput... |
my $execdir = $perlvar{'lonDaemons'}; |
my $path=$perlvar{'lonDocRoot'}."/priv/$domain"; |
my $userhome= "/home/$user" ; |
unless (-e $path) { |
&logthis("system $execdir/lchtmldir $userhome $user $authtype"); |
mkdir($path); |
&Debug("Setting homedir permissions for $userhome"); |
} |
system("$execdir/lchtmldir $userhome $user $authtype"); |
unless (-e $path.'/'.$user) { |
|
mkdir($path.'/'.$user); |
|
} |
} |
} |
} |
} |
|
|
Line 7213 sub change_unix_password {
|
Line 7282 sub change_unix_password {
|
|
|
|
|
sub make_passwd_file { |
sub make_passwd_file { |
my ($uname, $umode,$npass,$passfilename)=@_; |
my ($uname,$udom,$umode,$npass,$passfilename)=@_; |
my $result="ok"; |
my $result="ok"; |
if ($umode eq 'krb4' or $umode eq 'krb5') { |
if ($umode eq 'krb4' or $umode eq 'krb5') { |
{ |
{ |
Line 7254 sub make_passwd_file {
|
Line 7323 sub make_passwd_file {
|
# |
# |
my $uid = getpwnam($uname); |
my $uid = getpwnam($uname); |
if((defined $uid) && ($uid == 0)) { |
if((defined $uid) && ($uid == 0)) { |
&logthis(">>>Attempted to create privilged account blocked"); |
&logthis(">>>Attempt to create privileged account blocked"); |
return "no_priv_account_error\n"; |
return "no_priv_account_error\n"; |
} |
} |
|
|
Line 7266 sub make_passwd_file {
|
Line 7335 sub make_passwd_file {
|
&Debug("user = ".$uname.", Password =". $npass); |
&Debug("user = ".$uname.", Password =". $npass); |
my $se = IO::File->new("|$execpath > $perlvar{'lonDaemons'}/logs/lcuseradd.log"); |
my $se = IO::File->new("|$execpath > $perlvar{'lonDaemons'}/logs/lcuseradd.log"); |
print $se "$uname\n"; |
print $se "$uname\n"; |
|
print $se "$udom\n"; |
print $se "$npass\n"; |
print $se "$npass\n"; |
print $se "$npass\n"; |
print $se "$npass\n"; |
print $se "$lc_error_file\n"; # Status -> unique file. |
print $se "$lc_error_file\n"; # Status -> unique file. |