version 1.1056.2.2, 2010/03/26 21:27:41
|
version 1.1061, 2010/05/03 16:41:57
|
Line 665 sub userload {
|
Line 665 sub userload {
|
return $userloadpercent; |
return $userloadpercent; |
} |
} |
|
|
# ------------------------------------------ Fight off request when overloaded |
|
|
|
sub overloaderror { |
|
my ($r,$checkserver)=@_; |
|
unless ($checkserver) { $checkserver=$perlvar{'lonHostID'}; } |
|
my $loadavg; |
|
if ($checkserver eq $perlvar{'lonHostID'}) { |
|
open(my $loadfile,'/proc/loadavg'); |
|
$loadavg=<$loadfile>; |
|
$loadavg =~ s/\s.*//g; |
|
$loadavg = 100*$loadavg/$perlvar{'lonLoadLim'}; |
|
close($loadfile); |
|
} else { |
|
$loadavg=&reply('load',$checkserver); |
|
} |
|
my $overload=$loadavg-100; |
|
if ($overload>0) { |
|
$r->err_headers_out->{'Retry-After'}=$overload; |
|
$r->log_error('Overload of '.$overload.' on '.$checkserver); |
|
return 413; |
|
} |
|
return ''; |
|
} |
|
|
|
# ------------------------------ Find server with least workload from spare.tab |
# ------------------------------ Find server with least workload from spare.tab |
|
|
sub spareserver { |
sub spareserver { |
Line 3207 sub get_domain_roles {
|
Line 3183 sub get_domain_roles {
|
return %personnel; |
return %personnel; |
} |
} |
|
|
# ----------------------------------------------------------- Check out an item |
# ----------------------------------------------------------- Interval timing |
|
|
sub get_first_access { |
sub get_first_access { |
my ($type,$argsymb)=@_; |
my ($type,$argsymb)=@_; |
Line 3243 sub set_first_access {
|
Line 3219 sub set_first_access {
|
return 'already_set'; |
return 'already_set'; |
} |
} |
|
|
sub checkout { |
|
my ($symb,$tuname,$tudom,$tcrsid)=@_; |
|
my $now=time; |
|
my $lonhost=$perlvar{'lonHostID'}; |
|
my $infostr=&escape( |
|
'CHECKOUTTOKEN&'. |
|
$tuname.'&'. |
|
$tudom.'&'. |
|
$tcrsid.'&'. |
|
$symb.'&'. |
|
$now.'&'.$ENV{'REMOTE_ADDR'}); |
|
my $token=&reply('tmpput:'.$infostr,$lonhost); |
|
if ($token=~/^error\:/) { |
|
&logthis("<font color=\"blue\">WARNING: ". |
|
"Checkout tmpput failed ".$tudom.' - '.$tuname.' - '.$symb. |
|
"</font>"); |
|
return ''; |
|
} |
|
|
|
$token=~s/^(\d+)\_.*\_(\d+)$/$1\*$2\*$lonhost/; |
|
$token=~tr/a-z/A-Z/; |
|
|
|
my %infohash=('resource.0.outtoken' => $token, |
|
'resource.0.checkouttime' => $now, |
|
'resource.0.outremote' => $ENV{'REMOTE_ADDR'}); |
|
|
|
unless (&cstore(\%infohash,$symb,$tcrsid,$tudom,$tuname) eq 'ok') { |
|
return ''; |
|
} else { |
|
&logthis("<font color=\"blue\">WARNING: ". |
|
"Checkout cstore failed ".$tudom.' - '.$tuname.' - '.$symb. |
|
"</font>"); |
|
} |
|
|
|
if (&log($tudom,$tuname,&homeserver($tuname,$tudom), |
|
&escape('Checkout '.$infostr.' - '. |
|
$token)) ne 'ok') { |
|
return ''; |
|
} else { |
|
&logthis("<font color=\"blue\">WARNING: ". |
|
"Checkout log failed ".$tudom.' - '.$tuname.' - '.$symb. |
|
"</font>"); |
|
} |
|
return $token; |
|
} |
|
|
|
# ------------------------------------------------------------ Check in an item |
|
|
|
sub checkin { |
|
my $token=shift; |
|
my $now=time; |
|
my ($ta,$tb,$lonhost)=split(/\*/,$token); |
|
$lonhost=~tr/A-Z/a-z/; |
|
my $dtoken=$ta.'_'.&hostname($lonhost).'_'.$tb; |
|
$dtoken=~s/\W/\_/g; |
|
my ($dummy,$tuname,$tudom,$tcrsid,$symb,$chtim,$rmaddr)= |
|
split(/\&/,&unescape(&reply('tmpget:'.$dtoken,$lonhost))); |
|
|
|
unless (($tuname) && ($tudom)) { |
|
&logthis('Check in '.$token.' ('.$dtoken.') failed'); |
|
return ''; |
|
} |
|
|
|
unless (&allowed('mgr',$tcrsid)) { |
|
&logthis('Check in '.$token.' ('.$dtoken.') unauthorized: '. |
|
$env{'user.name'}.' - '.$env{'user.domain'}); |
|
return ''; |
|
} |
|
|
|
my %infohash=('resource.0.intoken' => $token, |
|
'resource.0.checkintime' => $now, |
|
'resource.0.inremote' => $ENV{'REMOTE_ADDR'}); |
|
|
|
unless (&cstore(\%infohash,$symb,$tcrsid,$tudom,$tuname) eq 'ok') { |
|
return ''; |
|
} |
|
|
|
if (&log($tudom,$tuname,&homeserver($tuname,$tudom), |
|
&escape('Checkin - '.$token)) ne 'ok') { |
|
return ''; |
|
} |
|
|
|
return ($symb,$tuname,$tudom,$tcrsid); |
|
} |
|
|
|
# --------------------------------------------- Set Expire Date for Spreadsheet |
# --------------------------------------------- Set Expire Date for Spreadsheet |
|
|
sub expirespread { |
sub expirespread { |
Line 6602 sub modifyuser {
|
Line 6493 sub modifyuser {
|
# |
# |
# If name, email and/or uid are blank (e.g., because an uploaded file |
# If name, email and/or uid are blank (e.g., because an uploaded file |
# of users did not contain them), do not overwrite existing values |
# of users did not contain them), do not overwrite existing values |
# unless field is in $candelete array ref. |
# unless field is in $candelete array ref. |
# |
# |
|
|
my @fields = ('firstname','middlename','lastname','generation', |
my @fields = ('firstname','middlename','lastname','generation', |
'permanentemail','id'); |
'permanentemail','id'); |
my %newvalues; |
my %newvalues; |
Line 6616 sub modifyuser {
|
Line 6508 sub modifyuser {
|
$names{$field} = $middle; |
$names{$field} = $middle; |
} elsif ($field eq 'lastname') { |
} elsif ($field eq 'lastname') { |
$names{$field} = $last; |
$names{$field} = $last; |
} elsif ($field eq 'generation') { |
} elsif ($field eq 'generation') { |
$names{$field} = $gene; |
$names{$field} = $gene; |
} elsif ($field eq 'permanentemail') { |
} elsif ($field eq 'permanentemail') { |
$names{$field} = $email; |
$names{$field} = $email; |
Line 6626 sub modifyuser {
|
Line 6518 sub modifyuser {
|
} |
} |
} |
} |
} |
} |
|
|
if ($first) { $names{'firstname'} = $first; } |
if ($first) { $names{'firstname'} = $first; } |
if (defined($middle)) { $names{'middlename'} = $middle; } |
if (defined($middle)) { $names{'middlename'} = $middle; } |
if ($last) { $names{'lastname'} = $last; } |
if ($last) { $names{'lastname'} = $last; } |
Line 10359 modifyuser($udom,$uname,$uid,$umode,$upa
|
Line 10250 modifyuser($udom,$uname,$uid,$umode,$upa
|
will update user information (firstname,middlename,lastname,generation, |
will update user information (firstname,middlename,lastname,generation, |
permanentemail), and if forceid is true, student/employee ID also. |
permanentemail), and if forceid is true, student/employee ID also. |
A user's institutional affiliation(s) can also be updated. |
A user's institutional affiliation(s) can also be updated. |
User information fields will not be overwritten with empty entries |
User information fields will not be overwritten with empty entries |
unless the field is included in the $candelete array reference. |
unless the field is included in the $candelete array reference. |
This array is included when a single user is modified via "Manage Users", |
This array is included when a single user is modified via "Manage Users", |
or when Autoupdate.pl is run by cron in a domain. |
or when Autoupdate.pl is run by cron in a domain. |