--- loncom/lonnet/perl/lonnet.pm 2014/04/23 10:11:34 1.1256 +++ loncom/lonnet/perl/lonnet.pm 2014/06/13 03:33:55 1.1262 @@ -1,7 +1,7 @@ # The LearningOnline Network # TCP networking package # -# $Id: lonnet.pm,v 1.1256 2014/04/23 10:11:34 raeburn Exp $ +# $Id: lonnet.pm,v 1.1262 2014/06/13 03:33:55 raeburn Exp $ # # Copyright Michigan State University Board of Trustees # @@ -961,12 +961,29 @@ sub has_user_session { # --------- determine least loaded server in a user's domain which allows login sub choose_server { - my ($udom,$checkloginvia,$required) = @_; + my ($udom,$checkloginvia,$required,$skiploadbal) = @_; my %domconfhash = &Apache::loncommon::get_domainconf($udom); my %servers = &get_servers($udom); my $lowest_load = 30000; - my ($login_host,$hostname,$portal_path,$isredirect); + my ($login_host,$hostname,$portal_path,$isredirect,$balancers); + if ($skiploadbal) { + ($balancers,my $cached)=&is_cached_new('loadbalancing',$udom); + unless (defined($cached)) { + my $cachetime = 60*60*24; + my %domconfig = + &Apache::lonnet::get_dom('configuration',['loadbalancing'],$udom); + if (ref($domconfig{'loadbalancing'}) eq 'HASH') { + $balancers = &do_cache_new('loadbalancing',$udom,$domconfig{'loadbalancing'}, + $cachetime); + } + } + } foreach my $lonhost (keys(%servers)) { + if ($skiploadbal) { + if (ref($balancers) eq 'HASH') { + next if (exists($balancers->{$lonhost})); + } + } my $loginvia; if ($checkloginvia) { $loginvia = $domconfhash{$udom.'.login.loginvia_'.$lonhost}; @@ -2011,7 +2028,8 @@ sub get_domain_defaults { &Apache::lonnet::get_dom('configuration',['defaults','quotas', 'requestcourses','inststatus', 'coursedefaults','usersessions', - 'requestauthor','selfenrollment'],$domain); + 'requestauthor','selfenrollment', + 'coursecategories'],$domain); my @coursetypes = ('official','unofficial','community','textbook'); if (ref($domconfig{'defaults'}) eq 'HASH') { $domdefaults{'lang_def'} = $domconfig{'defaults'}{'lang_def'}; @@ -2103,6 +2121,16 @@ sub get_domain_defaults { } } } + if (ref($domconfig{'coursecategories'}) eq 'HASH') { + $domdefaults{'catauth'} = 'std'; + $domdefaults{'catunauth'} = 'std'; + if ($domconfig{'coursecategories'}{'auth'}) { + $domdefaults{'catauth'} = $domconfig{'coursecategories'}{'auth'}; + } + if ($domconfig{'coursecategories'}{'unauth'}) { + $domdefaults{'catunauth'} = $domconfig{'coursecategories'}{'unauth'}; + } + } &do_cache_new('domdefaults',$domain,\%domdefaults,$cachetime); return %domdefaults; } @@ -7893,7 +7921,7 @@ sub auto_validate_class_sec { sub auto_crsreq_update { my ($cdom,$cnum,$crstype,$action,$ownername,$ownerdomain,$fullname,$title, - $code,$inbound) = @_; + $code,$accessstart,$accessend,$inbound) = @_; my ($homeserver,%crsreqresponse); if ($cdom =~ /^$match_domain$/) { $homeserver = &domain($cdom,'primary'); @@ -7906,7 +7934,9 @@ sub auto_crsreq_update { my $response=&reply('autocrsrequpdate:'.$cdom.':'.$cnum.':'.&escape($crstype). ':'.&escape($action).':'.&escape($ownername).':'. &escape($ownerdomain).':'.&escape($fullname).':'. - &escape($title).':'.&escape($code).':'.$info,$homeserver); + &escape($title).':'.&escape($code).':'. + &escape($accessstart).':'.&escape($accessend).':'.$info, + $homeserver); unless ($response =~ /(con_lost|error|no_such_host|refused)/) { my @items = split(/&/,$response); foreach my $item (@items) { @@ -10193,7 +10223,7 @@ sub metadata { ($uri =~ m|/$|) || ($uri =~ m|/.meta$|) || ($uri =~ m{^/*uploaded/.+\.sequence$})) { return undef; } - if (($uri =~ /^priv/ || $uri=~/home\/httpd\/html\/priv/) + if (($uri =~ /^priv/ || $uri=~m{^home/httpd/html/priv}) && &Apache::lonxml::get_state('target') =~ /^(|meta)$/) { return undef; } @@ -11251,8 +11281,12 @@ sub rndseed_CODE_64bit5 { sub setup_random_from_rndseed { my ($rndseed)=@_; if ($rndseed =~/([,:])/) { - my ($num1,$num2)=split(/[,:]/,$rndseed); - &Math::Random::random_set_seed(abs($num1),abs($num2)); + my ($num1,$num2) = map { abs($_); } (split(/[,:]/,$rndseed)); + if ((!$num1) || (!$num2) || ($num1 > 2147483562) || ($num2 > 2147483398)) { + &Math::Random::random_set_seed_from_phrase($rndseed); + } else { + &Math::Random::random_set_seed($num1,$num2); + } } else { &Math::Random::random_set_seed_from_phrase($rndseed); } @@ -11643,7 +11677,9 @@ sub default_login_domain { sub declutter { my $thisfn=shift; if ($thisfn=~m|^/enc/|) { $thisfn=&Apache::lonenc::unencrypted($thisfn); } - $thisfn=~s/^\Q$perlvar{'lonDocRoot'}\E//; + unless ($thisfn=~m{^/home/httpd/html/priv/}) { + $thisfn=~s{^/home/httpd/html}{}; + } $thisfn=~s/^\///; $thisfn=~s|^adm/wrapper/||; $thisfn=~s|^adm/coursedocs/showdoc/||; @@ -11823,7 +11859,7 @@ sub parse_dns_checksums_tab { sub fetch_dns_checksums { my %checksums; my $machine_dom = &Apache::lonnet::host_domain($perlvar{'lonHostID'}); - my $loncaparev = &get_server_loncaparev($machine_dom); + my $loncaparev = &get_server_loncaparev($machine_dom,$perlvar{'lonHostID'}); my ($release,$timestamp) = split(/\-/,$loncaparev); &get_dns("/adm/dns/checksums/$release",\&parse_dns_checksums_tab,1,1, \%checksums); @@ -13612,7 +13648,8 @@ filelocation except for hrefs =item * -declutter() : declutters URLs (remove docroot, beginning slashes, 'res' etc) +declutter() : declutters URLs -- remove beginning slashes, 'res' etc. +also removes beginning /home/httpd/html unless /priv/ follows it. =back