[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">&nbsp;
+                           <label><input type="radio" name="'.$prefix.'_'.$type.'_inuse" '.$checkedoff{$type}.' value="0" />'.&mt('Not in use').'</label>&nbsp;
+                           <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.')"'.
+                         ' />'.('&nbsp;'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">'.
+                              '&nbsp;</td>';
+            } elsif ($colsleft == 1) {
+                $datatable .= '<td class="LC_left_item">&nbsp;</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=&current_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--