version 1.1172.2.52, 2014/06/25 18:44:10
|
version 1.1172.2.61, 2015/03/30 21:58:56
|
Line 1174 sub spare_can_host {
|
Line 1174 sub spare_can_host {
|
my ($udom,$uint_dom,$remotesessions,$try_server)=@_; |
my ($udom,$uint_dom,$remotesessions,$try_server)=@_; |
my $canhost=1; |
my $canhost=1; |
my @intdoms; |
my @intdoms; |
my $internet_names = &Apache::lonnet::get_internet_names($try_server); |
my $internet_names = &get_internet_names($try_server); |
if (ref($internet_names) eq 'ARRAY') { |
if (ref($internet_names) eq 'ARRAY') { |
@intdoms = @{$internet_names}; |
@intdoms = @{$internet_names}; |
} |
} |
unless (grep(/^\Q$uint_dom\E$/,@intdoms)) { |
unless (grep(/^\Q$uint_dom\E$/,@intdoms)) { |
my $serverhomeID = &Apache::lonnet::get_server_homeID($try_server); |
my $try_server_hostname = &hostname($try_server); |
my $serverhomedom = &Apache::lonnet::host_domain($serverhomeID); |
my $serverhomeID = &get_server_homeID($try_server_hostname); |
my %defdomdefaults = &Apache::lonnet::get_domain_defaults($serverhomedom); |
my $serverhomedom = &host_domain($serverhomeID); |
my $remoterev = &Apache::lonnet::get_server_loncaparev(undef,$try_server); |
my %defdomdefaults = &get_domain_defaults($serverhomedom); |
|
my $remoterev = &get_server_loncaparev(undef,$try_server); |
$canhost = &can_host_session($udom,$try_server,$remoterev, |
$canhost = &can_host_session($udom,$try_server,$remoterev, |
$remotesessions, |
$remotesessions, |
$defdomdefaults{'hostedsessions'}); |
$defdomdefaults{'hostedsessions'}); |
Line 1647 sub dump_dom {
|
Line 1648 sub dump_dom {
|
|
|
sub get_dom { |
sub get_dom { |
my ($namespace,$storearr,$udom,$uhome)=@_; |
my ($namespace,$storearr,$udom,$uhome)=@_; |
|
return if ($udom eq 'public'); |
my $items=''; |
my $items=''; |
foreach my $item (@$storearr) { |
foreach my $item (@$storearr) { |
$items.=&escape($item).'&'; |
$items.=&escape($item).'&'; |
Line 1654 sub get_dom {
|
Line 1656 sub get_dom {
|
$items=~s/\&$//; |
$items=~s/\&$//; |
if (!$udom) { |
if (!$udom) { |
$udom=$env{'user.domain'}; |
$udom=$env{'user.domain'}; |
|
return if ($udom eq 'public'); |
if (defined(&domain($udom,'primary'))) { |
if (defined(&domain($udom,'primary'))) { |
$uhome=&domain($udom,'primary'); |
$uhome=&domain($udom,'primary'); |
} else { |
} else { |
Line 2068 sub get_domain_defaults {
|
Line 2071 sub get_domain_defaults {
|
} |
} |
} |
} |
if (ref($domconfig{'coursedefaults'}) eq 'HASH') { |
if (ref($domconfig{'coursedefaults'}) eq 'HASH') { |
|
$domdefaults{'usejsme'} = $domconfig{'coursedefaults'}{'usejsme'}; |
|
$domdefaults{'uselcmath'} = $domconfig{'coursedefaults'}{'uselcmath'}; |
|
if (ref($domconfig{'coursedefaults'}{'postsubmit'}) eq 'HASH') { |
|
$domdefaults{'postsubmit'} = $domconfig{'coursedefaults'}{'postsubmit'}{'client'}; |
|
} |
foreach my $type (@coursetypes) { |
foreach my $type (@coursetypes) { |
if (ref($domconfig{'coursedefaults'}{'coursecredits'}) eq 'HASH') { |
if (ref($domconfig{'coursedefaults'}{'coursecredits'}) eq 'HASH') { |
unless ($type eq 'community') { |
unless ($type eq 'community') { |
Line 2077 sub get_domain_defaults {
|
Line 2085 sub get_domain_defaults {
|
if (ref($domconfig{'coursedefaults'}{'uploadquota'}) eq 'HASH') { |
if (ref($domconfig{'coursedefaults'}{'uploadquota'}) eq 'HASH') { |
$domdefaults{$type.'quota'} = $domconfig{'coursedefaults'}{'uploadquota'}{$type}; |
$domdefaults{$type.'quota'} = $domconfig{'coursedefaults'}{'uploadquota'}{$type}; |
} |
} |
|
if ($domdefaults{'postsubmit'} eq 'on') { |
|
if (ref($domconfig{'coursedefaults'}{'postsubmit'}{'timeout'}) eq 'HASH') { |
|
$domdefaults{$type.'postsubtimeout'} = |
|
$domconfig{'coursedefaults'}{'postsubmit'}{'timeout'}{$type}; |
|
} |
|
} |
} |
} |
} |
} |
if (ref($domconfig{'usersessions'}) eq 'HASH') { |
if (ref($domconfig{'usersessions'}) eq 'HASH') { |
Line 2715 sub ssi {
|
Line 2729 sub ssi {
|
&Apache::lonenc::check_encrypt(\$fn); |
&Apache::lonenc::check_encrypt(\$fn); |
if (%form) { |
if (%form) { |
$request=new HTTP::Request('POST',&absolute_url().$fn); |
$request=new HTTP::Request('POST',&absolute_url().$fn); |
$request->content(join('&',map { &escape($_).'='.&escape($form{$_}) } keys(%form))); |
$request->content(join('&',map { |
|
my $name = escape($_); |
|
"$name=" . ( ref($form{$_}) eq 'ARRAY' |
|
? join("&$name=", map {escape($_) } @{$form{$_}}) |
|
: &escape($form{$_}) ); |
|
} keys(%form))); |
} else { |
} else { |
$request=new HTTP::Request('GET',&absolute_url().$fn); |
$request=new HTTP::Request('GET',&absolute_url().$fn); |
} |
} |
Line 5175 sub privileged {
|
Line 5194 sub privileged {
|
my %rolesdump = &dump("roles", $domain, $username) or return 0; |
my %rolesdump = &dump("roles", $domain, $username) or return 0; |
my $now = time; |
my $now = time; |
|
|
for my $role (@rolesdump{grep { ! /^rolesdef_/ } keys %rolesdump}) { |
for my $role (@rolesdump{grep { ! /^rolesdef_/ } keys(%rolesdump)}) { |
my ($trole, $tend, $tstart) = split(/_/, $role); |
my ($trole, $tend, $tstart) = split(/_/, $role); |
if (grep(/^\Q$trole\E$/,@{$roles})) { |
if (grep(/^\Q$trole\E$/,@{$roles})) { |
return 1 unless ($tend && $tend < $now) |
return 1 unless ($tend && $tend < $now) |
Line 5264 sub rolesinit {
|
Line 5283 sub rolesinit {
|
my %allroles=(); |
my %allroles=(); |
my %allgroups=(); |
my %allgroups=(); |
|
|
for my $area (grep { ! /^rolesdef_/ } keys %rolesdump) { |
for my $area (grep { ! /^rolesdef_/ } keys(%rolesdump)) { |
my $role = $rolesdump{$area}; |
my $role = $rolesdump{$area}; |
$area =~ s/\_\w\w$//; |
$area =~ s/\_\w\w$//; |
|
|
Line 5704 sub dump {
|
Line 5723 sub dump {
|
if (!$uname) { $uname=$env{'user.name'}; } |
if (!$uname) { $uname=$env{'user.name'}; } |
my $uhome=&homeserver($uname,$udomain); |
my $uhome=&homeserver($uname,$udomain); |
|
|
my $reply; |
if ($regexp) { |
|
$regexp=&escape($regexp); |
|
} else { |
|
$regexp='.'; |
|
} |
if (grep { $_ eq $uhome } ¤t_machine_ids()) { |
if (grep { $_ eq $uhome } ¤t_machine_ids()) { |
# user is hosted on this machine |
# user is hosted on this machine |
$reply = LONCAPA::Lond::dump_with_regexp(join(':', ($udomain, |
my $reply = LONCAPA::Lond::dump_with_regexp(join(':', ($udomain, |
$uname, $namespace, $regexp, $range)), $perlvar{'lonVersion'}); |
$uname, $namespace, $regexp, $range)), $perlvar{'lonVersion'}); |
return %{&unserialize($reply, $escapedkeys)}; |
return %{&unserialize($reply, $escapedkeys)}; |
} |
} |
if ($regexp) { |
|
$regexp=&escape($regexp); |
|
} else { |
|
$regexp='.'; |
|
} |
|
my $rep=&reply("dump:$udomain:$uname:$namespace:$regexp:$range",$uhome); |
my $rep=&reply("dump:$udomain:$uname:$namespace:$regexp:$range",$uhome); |
my @pairs=split(/\&/,$rep); |
my @pairs=split(/\&/,$rep); |
my %returnhash=(); |
my %returnhash=(); |
Line 5892 sub newput {
|
Line 5910 sub newput {
|
# --------------------------------------------------------- putstore interface |
# --------------------------------------------------------- putstore interface |
|
|
sub putstore { |
sub putstore { |
my ($namespace,$symb,$version,$storehash,$udomain,$uname)=@_; |
my ($namespace,$symb,$version,$storehash,$udomain,$uname,$tolog)=@_; |
if (!$udomain) { $udomain=$env{'user.domain'}; } |
if (!$udomain) { $udomain=$env{'user.domain'}; } |
if (!$uname) { $uname=$env{'user.name'}; } |
if (!$uname) { $uname=$env{'user.name'}; } |
my $uhome=&homeserver($uname,$udomain); |
my $uhome=&homeserver($uname,$udomain); |
Line 5906 sub putstore {
|
Line 5924 sub putstore {
|
my $reply = |
my $reply = |
&reply("putstore:$udomain:$uname:$namespace:$esc_symb:$esc_v:$items", |
&reply("putstore:$udomain:$uname:$namespace:$esc_symb:$esc_v:$items", |
$uhome); |
$uhome); |
|
if (($tolog) && ($reply eq 'ok')) { |
|
my $namevalue=''; |
|
foreach my $key (keys(%{$storehash})) { |
|
$namevalue.=&escape($key).'='.&freeze_escape($storehash->{$key}).'&'; |
|
} |
|
$namevalue .= 'ip='.&escape($ENV{'REMOTE_ADDR'}). |
|
'&host='.&escape($perlvar{'lonHostID'}). |
|
'&version='.$esc_v. |
|
'&by='.&escape($env{'user.name'}.':'.$env{'user.domain'}); |
|
&Apache::lonnet::courselog($symb.':'.$uname.':'.$udomain.':PUTSTORE:'.$namevalue); |
|
} |
if ($reply eq 'unknown_cmd') { |
if ($reply eq 'unknown_cmd') { |
# gfall back to way things use to be done |
# gfall back to way things use to be done |
return &old_putstore($namespace,$symb,$version,$storehash,$udomain, |
return &old_putstore($namespace,$symb,$version,$storehash,$udomain, |
Line 6064 sub get_timebased_id {
|
Line 6093 sub get_timebased_id {
|
my %inuse = &Apache::lonnet::dump('nohist_'.$namespace,$cdom,$cnum,$prefix); |
my %inuse = &Apache::lonnet::dump('nohist_'.$namespace,$cdom,$cnum,$prefix); |
my $id = time; |
my $id = time; |
$newid = $id; |
$newid = $id; |
|
if ($idtype eq 'addcode') { |
|
$newid .= &sixnum_code(); |
|
} |
my $idtries = 0; |
my $idtries = 0; |
while (exists($inuse{$prefix."\0".$newid}) && $idtries < $maxtries) { |
while (exists($inuse{$prefix."\0".$newid}) && $idtries < $maxtries) { |
if ($idtype eq 'concat') { |
if ($idtype eq 'concat') { |
$newid = $id.$idtries; |
$newid = $id.$idtries; |
|
} elsif ($idtype eq 'addcode') { |
|
$newid = $newid.&sixnum_code(); |
} else { |
} else { |
$newid ++; |
$newid ++; |
} |
} |
Line 6084 sub get_timebased_id {
|
Line 6118 sub get_timebased_id {
|
$error = 'error saving new item: '.$putresult; |
$error = 'error saving new item: '.$putresult; |
} |
} |
} else { |
} else { |
|
undef($newid); |
$error = ('error: no unique suffix available for the new item '); |
$error = ('error: no unique suffix available for the new item '); |
} |
} |
# remove lock |
# remove lock |
Line 6092 sub get_timebased_id {
|
Line 6127 sub get_timebased_id {
|
} else { |
} else { |
$error = "error: could not obtain lockfile\n"; |
$error = "error: could not obtain lockfile\n"; |
$dellock = 'ok'; |
$dellock = 'ok'; |
|
if (($prefix eq 'paste') && ($namespace eq 'courseeditor') && ($keyid eq 'num')) { |
|
$dellock = 'nolock'; |
|
} |
} |
} |
return ($newid,$dellock,$error); |
return ($newid,$dellock,$error); |
} |
} |
|
|
|
sub sixnum_code { |
|
my $code; |
|
for (0..6) { |
|
$code .= int( rand(9) ); |
|
} |
|
return $code; |
|
} |
|
|
# -------------------------------------------------- portfolio access checking |
# -------------------------------------------------- portfolio access checking |
|
|
sub portfolio_access { |
sub portfolio_access { |
Line 10558 sub metadata {
|
Line 10604 sub metadata {
|
|
|
$metaentry{':keys'} = join(',',keys(%metathesekeys)); |
$metaentry{':keys'} = join(',',keys(%metathesekeys)); |
&metadata_generate_part0(\%metathesekeys,\%metaentry,$uri); |
&metadata_generate_part0(\%metathesekeys,\%metaentry,$uri); |
$metaentry{':allpossiblekeys'}=join(',',keys %metathesekeys); |
$metaentry{':allpossiblekeys'}=join(',',keys(%metathesekeys)); |
&do_cache_new('meta',$uri,\%metaentry,$cachetime); |
&do_cache_new('meta',$uri,\%metaentry,$cachetime); |
# this is the end of "was not already recently cached |
# this is the end of "was not already recently cached |
} |
} |
Line 10930 sub deversion {
|
Line 10976 sub deversion {
|
|
|
sub symbread { |
sub symbread { |
my ($thisfn,$donotrecurse)=@_; |
my ($thisfn,$donotrecurse)=@_; |
my $cache_str; |
my $cache_str='request.symbread.cached.'.$thisfn; |
if ($thisfn ne '') { |
if (defined($env{$cache_str})) { return $env{$cache_str}; } |
$cache_str='request.symbread.cached.'.$thisfn; |
|
if ($env{$cache_str} ne '') { |
|
return $env{$cache_str}; |
|
} |
|
} else { |
|
# no filename provided? try from environment |
# no filename provided? try from environment |
|
unless ($thisfn) { |
if ($env{'request.symb'}) { |
if ($env{'request.symb'}) { |
return $env{$cache_str}=&symbclean($env{'request.symb'}); |
return $env{$cache_str}=&symbclean($env{'request.symb'}); |
} |
} |
Line 11905 sub get_dns {
|
Line 11947 sub get_dns {
|
# ------------------------------------------------------Get DNS checksums file |
# ------------------------------------------------------Get DNS checksums file |
sub parse_dns_checksums_tab { |
sub parse_dns_checksums_tab { |
my ($lines,$hashref) = @_; |
my ($lines,$hashref) = @_; |
my $machine_dom = &Apache::lonnet::host_domain($perlvar{'lonHostID'}); |
my $lonhost = $perlvar{'lonHostID'}; |
|
my $machine_dom = &Apache::lonnet::host_domain($lonhost); |
my $loncaparev = &get_server_loncaparev($machine_dom); |
my $loncaparev = &get_server_loncaparev($machine_dom); |
|
my $distro = (split(/\:/,&get_server_distarch($lonhost)))[0]; |
|
my $webconfdir = '/etc/httpd/conf'; |
|
if ($distro =~ /^(ubuntu|debian)(\d+)$/) { |
|
$webconfdir = '/etc/apache2'; |
|
} elsif ($distro =~ /^sles(\d+)$/) { |
|
if ($1 >= 10) { |
|
$webconfdir = '/etc/apache2'; |
|
} |
|
} elsif ($distro =~ /^suse(\d+\.\d+)$/) { |
|
if ($1 >= 10.0) { |
|
$webconfdir = '/etc/apache2'; |
|
} |
|
} |
my ($release,$timestamp) = split(/\-/,$loncaparev); |
my ($release,$timestamp) = split(/\-/,$loncaparev); |
my (%chksum,%revnum); |
my (%chksum,%revnum); |
if (ref($lines) eq 'ARRAY') { |
if (ref($lines) eq 'ARRAY') { |
Line 11915 sub parse_dns_checksums_tab {
|
Line 11971 sub parse_dns_checksums_tab {
|
if ($version eq $release) { |
if ($version eq $release) { |
foreach my $line (@{$lines}) { |
foreach my $line (@{$lines}) { |
my ($file,$version,$shasum) = split(/,/,$line); |
my ($file,$version,$shasum) = split(/,/,$line); |
|
if ($file =~ m{^/etc/httpd/conf}) { |
|
if ($webconfdir eq '/etc/apache2') { |
|
$file =~ s{^\Q/etc/httpd/conf/\E}{$webconfdir/}; |
|
} |
|
} |
$chksum{$file} = $shasum; |
$chksum{$file} = $shasum; |
$revnum{$file} = $version; |
$revnum{$file} = $version; |
} |
} |
Line 13299 $range should be either an integer '100'
|
Line 13360 $range should be either an integer '100'
|
|
|
=item * |
=item * |
|
|
putstore($namespace,$symb,$version,$storehash,$udomain,$uname) : |
putstore($namespace,$symb,$version,$storehash,$udomain,$uname,$tolog) : |
replaces a &store() version of data with a replacement set of data |
replaces a &store() version of data with a replacement set of data |
for a particular resource in a namespace passed in the $storehash hash |
for a particular resource in a namespace passed in the $storehash hash |
reference |
reference. If $tolog is true, the transaction is logged in the courselog |
|
with an action=PUTSTORE. |
|
|
=item * |
=item * |
|
|