[LON-CAPA-cvs] cvs: loncom / loncron lond /auth lonauth.pm switchserver.pm /interface domainprefs.pm lonconfigsettings.pm /lonnet/perl lonnet.pm
raeburn
raeburn@source.lon-capa.org
Sat, 17 Jul 2010 20:02:14 -0000
This is a MIME encoded message
--raeburn1279396934
Content-Type: text/plain
raeburn Sat Jul 17 20:02:14 2010 EDT
Modified files:
/loncom lond loncron
/loncom/auth lonauth.pm switchserver.pm
/loncom/interface domainprefs.pm lonconfigsettings.pm
/loncom/lonnet/perl lonnet.pm
Log:
- Following the switch to 2.10, domains may prefer that their users do not have sessions hosted on older versions of LON-CAPA.
- Domain Coordinators can control:
(a) where their users may have sessions hosted (by domain and/or LON-CAPA version).
(b) which other domains will have user sessions hosted on servers in the domain.
--raeburn1279396934
Content-Type: text/plain
Content-Disposition: attachment; filename="raeburn-20100717200214.txt"
Index: loncom/lond
diff -u loncom/lond:1.446 loncom/lond:1.447
--- loncom/lond:1.446 Sat Jul 17 19:14:35 2010
+++ loncom/lond Sat Jul 17 20:01:56 2010
@@ -2,7 +2,7 @@
# The LearningOnline Network
# lond "LON Daemon" Server (port "LOND" 5663)
#
-# $Id: lond,v 1.446 2010/07/17 19:14:35 raeburn Exp $
+# $Id: lond,v 1.447 2010/07/17 20:01:56 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -58,7 +58,7 @@
my $status='';
my $lastlog='';
-my $VERSION='$Revision: 1.446 $'; #' stupid emacs
+my $VERSION='$Revision: 1.447 $'; #' stupid emacs
my $remoteVERSION;
my $currenthostid="default";
my $currentdomainid;
@@ -67,6 +67,7 @@
my $clientip; # IP address of client.
my $clientname; # LonCAPA name of client.
my $clientversion; # LonCAPA version running on client
+my @clientdoms; # Array of domains on $clientip
my $server;
@@ -1765,15 +1766,37 @@
# upass - User's password.
# checkdefauth - Pass to validate_user() to try authentication
# with default auth type(s) if no user account.
+ # clientcancheckhost - Passed by clients with functionality in lonauth.pm
+ # to check if session can be hosted.
- my ($udom, $uname, $upass, $checkdefauth)=split(/:/,$tail);
+ my ($udom, $uname, $upass, $checkdefauth, $clientcancheckhost)=split(/:/,$tail);
&Debug(" Authenticate domain = $udom, user = $uname, password = $upass, checkdefauth = $checkdefauth");
chomp($upass);
$upass=&unescape($upass);
my $pwdcorrect = &validate_user($udom,$uname,$upass,$checkdefauth);
if($pwdcorrect) {
- &Reply( $client, "authorized\n", $userinput);
+ my $canhost = 1;
+ unless ($clientcancheckhost) {
+ unless (grep(/^\Q$udom\E$/,@clientdoms)) {
+ my ($remote,$hosted);
+ my $remotesession = &get_usersession_config($udom,'remotesession');
+ if (ref($remotesession) eq 'HASH') {
+ $remote = $remotesession->{'remote'}
+ }
+ my $hostedsession = &get_usersession_config($clientdoms[0],'hostedsession');
+ if (ref($hostedsession) eq 'HASH') {
+ $hosted = $hostedsession->{'hosted'};
+ }
+ $canhost = &Apache::lonnet::can_host_session($udom,$currentdomainid,$clientversion,
+ $remote,$hosted);
+ }
+ }
+ if ($canhost) {
+ &Reply( $client, "authorized\n", $userinput);
+ } else {
+ &Reply( $client, "not_allowed_to_host\n", $userinput);
+ }
#
# Bad credentials: Failed to authorize
#
@@ -3130,7 +3153,7 @@
if ($key =~ m{^/($LONCAPA::match_domain)/($LONCAPA::match_community)_(cc|co|in|ta|ep|ad|st|cr)}) {
my $cdom = $1;
my $cnum = $2;
- if ($clientversion =~ /^['"]?(\d+)\.(\d+)[.\d\-]+['"]?$/) {
+ if ($clientversion =~ /^\'?(\d+)\.(\d+)/) {
my $major = $1;
my $minor = $2;
next if (($major < 2) || (($major == 2) && ($minor < 9)));
@@ -6250,6 +6273,7 @@
# Read the host hashes:
&Apache::lonnet::load_hosts_tab();
+my %iphost = &Apache::lonnet::get_iphost(1);
my $dist=`$perlvar{'lonDaemons'}/distprobe`;
@@ -6466,6 +6490,15 @@
# ------------------------------------------------------------ Process requests
my $keep_going = 1;
my $user_input;
+ @clientdoms = ();
+ if (ref($iphost{$clientip}) eq 'ARRAY') {
+ foreach my $id (@{$iphost{$clientip}}) {
+ my $clientdom = &Apache::lonnet::host_domain($id);
+ unless (grep(/^\Q$clientdom\E/,@clientdoms)) {
+ push(@clientdoms,$clientdom);
+ }
+ }
+ }
while(($user_input = get_request) && $keep_going) {
alarm(120);
Debug("Main: Got $user_input\n");
@@ -7211,6 +7244,20 @@
return "version:$VERSION";
}
+sub get_usersession_config {
+ my ($dom,$name) = @_;
+ my ($usersessionconf,$cached)=&Apache::lonnet::is_cached_new($name,$dom);
+ if (defined($cached)) {
+ return $usersessionconf;
+ } else {
+ my %domconfig = &Apache::lonnet::get_dom('configuration',['usersessions'],$dom);
+ if (ref($domconfig{'usersessions'}) eq 'HASH') {
+ &Apache::lonnet::do_cache_new($name,$dom,$domconfig{'usersessions'},3600);
+ return $domconfig{'usersessions'};
+ }
+ }
+ return;
+}
# ----------------------------------- POD (plain old documentation, CPAN style)
Index: loncom/loncron
diff -u loncom/loncron:1.83 loncom/loncron:1.84
--- loncom/loncron:1.83 Wed Mar 24 18:57:49 2010
+++ loncom/loncron Sat Jul 17 20:01:56 2010
@@ -2,7 +2,7 @@
# Housekeeping program, started by cron, loncontrol and loncron.pl
#
-# $Id: loncron,v 1.83 2010/03/24 18:57:49 raeburn Exp $
+# $Id: loncron,v 1.84 2010/07/17 20:01:56 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -685,6 +685,22 @@
$sfh->close();
}
+sub write_loncaparevs {
+ if (open(my $fh,">$perlvar{'lonTabDir'}/loncaparevs.tab")) {
+ my %hostname = &Apache::lonnet::all_hostnames();
+ foreach my $id (sort(keys(%hostname))) {
+ if ($id ne '') {
+ my $loncaparev = &Apache::lonnet::get_server_loncaparev('',$id,1,'loncron');
+ if ($loncaparev =~ /^[\d.\-]+$/) {
+ print $fh $id.':'.$loncaparev."\n";
+ }
+ }
+ }
+ close($fh);
+ }
+ return;
+}
+
sub send_mail {
print "sending mail\n";
my $defdom = $perlvar{'lonDefDomain'};
@@ -833,6 +849,9 @@
if ($totalcount>200 && !$noemail) { &send_mail(); }
}
+ if (!$justcheckconnections && !$justreload) {
+ &write_loncaparevs();
+ }
}
&main();
Index: loncom/auth/lonauth.pm
diff -u loncom/auth/lonauth.pm:1.104 loncom/auth/lonauth.pm:1.105
--- loncom/auth/lonauth.pm:1.104 Mon Mar 22 20:11:08 2010
+++ loncom/auth/lonauth.pm Sat Jul 17 20:02:02 2010
@@ -1,7 +1,7 @@
# The LearningOnline Network
# User Authentication Module
#
-# $Id: lonauth.pm,v 1.104 2010/03/22 20:11:08 droeschl Exp $
+# $Id: lonauth.pm,v 1.105 2010/07/17 20:02:02 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -211,11 +211,15 @@
&Apache::loncommon::start_page('Already logged in');
my $end_page =
&Apache::loncommon::end_page();
+ my $dest = '/adm/roles';
+ if ($env{'form.firsturl'} ne '') {
+ $dest = $env{'form.firsturl'};
+ }
$r->print(
$start_page
.'<h1>'.&mt('You are already logged in!').'</h1>'
.'<p>'.&mt('Please either [_1]continue the current session[_2] or [_3]log out[_4].'
- ,'<a href="/adm/roles">','</a>','<a href="/adm/logout">','</a>')
+ ,'<a href="'.$dest.'">','</a>','<a href="/adm/logout">','</a>')
.'</p>'
.$end_page
);
@@ -331,8 +335,10 @@
if (grep(/^login$/,@cancreate)) {
$defaultauth = 1;
}
+ my $clientcancheckhost = 1;
my $authhost=Apache::lonnet::authenticate($form{'uname'},$upass,
- $form{'udom'},$defaultauth);
+ $form{'udom'},$defaultauth,
+ $clientcancheckhost);
# --------------------------------------------------------------------- Failed?
@@ -344,9 +350,10 @@
my %domconfig =
&Apache::lonnet::get_dom('configuration',['usercreation'],$form{'udom'});
if (grep(/^login$/,@cancreate)) {
+ my $domdesc = &Apache::lonnet::domain($form{'udom'},'description');
+ &check_can_host($r,\%form,'no_account_on_host',$domdesc);
my $start_page =
&Apache::loncommon::start_page('Create a user account in LON-CAPA');
- my $domdesc = &Apache::lonnet::domain($form{'udom'},'description');
my $lonhost = $r->dir_config('lonHostID');
my $origmail = $Apache::lonnet::perlvar{'lonSupportEMail'};
my $contacts =
@@ -396,10 +403,13 @@
}
}
+ &check_can_host($r,\%form,$authhost);
+
if ($r->dir_config("lonBalancer") eq 'yes') {
&success($r,$form{'uname'},$form{'udom'},$authhost,'noredirect',undef,
\%form);
- $r->internal_redirect('/adm/switchserver');
+ my ($otherserver) = &choose_server($form{'udom'});
+ $r->internal_redirect('/adm/switchserver?otherserver='.$otherserver);
} else {
&success($r,$form{'uname'},$form{'udom'},$authhost,$firsturl,undef,
\%form);
@@ -407,6 +417,75 @@
return OK;
}
+sub check_can_host {
+ my ($r,$form,$authhost,$domdesc) = @_;
+ return unless (ref($form) eq 'HASH');
+ my $canhost = 1;
+ my @machinedoms = &Apache::lonnet::current_machine_domains();
+ my $udom = $form->{'udom'};
+ unless (grep(/^\Q$udom\E/,@machinedoms)) {
+ my $defdom = &Apache::lonnet::default_login_domain();
+ my %defdomdefaults = &Apache::lonnet::get_domain_defaults($defdom);
+ my %udomdefaults = &Apache::lonnet::get_domain_defaults($udom);
+ my $loncaparev;
+ if ($authhost eq 'no_account_on_host') {
+ $loncaparev = &Apache::lonnet::get_server_loncaparev($defdom);
+ } else {
+ $loncaparev = &Apache::lonnet::get_server_loncaparev($defdom,$authhost);
+ }
+ $canhost = &Apache::lonnet::can_host_session($udom,$defdom,$loncaparev,$udomdefaults{'remotesessions'},$defdomdefaults{'hostedsessions'});
+ }
+ unless ($canhost) {
+ if ($authhost eq 'no_account_on_host') {
+ my ($login_host,$hostname) = &choose_server($udom);
+ &Apache::loncommon::content_type($r,'text/html');
+ $r->send_http_header;
+ if ($login_host ne '') {
+ my $protocol = $Apache::lonnet::protocol{$login_host};
+ $protocol = 'http' if ($protocol ne 'https');
+ my $newurl = $protocol.'://'.$hostname.'/adm/createaccount';
+ $r->print(&Apache::loncommon::start_page('Create a user account in LON-CAPA').
+ '<h3>'.&mt('Account creation').'</h3>'.
+ &mt('You do not currently have a LON-CAPA account at this institution.').'<br />'.
+ '<p>'.&mt('You will be able to create one by logging into a LON-CAPA server within the [_1] domain.',$domdesc).'</p>'.
+ '<p>'.&mt('[_1]Log in[_2]','<a href="'.$newurl.'">','</a>').
+ &Apache::loncommon::end_page());
+ } else {
+ $r->print(&Apache::loncommon::start_page('Access to LON-CAPA unavailable').
+ '<h3>'.&mt('Account creation unavailable').'</h3>'.
+ &mt('You do not currently have a LON-CAPA account at this institution.').'<br />'.
+ '<p>'.&mt('Currently a LON-CAPA server is not available within the [_1] domain for you to log-in to, to create an account.',$domdesc).'</p>'.
+ &Apache::loncommon::end_page());
+ }
+ return OK;
+ } else {
+ &success($r,$form->{'uname'},$udom,$authhost,'noredirect',undef,
+ $form);
+ my ($otherserver) = &choose_server($udom);
+ $r->internal_redirect('/adm/switchserver?otherserver='.$otherserver);
+ }
+ }
+}
+
+sub choose_server {
+ my ($udom) = @_;
+ my %domconfhash = &Apache::loncommon::get_domainconf($udom);
+ my %servers = &Apache::lonnet::get_servers($udom);
+ my $lowest_load = 30000;
+ my ($login_host,$hostname);
+ foreach my $lonhost (keys(%servers)) {
+ my $loginvia = $domconfhash{$udom.'.login.loginvia_'.$lonhost};
+ if ($loginvia eq '') {
+ ($login_host, $lowest_load) =
+ &Apache::lonnet::compare_server_load($lonhost, $login_host, $lowest_load);
+ }
+ }
+ if ($login_host ne '') {
+ $hostname = $servers{$login_host};
+ }
+ return ($login_host,$hostname);
+}
+
1;
__END__
Index: loncom/auth/switchserver.pm
diff -u loncom/auth/switchserver.pm:1.25 loncom/auth/switchserver.pm:1.26
--- loncom/auth/switchserver.pm:1.25 Mon Mar 22 20:11:08 2010
+++ loncom/auth/switchserver.pm Sat Jul 17 20:02:02 2010
@@ -1,7 +1,7 @@
# The LearningOnline Network
# Switch Servers Handler
#
-# $Id: switchserver.pm,v 1.25 2010/03/22 20:11:08 droeschl Exp $
+# $Id: switchserver.pm,v 1.26 2010/07/17 20:02:02 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -83,7 +83,7 @@
$env{'form.otherserver'} =
&Apache::lonnet::spareserver(30000,undef,1);
}
-
+
$switch_to=&Apache::lonnet::hostname($env{'form.otherserver'});
}
@@ -95,6 +95,20 @@
return &do_redirect($r,$url,1)
}
+ my $canhost = 1;
+ my @machinedoms = &Apache::lonnet::machine_domains($switch_to);
+ unless (grep(/^\Q$env{'user.domain'}\E/,@machinedoms)) {
+ my $machinedom = &Apache::lonnet::host_domain($env{'form.otherserver'});
+ my %defdomdefaults = &Apache::lonnet::get_domain_defaults($machinedom);
+ my %udomdefaults = &Apache::lonnet::get_domain_defaults($env{'user.domain'});
+ my $remoterev = &Apache::lonnet::get_server_loncaparev($env{'user.domain'},$env{'form.otherserver'});
+ $canhost = &Apache::lonnet::can_host_session($env{'user.domain'},$machinedom,
+ $remoterev,$udomdefaults{'remotesessions'},
+ $defdomdefaults{'hostedsessions'});
+ }
+
+ unless ($canhost) { return FORBIDDEN; }
+
if ($env{'form.role'} &&
!exists($env{'user.role.'.$env{'form.role'}})) { return FORBIDDEN; }
Index: loncom/interface/domainprefs.pm
diff -u loncom/interface/domainprefs.pm:1.136 loncom/interface/domainprefs.pm:1.137
--- loncom/interface/domainprefs.pm:1.136 Mon Jun 21 06:23:24 2010
+++ loncom/interface/domainprefs.pm Sat Jul 17 20:02:07 2010
@@ -1,7 +1,7 @@
# The LearningOnline Network with CAPA
# Handler to set domain-wide configuration settings
#
-# $Id: domainprefs.pm,v 1.136 2010/06/21 06:23:24 raeburn Exp $
+# $Id: domainprefs.pm,v 1.137 2010/07/17 20:02:07 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -203,12 +203,12 @@
'directorysrch','usercreation','usermodification',
'contacts','defaults','scantron','coursecategories',
'serverstatuses','requestcourses','helpsettings',
- 'coursedefaults'],$dom);
+ 'coursedefaults','usersessions'],$dom);
my @prefs_order = ('rolecolors','login','defaults','quotas','autoenroll',
'autoupdate','autocreate','directorysrch','contacts',
'usercreation','usermodification','scantron',
'requestcourses','coursecategories','serverstatuses','helpsettings',
- 'coursedefaults');
+ 'coursedefaults','usersessions');
my %prefs = (
'rolecolors' =>
{ text => 'Default color schemes',
@@ -349,6 +349,14 @@
header => [{col1 => 'Setting',
col2 => 'Value',}],
},
+ 'usersessions' =>
+ {text => 'User session hosting',
+ help => 'Domain_Configuration_User_Sessions',
+ header => [{col1 => 'Hosting of users from other domains',
+ col2 => 'Rules'},
+ {col1 => "Hosting domain's own users elsewhere",
+ col2 => 'Rules'}],
+ },
);
my %servers = &dom_servers($dom);
if (keys(%servers) > 1) {
@@ -451,6 +459,8 @@
$output = &modify_helpsettings($r,$dom,$confname,%domconfig);
} elsif ($action eq 'coursedefaults') {
$output = &modify_coursedefaults($dom,%domconfig);
+ } elsif ($action eq 'usersessions') {
+ $output = &modify_usersessions($dom,%domconfig);
}
return $output;
}
@@ -503,6 +513,8 @@
$output .= &print_quotas($dom,$settings,\$rowtotal,$action);
} elsif ($action eq 'helpsettings') {
$output .= &print_helpsettings('top',$dom,$confname,$settings,\$rowtotal);
+ } elsif ($action eq 'usersessions') {
+ $output .= &print_usersessions('top',$dom,$settings,\$rowtotal);
} elsif ($action eq 'rolecolors') {
$output .= &print_rolecolors($phase,'student',$dom,$confname,$settings,\$rowtotal);
}
@@ -566,6 +578,8 @@
$output .= &print_courserequestmail($dom,$settings,\$rowtotal);
} elsif ($action eq 'helpsettings') {
$output .= &print_helpsettings('bottom',$dom,$confname,$settings,\$rowtotal);
+ } elsif ($action eq 'usersessions') {
+ $output .= &print_usersessions('bottom',$dom,$settings,\$rowtotal);
} elsif ($action eq 'rolecolors') {
$output .= &print_rolecolors($phase,'coordinator',$dom,$confname,$settings,\$rowtotal).'
</table>
@@ -2242,6 +2256,110 @@
return $datatable;
}
+sub print_usersessions {
+ my ($position,$dom,$settings,$rowtotal) = @_;
+ my ($css_class,$datatable,%checked,%choices);
+ my %lt = &usersession_titles();
+ my $itemcount = 1;
+ my $numinrow = 6;
+ my $prefix;
+ my @types;
+ if ($position eq 'top') {
+ $prefix = 'hosted';
+ @types = ('excludedomain','includedomain');
+ } else {
+ $prefix = 'remote';
+ @types = ('version','excludedomain','includedomain');
+ }
+ my (%current,%checkedon,%checkedoff);
+ my @lcversions = &Apache::lonnet::all_loncaparevs();
+ my @alldoms = sort(&Apache::lonnet::all_domains());
+ foreach my $type (@types) {
+ $checkedon{$type} = '';
+ $checkedoff{$type} = ' checked="checked"';
+ }
+ if (ref($settings) eq 'HASH') {
+ if (ref($settings->{$prefix}) eq 'HASH') {
+ foreach my $key (keys(%{$settings->{$prefix}})) {
+ $current{$key} = $settings->{$prefix}{$key};
+ if ($key eq 'version') {
+ if ($current{$key} ne '') {
+ $checkedon{$key} = ' checked="checked"';
+ $checkedoff{$key} = '';
+ }
+ } elsif (ref($current{$key}) eq 'ARRAY') {
+ $checkedon{$key} = ' checked="checked"';
+ $checkedoff{$key} = '';
+ }
+ }
+ }
+ }
+ foreach my $type (@types) {
+ $css_class = $itemcount%2 ? ' class="LC_odd_row"' : '';
+ $datatable .= '<tr'.$css_class.'>
+ <td><span class="LC_nobreak">'.$lt{$type}.'</span><br />
+ <span class="LC_nobreak">
+ <label><input type="radio" name="'.$prefix.'_'.$type.'_inuse" '.$checkedoff{$type}.' value="0" />'.&mt('Not in use').'</label>
+ <label><input type="radio" name="'.$prefix.'_'.$type.'_inuse" '.$checkedon{$type}.' value="1" />'.&mt('In use').'</label></span></td><td>';
+ if ($type eq 'version') {
+ my $selector = '<select name="'.$prefix.'_version">';
+ foreach my $version (@lcversions) {
+ my $selected = '';
+ if ($current{'version'} eq $version) {
+ $selected = ' selected="selected"';
+ }
+ $selector .= ' <option value="'.$version.'"'.
+ $selected.'>'.$version.'</option>';
+ }
+ $selector .= '</select> ';
+ $datatable .= &mt('remote server must be version: [_1] or later',$selector);
+ } else {
+ $datatable.= '<div><input type="button" value="'.&mt('check all').'" '.
+ 'onclick="javascript:checkAll(document.display.'.$prefix.'_'.$type.')"'.
+ ' />'.(' 'x2).
+ '<input type="button" value="'.&mt('uncheck all').'" '.
+ 'onclick="javascript:uncheckAll(document.display.'.$prefix.'_'.$type.')" />'.
+ "\n".
+ '</div><div><table>';
+ my $rem;
+ for (my $i=0; $i<@alldoms; $i++) {
+ next if ($alldoms[$i] eq $dom);
+ my $checkedtype;
+ if (ref($current{$type}) eq 'ARRAY') {
+ if (grep(/^\Q$alldoms[$i]\E$/,@{$current{$type}})) {
+ $checkedtype = ' checked="checked"';
+ }
+ }
+ $rem = $i%($numinrow);
+ if ($rem == 0) {
+ if ($i > 0) {
+ $datatable .= '</tr>';
+ }
+ $datatable .= '<tr>';
+ }
+ $datatable .= '<td class="LC_left_item">'.
+ '<span class="LC_nobreak"><label>'.
+ '<input type="checkbox" name="'.$prefix.'_'.$type.
+ '" value="'.$alldoms[$i].'"'.$checkedtype.' />'.$alldoms[$i].
+ '</label></span></td>';
+ }
+ $rem = @alldoms%($numinrow);
+ my $colsleft = $numinrow - $rem;
+ if ($colsleft > 1 ) {
+ $datatable .= '<td colspan="'.$colsleft.'" class="LC_left_item">'.
+ ' </td>';
+ } elsif ($colsleft == 1) {
+ $datatable .= '<td class="LC_left_item"> </td>';
+ }
+ $datatable .= '</tr></table>';
+ }
+ $datatable .= '</td></tr>';
+ $itemcount ++;
+ }
+ $$rowtotal += $itemcount;
+ return $datatable;
+}
+
sub contact_titles {
my %titles = &Apache::lonlocal::texthash (
'supportemail' => 'Support E-mail address',
@@ -6519,6 +6637,162 @@
return $resulttext;
}
+sub modify_usersessions {
+ my ($dom,%domconfig) = @_;
+ my @types = ('version','excludedomain','includedomain');
+ my @prefixes = ('remote','hosted');
+ my @lcversions = &Apache::lonnet::all_loncaparevs();
+ my (%defaultshash,%changes);
+ foreach my $prefix (@prefixes) {
+ $defaultshash{'usersessions'}{$prefix} = {};
+ }
+ my %domdefaults = &Apache::lonnet::get_domain_defaults($dom);
+ my $resulttext;
+ foreach my $prefix (@prefixes) {
+ foreach my $type (@types) {
+ my $inuse = $env{'form.'.$prefix.'_'.$type.'_inuse'};
+ if ($type eq 'version') {
+ my $value = $env{'form.'.$prefix.'_'.$type};
+ my $okvalue;
+ if ($value ne '') {
+ if (grep(/^\Q$value\E$/,@lcversions)) {
+ $okvalue = $value;
+ }
+ }
+ if (ref($domconfig{'usersessions'}) eq 'HASH') {
+ if (ref($domconfig{'usersessions'}{$prefix}) eq 'HASH') {
+ if ($domconfig{'usersessions'}{$prefix}{$type} ne '') {
+ if ($inuse == 0) {
+ $changes{$prefix}{$type} = 1;
+ } else {
+ if ($okvalue ne $domconfig{'usersessions'}{$prefix}{$type}) {
+ $changes{$prefix}{$type} = 1;
+ }
+ if ($okvalue ne '') {
+ $defaultshash{'usersessions'}{$prefix}{$type} = $okvalue;
+ }
+ }
+ } else {
+ if (($inuse == 1) && ($okvalue ne '')) {
+ $defaultshash{'usersessions'}{$prefix}{$type} = $okvalue;
+ $changes{$prefix}{$type} = 1;
+ }
+ }
+ } else {
+ if (($inuse == 1) && ($okvalue ne '')) {
+ $defaultshash{'usersessions'}{$prefix}{$type} = $okvalue;
+ $changes{$prefix}{$type} = 1;
+ }
+ }
+ } else {
+ if (($inuse == 1) && ($okvalue ne '')) {
+ $defaultshash{'usersessions'}{$prefix}{$type} = $okvalue;
+ $changes{$prefix}{$type} = 1;
+ }
+ }
+ } else {
+ my @vals = &Apache::loncommon::get_env_multiple('form.'.$prefix.'_'.$type);
+ my @okvals;
+ foreach my $val (@vals) {
+ if (&Apache::lonnet::domain($val) ne '') {
+ push(@okvals,$val);
+ }
+ }
+ @okvals = sort(@okvals);
+ if (ref($domconfig{'usersessions'}) eq 'HASH') {
+ if (ref($domconfig{'usersessions'}{$prefix}) eq 'HASH') {
+ if (ref($domconfig{'usersessions'}{$prefix}{$type}) eq 'ARRAY') {
+ if ($inuse == 0) {
+ $changes{$prefix}{$type} = 1;
+ } else {
+ $defaultshash{'usersessions'}{$prefix}{$type} = \@okvals;
+ my @changed = &Apache::loncommon::compare_arrays($domconfig{'usersessions'}{$prefix}{$type},$defaultshash{'usersessions'}{$prefix}{$type});
+ if (@changed > 0) {
+ $changes{$prefix}{$type} = 1;
+ }
+ }
+ } else {
+ if ($inuse == 1) {
+ $defaultshash{'usersessions'}{$prefix}{$type} = \@okvals;
+ $changes{$prefix}{$type} = 1;
+ }
+ }
+ } else {
+ if ($inuse == 1) {
+ $defaultshash{'usersessions'}{$prefix}{$type} = \@okvals;
+ $changes{$prefix}{$type} = 1;
+ }
+ }
+ } else {
+ if ($inuse == 1) {
+ $defaultshash{'usersessions'}{$prefix}{$type} = \@okvals;
+ $changes{$prefix}{$type} = 1;
+ }
+ }
+ }
+ }
+ }
+ if (keys(%changes) > 0) {
+ my $putresult = &Apache::lonnet::put_dom('configuration',\%defaultshash,
+ $dom);
+ if ($putresult eq 'ok') {
+ if (ref($defaultshash{'usersessions'}) eq 'HASH') {
+ if (ref($defaultshash{'usersessions'}{'remote'}) eq 'HASH') {
+ $domdefaults{'remotesessions'} = $defaultshash{'usersessions'}{'remote'};
+ }
+ if (ref($defaultshash{'usersessions'}{'hosted'}) eq 'HASH') {
+ $domdefaults{'hostedsessions'} = $defaultshash{'usersessions'}{'hosted'};
+ }
+ }
+ my $cachetime = 24*60*60;
+ &Apache::lonnet::do_cache_new('domdefaults',$dom,\%domdefaults,$cachetime);
+ my %lt = &usersession_titles();
+ $resulttext = &mt('Changes made:').'<ul>';
+ foreach my $prefix (@prefixes) {
+ if (ref($changes{$prefix}) eq 'HASH') {
+ $resulttext .= '<li>'.$lt{$prefix}.'<ul>';
+ foreach my $type (@types) {
+ if (defined($changes{$prefix}{$type})) {
+ my $newvalue;
+ if (ref($defaultshash{'usersessions'}) eq 'HASH') {
+ if (ref($defaultshash{'usersessions'}{$prefix})) {
+ if ($type eq 'version') {
+ $newvalue = $defaultshash{'usersessions'}{$prefix}{$type};
+ } elsif (ref($defaultshash{'usersessions'}{$prefix}{$type}) eq 'ARRAY') {
+ if (@{$defaultshash{'usersessions'}{$prefix}{$type}} > 0) {
+ $newvalue = join(', ',@{$defaultshash{'usersessions'}{$prefix}{$type}});
+ }
+ }
+ }
+ }
+ if ($newvalue eq '') {
+ if ($type eq 'version') {
+ $resulttext .= '<li>'.&mt('[_1] set to: off',$lt{$type}).'</li>';
+ } else {
+ $resulttext .= '<li>'.&mt('[_1] set to: none',$lt{$type}).'</li>';
+ }
+ } else {
+ if ($type eq 'version') {
+ $newvalue .= ' '.&mt('(or later)');
+ }
+ $resulttext .= '<li>'.&mt('[_1] set to: [_2].',$lt{$type},$newvalue).'</li>';
+ }
+ }
+ }
+ $resulttext .= '</ul>';
+ }
+ }
+ $resulttext .= '</ul>';
+ } else {
+ $resulttext = '<span class="LC_error">'.
+ &mt('An error occurred: [_1]',$putresult).'</span>';
+ }
+ } else {
+ $resulttext = &mt('No changes made to settings for user session hosting.');
+ }
+ return $resulttext;
+}
+
sub recurse_check {
my ($chkcats,$categories,$depth,$name) = @_;
if (ref($chkcats->[$depth]{$name}) eq 'ARRAY') {
@@ -6662,4 +6936,15 @@
return ($numdcs,$datatable);
}
+sub usersession_titles {
+ return &Apache::lonlocal::texthash(
+ hosted => 'Hosting of sessions for users from other domains on servers in this domain',
+
+ remote => 'Hosting of sessions for users in this domain on servers in other domains',
+ version => 'LON-CAPA version requirement',
+ excludedomain => 'Specific domains excluded',
+ includedomain => 'Specific domains included',
+ );
+}
+
1;
Index: loncom/interface/lonconfigsettings.pm
diff -u loncom/interface/lonconfigsettings.pm:1.14 loncom/interface/lonconfigsettings.pm:1.15
--- loncom/interface/lonconfigsettings.pm:1.14 Sat May 22 01:29:27 2010
+++ loncom/interface/lonconfigsettings.pm Sat Jul 17 20:02:07 2010
@@ -1,7 +1,7 @@
# The LearningOnline Network with CAPA
# Handler to set domain-wide configuration settings
#
-# $Id: lonconfigsettings.pm,v 1.14 2010/05/22 01:29:27 raeburn Exp $
+# $Id: lonconfigsettings.pm,v 1.15 2010/07/17 20:02:07 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -251,6 +251,13 @@
if (grep(/^\Q$item\E$/,@actions)) {
push(@items,$item);
if ($context eq 'domain') {
+ if ($item eq 'usersessions') {
+ $r->print('<script type="text/javascript">'."\n".
+ '// <![CDATA['."\n".
+ &Apache::loncommon::check_uncheck_jscript()."\n".
+ '// ]]>'."\n".
+ '</script>'."\n");
+ }
($output{$item},$rowtotal{$item}) =
&Apache::domainprefs::print_config_box($r,$dom,$confname,
$phase,$item,$prefs->{$item},$values->{$item});
Index: loncom/lonnet/perl/lonnet.pm
diff -u loncom/lonnet/perl/lonnet.pm:1.1072 loncom/lonnet/perl/lonnet.pm:1.1073
--- loncom/lonnet/perl/lonnet.pm:1.1072 Tue Jul 6 18:36:56 2010
+++ loncom/lonnet/perl/lonnet.pm Sat Jul 17 20:02:13 2010
@@ -1,7 +1,7 @@
# The LearningOnline Network
# TCP networking package
#
-# $Id: lonnet.pm,v 1.1072 2010/07/06 18:36:56 www Exp $
+# $Id: lonnet.pm,v 1.1073 2010/07/17 20:02:13 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -76,7 +76,7 @@
use Image::Magick;
use vars qw(%perlvar %spareid %pr %prp $memcache %packagetab $tmpdir
- $_64bit %env %protocol);
+ $_64bit %env %protocol %loncaparevs);
my (%badServerCache, $memcache, %courselogs, %accesshash, %domainrolehash,
%userrolehash, $processmarker, $dumpcount, %coursedombuf,
@@ -196,7 +196,7 @@
}
sub get_server_loncaparev {
- my ($dom,$lonhost) = @_;
+ my ($dom,$lonhost,$ignore_cache,$caller) = @_;
if (defined($lonhost)) {
if (!defined(&hostname($lonhost))) {
undef($lonhost);
@@ -211,14 +211,45 @@
}
}
if (defined($lonhost)) {
- my $cachetime = 24*3600;
- my ($loncaparev,$cached)=&is_cached_new('serverloncaparev',$lonhost);
- if (defined($cached)) {
- return $loncaparev;
- } else {
- my $loncaparev = &reply('serverloncaparev',$lonhost);
- return &do_cache_new('serverloncaparev',$lonhost,$loncaparev,$cachetime);
+ my $cachetime = 12*3600;
+ if (!$ignore_cache) {
+ my ($loncaparev,$cached)=&is_cached_new('serverloncaparev',$lonhost);
+ if (defined($cached)) {
+ return $loncaparev;
+ }
+ }
+ my ($answer,$loncaparev);
+ my @ids=¤t_machine_ids();
+ if (grep(/^\Q$lonhost\E$/,@ids)) {
+ $answer = $perlvar{'lonVersion'};
+ if ($answer =~ /^[\'\"]?([\d.\-]+)[\'\"]?$/) {
+ $loncaparev = $1;
+ }
+ } else {
+ $answer = &reply('serverloncaparev',$lonhost);
+ if (($answer eq 'unknown_cmd') || ($answer eq 'con_lost')) {
+ if ($caller eq 'loncron') {
+ my $ua=new LWP::UserAgent;
+ $ua->timeout(20);
+ my $protocol = $protocol{$lonhost};
+ $protocol = 'http' if ($protocol ne 'https');
+ my $url = $protocol.'://'.&hostname($lonhost).'/adm/about.html';
+ my $request=new HTTP::Request('GET',$url);
+ my $response=$ua->request($request);
+ unless ($response->is_error()) {
+ my $content = $response->content;
+ if ($content =~ /<p>VERSION\:\s*([\d.\-]+)<\/p>/) {
+ $loncaparev = $1;
+ }
+ }
+ } else {
+ $loncaparev = $loncaparevs{$lonhost};
+ }
+ } elsif ($answer =~ /^[\'\"]?([\d.\-]+)[\'\"]?$/) {
+ $loncaparev = $1;
+ }
}
+ return &do_cache_new('serverloncaparev',$lonhost,$loncaparev,$cachetime);
}
}
@@ -811,7 +842,7 @@
# --------- Try to authenticate user from domain's lib servers (first this one)
sub authenticate {
- my ($uname,$upass,$udom,$checkdefauth)=@_;
+ my ($uname,$upass,$udom,$checkdefauth,$clientcancheckhost)=@_;
$upass=&escape($upass);
$uname= &LONCAPA::clean_username($uname);
my $uhome=&homeserver($uname,$udom,1);
@@ -834,7 +865,7 @@
return 'no_host';
}
}
- my $answer=reply("encrypt:auth:$udom:$uname:$upass:$checkdefauth",$uhome);
+ my $answer=reply("encrypt:auth:$udom:$uname:$upass:$checkdefauth:$clientcancheckhost",$uhome);
if ($answer eq 'authorized') {
if ($newhome) {
&logthis("User $uname at $udom authorized by $uhome, but needs account");
@@ -852,6 +883,63 @@
return 'no_host';
}
+sub can_host_session {
+ my ($udom,$machinedom,$remoterev,$remotesessions,$hostedsessions) = @_;
+ my $canhost = 1;
+ if (ref($remotesessions) eq 'HASH') {
+ if (ref($remotesessions->{'excludedomain'}) eq 'ARRAY') {
+ if (grep(/^\Q$machinedom\E$/,@{$remotesessions->{'excludedomain'}})) {
+ $canhost = 0;
+ } else {
+ $canhost = 1;
+ }
+ }
+ if (ref($remotesessions->{'includedomain'}) eq 'ARRAY') {
+ if (grep(/^\Q$machinedom\E$/,@{$remotesessions->{'includedomain'}})) {
+ $canhost = 1;
+ } else {
+ $canhost = 0;
+ }
+ }
+ if ($canhost) {
+ if ($remotesessions->{'version'} ne '') {
+ my ($reqmajor,$reqminor) = ($remotesessions->{'version'} =~ /^(\d+)\.(\d+)$/);
+ if ($reqmajor ne '' && $reqminor ne '') {
+ if ($remoterev =~ /^\'?(\d+)\.(\d+)/) {
+ my $major = $1;
+ my $minor = $2;
+ if (($major < $reqmajor ) ||
+ (($major == $reqmajor) && ($minor < $reqminor))) {
+ $canhost = 0;
+ }
+ } else {
+ $canhost = 0;
+ }
+ }
+ }
+ }
+ }
+ if ($canhost) {
+ if (ref($hostedsessions) eq 'HASH') {
+ if (ref($hostedsessions->{'excludedomain'}) eq 'ARRAY') {
+ if (grep(/^\Q$udom\E$/,@{$hostedsessions->{'excludedomain'}})) {
+ $canhost = 0;
+ } else {
+ $canhost = 1;
+ }
+ }
+ if (ref($hostedsessions->{'includedomain'}) eq 'ARRAY') {
+ if (grep(/^\Q$udom\E$/,@{$hostedsessions->{'includedomain'}})) {
+ $canhost = 1;
+ } else {
+ $canhost = 0;
+ }
+ }
+ }
+ }
+ return $canhost;
+}
+
# ---------------------- Find the homebase for a user from domain's lib servers
my %homecache;
@@ -1328,7 +1416,7 @@
my %domconfig =
&Apache::lonnet::get_dom('configuration',['defaults','quotas',
'requestcourses','inststatus',
- 'coursedefaults'],$domain);
+ 'coursedefaults','usersessions'],$domain);
if (ref($domconfig{'defaults'}) eq 'HASH') {
$domdefaults{'lang_def'} = $domconfig{'defaults'}{'lang_def'};
$domdefaults{'auth_def'} = $domconfig{'defaults'}{'auth_def'};
@@ -1368,6 +1456,14 @@
$domdefaults{$item} = $domconfig{'coursedefaults'}{$item};
}
}
+ if (ref($domconfig{'usersessions'}) eq 'HASH') {
+ if (ref($domconfig{'usersessions'}{'remote'}) eq 'HASH') {
+ $domdefaults{'remotesessions'} = $domconfig{'usersessions'}{'remote'};
+ }
+ if (ref($domconfig{'usersessions'}{'hosted'}) eq 'HASH') {
+ $domdefaults{'hostedsessions'} = $domconfig{'usersessions'}{'hosted'};
+ }
+ }
&Apache::lonnet::do_cache_new('domdefaults',$domain,\%domdefaults,
$cachetime);
return %domdefaults;
@@ -10003,6 +10099,24 @@
close($config);
}
+# ---------------------------------------------------------- Read loncaparev table
+{
+ if (-e "$perlvar{'lonTabDir'}/loncaparevs.tab") {
+ if (open(my $config,"<$perlvar{'lonTabDir'}/loncaparevs.tab")) {
+ while (my $configline=<$config>) {
+ chomp($configline);
+ my ($hostid,$loncaparev)=split(/:/,$configline);
+ $loncaparevs{$hostid}=$loncaparev;
+ }
+ close($config);
+ }
+ }
+}
+
+sub all_loncaparevs {
+ return qw(1.1 1.2 1.3 2.0 2.1 2.2 2.3 2.4 2.5 2.6 2.7 2.8 2.9 2.10);
+}
+
# ------------- set up temporary directory
{
$tmpdir = $perlvar{'lonDaemons'}.'/tmp/';
@@ -10233,9 +10347,14 @@
=item *
X<authenticate()>
-B<authenticate($uname,$upass,$udom)>: try to
+B<authenticate($uname,$upass,$udom,$checkdefauth,$clientcancheckhost)>: try to
authenticate user from domain's lib servers (first use the current
one). C<$upass> should be the users password.
+$checkdefauth is optional (value is 1 if a check should be made to
+ authenticate user using default authentication method, and allow
+ account creation if username does not have account in the domain).
+$clientcancheckhost is optional (value is 1 if checking whether the
+ server can host will occur on the client side in lonauth.pm).
=item *
X<homeserver()>
--raeburn1279396934--