--- loncom/lond 2010/07/17 19:14:35 1.446 +++ loncom/lond 2010/07/17 20:01:56 1.447 @@ -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 $DEBUG = 0; # Non zero to ena 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 $client; 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 @@ sub authenticate_handler { # 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 @@ sub dump_with_regexp { 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 @@ $SIG{USR2} = \&UpdateHosts; # 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 @@ sub make_new_child { # ------------------------------------------------------------ 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 @@ sub version { 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)