--- loncom/lonnet/perl/lonnet.pm 2010/07/23 14:59:24 1.1075 +++ loncom/lonnet/perl/lonnet.pm 2010/07/29 17:44:41 1.1079 @@ -1,7 +1,7 @@ # The LearningOnline Network # TCP networking package # -# $Id: lonnet.pm,v 1.1075 2010/07/23 14:59:24 raeburn Exp $ +# $Id: lonnet.pm,v 1.1079 2010/07/29 17:44:41 raeburn Exp $ # # Copyright Michigan State University Board of Trustees # @@ -76,7 +76,7 @@ use HTTP::Date; use Image::Magick; use vars qw(%perlvar %spareid %pr %prp $memcache %packagetab $tmpdir - $_64bit %env %protocol %loncaparevs %serverhomeIDs); + $_64bit %env %protocol %loncaparevs %serverhomeIDs %needsrelease); my (%badServerCache, $memcache, %courselogs, %accesshash, %domainrolehash, %userrolehash, $processmarker, $dumpcount, %coursedombuf, @@ -812,6 +812,27 @@ sub has_user_session { return 0; } +# --------- determine least loaded server in a user's domain which allows login + +sub choose_server { + my ($udom) = @_; + my %domconfhash = &Apache::loncommon::get_domainconf($udom); + my %servers = &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) = + &compare_server_load($lonhost, $login_host, $lowest_load); + } + } + if ($login_host ne '') { + $hostname = $servers{$login_host}; + } + return ($login_host,$hostname); +} + # --------------------------------------------- Try to change a user's password sub changepass { @@ -3922,9 +3943,10 @@ sub rolesinit { my ($domain,$username,$authhost)=@_; my $now=time; my %userroles = ('user.login.time' => $now); - my $rolesdump=reply("dump:$domain:$username:roles",$authhost); + my $extra = &freeze_escape({'clientcheckrole' => 1}); + my $rolesdump=reply("dump:$domain:$username:roles:.::$extra",$authhost); if (($rolesdump eq 'con_lost') || ($rolesdump eq '') || - ($rolesdump =~ /^error:/)) { + ($rolesdump =~ /^error:/)) { return \%userroles; } my %allroles=(); @@ -10117,6 +10139,10 @@ sub get_dns { } +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); +} + BEGIN { # ----------------------------------- Read loncapa.conf and loncapa_apache.conf @@ -10220,8 +10246,23 @@ BEGIN { } } -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); +{ + my $file = $Apache::lonnet::perlvar{'lonTabDir'}.'/releaseslist.xml'; + if (-e $file) { + my $parser = HTML::LCParser->new($file); + while (my $token = $parser->get_token()) { + if ($token->[0] eq 'S') { + my $item = $token->[1]; + my $name = $token->[2]{'name'}; + my $value = $token->[2]{'value'}; + if ($item ne '' && $name ne '' && $value ne '') { + my $release = $parser->get_text(); + $release =~ s/(^\s*|\s*$ )//gx; + $needsrelease{$item.':'.$name.':'.$value} = $release; + } + } + } + } } # ------------- set up temporary directory