--- loncom/lonnet/perl/lonnet.pm 2007/08/29 22:19:24 1.908 +++ loncom/lonnet/perl/lonnet.pm 2007/09/29 04:06:34 1.910.2.2 @@ -1,7 +1,7 @@ # The LearningOnline Network # TCP networking package # -# $Id: lonnet.pm,v 1.908 2007/08/29 22:19:24 albertel Exp $ +# $Id: lonnet.pm,v 1.910.2.2 2007/09/29 04:06:34 albertel Exp $ # # Copyright Michigan State University Board of Trustees # @@ -582,6 +582,27 @@ sub compare_server_load { } return ($spare_server,$lowest_load); } + +# --------------------------- ask offload servers if user already has a session +sub find_existing_session { + my ($udom,$uname) = @_; + foreach my $try_server (@{ $spareid{'primary'} }, + @{ $spareid{'default'} }) { + return $try_server if (&has_user_session($try_server, $udom, $uname)); + } + return; +} + +# -------------------------------- ask if server already has a session for user +sub has_user_session { + my ($lonid,$udom,$uname) = @_; + my $result = &reply(join(':','userhassession', + map {&escape($_)} ($udom,$uname)),$lonid); + return 1 if ($result eq 'ok'); + + return 0; +} + # --------------------------------------------- Try to change a user's password sub changepass { @@ -861,6 +882,7 @@ sub inst_directory_query { my $udom = $srch->{'srchdomain'}; my %results; my $homeserver = &domain($udom,'primary'); + my $outcome; if ($homeserver ne '') { my $queryid=&reply("querysend:instdirsearch:". &escape($srch->{'srchby'}).':'. @@ -880,14 +902,19 @@ sub inst_directory_query { } if (!&error($response) && $response ne 'refused') { - my @matches = split(/\n/,$response); - foreach my $match (@matches) { - my ($key,$value) = split(/=/,$match); - $results{&unescape($key).':'.$udom} = &thaw_unescape($value); + if ($response eq 'unavailable') { + $outcome = $response; + } else { + $outcome = 'ok'; + my @matches = split(/\n/,$response); + foreach my $match (@matches) { + my ($key,$value) = split(/=/,$match); + $results{&unescape($key).':'.$udom} = &thaw_unescape($value); + } } } } - return %results; + return ($outcome,%results); } sub usersearch { @@ -1217,8 +1244,10 @@ sub do_cache_new { $time=600; } if ($debug) { &Apache::lonnet::logthis("Setting $id to $value"); } - if (!($memcache->set($id,$setvalue,$time))) { + my $result = $memcache->set($id,$setvalue,$time); + if (! $result) { &logthis("caching of id -> $id failed"); + $memcache->disconnect_all(); } # need to make a copy of $value #&make_room($id,$value,$debug); @@ -7727,6 +7756,9 @@ sub hreflocation { $file=~s-^/home/httpd/lonUsers/($match_domain)/./././($match_name)/userfiles/ -/uploaded/$1/$2/-x; } + if ($file=~ m{^/userfiles/}) { + $file =~ s{^/userfiles/}{/uploaded/}; + } return $file; }