version 1.664, 2005/10/14 19:08:42
|
version 1.670, 2005/10/28 21:51:50
|
Line 443 sub overloaderror {
|
Line 443 sub overloaderror {
|
# ------------------------------ Find server with least workload from spare.tab |
# ------------------------------ Find server with least workload from spare.tab |
|
|
sub spareserver { |
sub spareserver { |
my ($loadpercent,$userloadpercent) = @_; |
my ($loadpercent,$userloadpercent,$want_server_name) = @_; |
my $tryserver; |
my $tryserver; |
my $spareserver=''; |
my $spareserver=''; |
if ($userloadpercent !~ /\d/) { $userloadpercent=0; } |
if ($userloadpercent !~ /\d/) { $userloadpercent=0; } |
my $lowestserver=$loadpercent > $userloadpercent? |
my $lowestserver=$loadpercent > $userloadpercent? |
$loadpercent : $userloadpercent; |
$loadpercent : $userloadpercent; |
foreach $tryserver (keys %spareid) { |
foreach $tryserver (keys(%spareid)) { |
my $loadans=reply('load',$tryserver); |
my $loadans=&reply('load',$tryserver); |
my $userloadans=reply('userload',$tryserver); |
my $userloadans=&reply('userload',$tryserver); |
if ($loadans !~ /\d/ && $userloadans !~ /\d/) { |
if ($loadans !~ /\d/ && $userloadans !~ /\d/) { |
next; #didn't get a number from the server |
next; #didn't get a number from the server |
} |
} |
Line 468 sub spareserver {
|
Line 468 sub spareserver {
|
$answer = $userloadans; |
$answer = $userloadans; |
} |
} |
if (($answer =~ /\d/) && ($answer<$lowestserver)) { |
if (($answer =~ /\d/) && ($answer<$lowestserver)) { |
$spareserver="http://$hostname{$tryserver}"; |
if ($want_server_name) { |
|
$spareserver=$tryserver; |
|
} else { |
|
$spareserver="http://$hostname{$tryserver}"; |
|
} |
$lowestserver=$answer; |
$lowestserver=$answer; |
} |
} |
} |
} |
Line 1176 sub process_coursefile {
|
Line 1180 sub process_coursefile {
|
$fetchresult= &reply('fetchuserfile:'.$docudom.'/'.$docuname.'/'.$file, |
$fetchresult= &reply('fetchuserfile:'.$docudom.'/'.$docuname.'/'.$file, |
$home); |
$home); |
} else { |
} else { |
my $fetchresult = ''; |
|
my $fpath = ''; |
my $fpath = ''; |
my $fname = $file; |
my $fname = $file; |
($fpath,$fname) = ($file =~ m|^(.*)/([^/]+)$|); |
($fpath,$fname) = ($file =~ m|^(.*)/([^/]+)$|); |
Line 2955 sub eget {
|
Line 2958 sub eget {
|
return %returnhash; |
return %returnhash; |
} |
} |
|
|
|
# ------------------------------------------------------------ tmpput interface |
|
sub tmpput { |
|
my ($storehash,$server)=@_; |
|
my $items=''; |
|
foreach (keys(%$storehash)) { |
|
$items.=&escape($_).'='.&freeze_escape($$storehash{$_}).'&'; |
|
} |
|
$items=~s/\&$//; |
|
return &reply("tmpput:$items",$server); |
|
} |
|
|
|
# ------------------------------------------------------------ tmpget interface |
|
sub tmpget { |
|
my ($token)=@_; |
|
my $rep=&reply("tmpget:$token",$perlvar{'lonHostID'}); |
|
my %returnhash; |
|
foreach my $item (split(/\&/,$rep)) { |
|
my ($key,$value)=split(/=/,$item); |
|
$returnhash{&unescape($key)}=&thaw_unescape($value); |
|
} |
|
return %returnhash; |
|
} |
|
|
# ---------------------------------------------- Custom access rule evaluation |
# ---------------------------------------------- Custom access rule evaluation |
|
|
sub customaccess { |
sub customaccess { |
Line 3076 sub allowed {
|
Line 3102 sub allowed {
|
$thisallowed.=$1; |
$thisallowed.=$1; |
} |
} |
|
|
# URI is an uploaded document for this course |
# URI is an uploaded document for this course, default permissions don't matter |
# not allowing 'edit' access (editupload) to uploaded course docs |
# not allowing 'edit' access (editupload) to uploaded course docs |
if (($priv eq 'bre') && ($uri=~m|^uploaded/|)) { |
if (($priv eq 'bre') && ($uri=~m|^uploaded/|)) { |
|
$thisallowed=''; |
my $refuri=$env{'httpref.'.$orguri}; |
my $refuri=$env{'httpref.'.$orguri}; |
if ($refuri) { |
if ($refuri) { |
if ($refuri =~ m|^/adm/|) { |
if ($refuri =~ m|^/adm/|) { |
$thisallowed='F'; |
$thisallowed='F'; |
|
} else { |
|
$refuri=&declutter($refuri); |
|
my ($match) = &is_on_map($refuri); |
|
if ($match) { |
|
$thisallowed='F'; |
|
} |
} |
} |
|
} else { |
|
$thisallowed=''; |
} |
} |
} |
} |
|
|
Line 5786 sub filelocation {
|
Line 5821 sub filelocation {
|
sub hreflocation { |
sub hreflocation { |
my ($dir,$file)=@_; |
my ($dir,$file)=@_; |
unless (($file=~m-^http://-i) || ($file=~m-^/-)) { |
unless (($file=~m-^http://-i) || ($file=~m-^/-)) { |
my $finalpath=filelocation($dir,$file); |
$file=filelocation($dir,$file); |
$finalpath=~s-^/home/httpd/html--; |
} |
$finalpath=~s-^/home/(\w+)/public_html/-/~$1/-; |
if ($file=~m-^\Q$perlvar{'lonDocRoot'}\E-) { |
return $finalpath; |
$file=~s-^\Q$perlvar{'lonDocRoot'}\E--; |
} elsif ($file=~m-^/home-) { |
} elsif ($file=~m-/home/(\w+)/public_html/-) { |
$file=~s-^/home/httpd/html--; |
|
$file=~s-^/home/(\w+)/public_html/-/~$1/-; |
$file=~s-^/home/(\w+)/public_html/-/~$1/-; |
return $file; |
} elsif ($file=~m-^\Q$perlvar{'lonUsersDir'}\E-) { |
|
$file=~s-^/home/httpd/lonUsers/([^/]*)/./././([^/]*)/userfiles/ |
|
-/uploaded/$1/$2/-x; |
} |
} |
return $file; |
return $file; |
} |
} |