version 1.1243, 2013/10/14 17:14:48
|
version 1.1262, 2014/06/13 03:33:55
|
Line 78 use Image::Magick;
|
Line 78 use Image::Magick;
|
|
|
use Encode; |
use Encode; |
|
|
use vars qw(%perlvar %spareid %pr %prp $memcache %packagetab $tmpdir $apache |
use vars qw(%perlvar %spareid %pr %prp $memcache %packagetab $tmpdir |
$_64bit %env %protocol %loncaparevs %serverhomeIDs %needsrelease |
$_64bit %env %protocol %loncaparevs %serverhomeIDs %needsrelease |
%managerstab); |
%managerstab); |
|
|
Line 606 sub transfer_profile_to_env {
|
Line 606 sub transfer_profile_to_env {
|
|
|
# ---------------------------------------------------- Check for valid session |
# ---------------------------------------------------- Check for valid session |
sub check_for_valid_session { |
sub check_for_valid_session { |
my ($r,$name) = @_; |
my ($r,$name,$userhashref) = @_; |
my %cookies=CGI::Cookie->parse($r->header_in('Cookie')); |
my %cookies=CGI::Cookie->parse($r->header_in('Cookie')); |
if ($name eq '') { |
if ($name eq '') { |
$name = 'lonID'; |
$name = 'lonID'; |
Line 637 sub check_for_valid_session {
|
Line 637 sub check_for_valid_session {
|
|| !defined($disk_env{'user.domain'})) { |
|| !defined($disk_env{'user.domain'})) { |
return undef; |
return undef; |
} |
} |
if (($r->user() eq '') && ($apache >= 2.4)) { |
|
if ($disk_env{'user.domain'} eq $r->dir_config('lonDefDomain')) { |
if (ref($userhashref) eq 'HASH') { |
$r->user($disk_env{'user.name'}); |
$userhashref->{'name'} = $disk_env{'user.name'}; |
} else { |
$userhashref->{'domain'} = $disk_env{'user.domain'}; |
$r->user($disk_env{'user.name'}.':'.$disk_env{'user.domain'}); |
|
} |
|
} |
} |
|
|
return $handle; |
return $handle; |
} |
} |
|
|
Line 677 sub appenv {
|
Line 676 sub appenv {
|
if (($key =~ /^user\.role/) || ($key =~ /^user\.priv/)) { |
if (($key =~ /^user\.role/) || ($key =~ /^user\.priv/)) { |
$refused = 1; |
$refused = 1; |
if (ref($roles) eq 'ARRAY') { |
if (ref($roles) eq 'ARRAY') { |
my ($type,$role) = ($key =~ /^user\.(role|priv)\.([^.]+)\./); |
my ($type,$role) = ($key =~ m{^user\.(role|priv)\.(.+?)\./}); |
if (grep(/^\Q$role\E$/,@{$roles})) { |
if (grep(/^\Q$role\E$/,@{$roles})) { |
$refused = 0; |
$refused = 0; |
} |
} |
Line 891 sub spareserver {
|
Line 890 sub spareserver {
|
} |
} |
|
|
sub compare_server_load { |
sub compare_server_load { |
my ($try_server, $spare_server, $lowest_load) = @_; |
my ($try_server, $spare_server, $lowest_load, $required) = @_; |
|
|
|
if ($required) { |
|
my ($reqdmajor,$reqdminor) = ($required =~ /^(\d+)\.(\d+)$/); |
|
my $remoterev = &get_server_loncaparev(undef,$try_server); |
|
my ($major,$minor) = ($remoterev =~ /^\'?(\d+)\.(\d+)\.[\w.\-]+\'?$/); |
|
if (($major eq '' && $minor eq '') || |
|
(($reqdmajor > $major) || (($reqdmajor == $major) && ($reqdminor > $minor)))) { |
|
return ($spare_server,$lowest_load); |
|
} |
|
} |
|
|
my $loadans = &reply('load', $try_server); |
my $loadans = &reply('load', $try_server); |
my $userloadans = &reply('userload',$try_server); |
my $userloadans = &reply('userload',$try_server); |
Line 952 sub has_user_session {
|
Line 961 sub has_user_session {
|
# --------- determine least loaded server in a user's domain which allows login |
# --------- determine least loaded server in a user's domain which allows login |
|
|
sub choose_server { |
sub choose_server { |
my ($udom,$checkloginvia) = @_; |
my ($udom,$checkloginvia,$required,$skiploadbal) = @_; |
my %domconfhash = &Apache::loncommon::get_domainconf($udom); |
my %domconfhash = &Apache::loncommon::get_domainconf($udom); |
my %servers = &get_servers($udom); |
my %servers = &get_servers($udom); |
my $lowest_load = 30000; |
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)) { |
foreach my $lonhost (keys(%servers)) { |
|
if ($skiploadbal) { |
|
if (ref($balancers) eq 'HASH') { |
|
next if (exists($balancers->{$lonhost})); |
|
} |
|
} |
my $loginvia; |
my $loginvia; |
if ($checkloginvia) { |
if ($checkloginvia) { |
$loginvia = $domconfhash{$udom.'.login.loginvia_'.$lonhost}; |
$loginvia = $domconfhash{$udom.'.login.loginvia_'.$lonhost}; |
if ($loginvia) { |
if ($loginvia) { |
my ($server,$path) = split(/:/,$loginvia); |
my ($server,$path) = split(/:/,$loginvia); |
($login_host, $lowest_load) = |
($login_host, $lowest_load) = |
&compare_server_load($server, $login_host, $lowest_load); |
&compare_server_load($server, $login_host, $lowest_load, $required); |
if ($login_host eq $server) { |
if ($login_host eq $server) { |
$portal_path = $path; |
$portal_path = $path; |
$isredirect = 1; |
$isredirect = 1; |
} |
} |
} else { |
} else { |
($login_host, $lowest_load) = |
($login_host, $lowest_load) = |
&compare_server_load($lonhost, $login_host, $lowest_load); |
&compare_server_load($lonhost, $login_host, $lowest_load, $required); |
if ($login_host eq $lonhost) { |
if ($login_host eq $lonhost) { |
$portal_path = ''; |
$portal_path = ''; |
$isredirect = ''; |
$isredirect = ''; |
Line 979 sub choose_server {
|
Line 1005 sub choose_server {
|
} |
} |
} else { |
} else { |
($login_host, $lowest_load) = |
($login_host, $lowest_load) = |
&compare_server_load($lonhost, $login_host, $lowest_load); |
&compare_server_load($lonhost, $login_host, $lowest_load, $required); |
} |
} |
} |
} |
if ($login_host ne '') { |
if ($login_host ne '') { |
Line 1736 sub retrieve_inst_usertypes {
|
Line 1762 sub retrieve_inst_usertypes {
|
my %domdefs = &Apache::lonnet::get_domain_defaults($udom); |
my %domdefs = &Apache::lonnet::get_domain_defaults($udom); |
if ((ref($domdefs{'inststatustypes'}) eq 'HASH') && |
if ((ref($domdefs{'inststatustypes'}) eq 'HASH') && |
(ref($domdefs{'inststatusorder'}) eq 'ARRAY')) { |
(ref($domdefs{'inststatusorder'}) eq 'ARRAY')) { |
%returnhash = %{$domdefs{'inststatustypes'}}; |
return ($domdefs{'inststatustypes'},$domdefs{'inststatusorder'}); |
@order = @{$domdefs{'inststatusorder'}}; |
|
} else { |
} else { |
if (defined(&domain($udom,'primary'))) { |
if (defined(&domain($udom,'primary'))) { |
my $uhome=&domain($udom,'primary'); |
my $uhome=&domain($udom,'primary'); |
my $rep=&reply("inst_usertypes:$udom",$uhome); |
my $rep=&reply("inst_usertypes:$udom",$uhome); |
if ($rep =~ /^(con_lost|error|no_such_host|refused)/) { |
if ($rep =~ /^(con_lost|error|no_such_host|refused)/) { |
&logthis("get_dom failed - $rep returned from $uhome in domain: $udom"); |
&logthis("retrieve_inst_usertypes failed - $rep returned from $uhome in domain: $udom"); |
return (\%returnhash,\@order); |
return (\%returnhash,\@order); |
} |
} |
my ($hashitems,$orderitems) = split(/:/,$rep); |
my ($hashitems,$orderitems) = split(/:/,$rep); |
Line 1759 sub retrieve_inst_usertypes {
|
Line 1784 sub retrieve_inst_usertypes {
|
push(@order,&unescape($item)); |
push(@order,&unescape($item)); |
} |
} |
} else { |
} else { |
&logthis("get_dom failed - no primary domain server for $udom"); |
&logthis("retrieve_inst_usertypes failed - no primary domain server for $udom"); |
} |
} |
|
return (\%returnhash,\@order); |
} |
} |
return (\%returnhash,\@order); |
|
} |
} |
|
|
sub is_domainimage { |
sub is_domainimage { |
Line 2003 sub get_domain_defaults {
|
Line 2028 sub get_domain_defaults {
|
&Apache::lonnet::get_dom('configuration',['defaults','quotas', |
&Apache::lonnet::get_dom('configuration',['defaults','quotas', |
'requestcourses','inststatus', |
'requestcourses','inststatus', |
'coursedefaults','usersessions', |
'coursedefaults','usersessions', |
'requestauthor'],$domain); |
'requestauthor','selfenrollment', |
|
'coursecategories'],$domain); |
|
my @coursetypes = ('official','unofficial','community','textbook'); |
if (ref($domconfig{'defaults'}) eq 'HASH') { |
if (ref($domconfig{'defaults'}) eq 'HASH') { |
$domdefaults{'lang_def'} = $domconfig{'defaults'}{'lang_def'}; |
$domdefaults{'lang_def'} = $domconfig{'defaults'}{'lang_def'}; |
$domdefaults{'auth_def'} = $domconfig{'defaults'}{'auth_def'}; |
$domdefaults{'auth_def'} = $domconfig{'defaults'}{'auth_def'}; |
Line 2033 sub get_domain_defaults {
|
Line 2060 sub get_domain_defaults {
|
} |
} |
} |
} |
if (ref($domconfig{'requestcourses'}) eq 'HASH') { |
if (ref($domconfig{'requestcourses'}) eq 'HASH') { |
foreach my $item ('official','unofficial','community') { |
foreach my $item ('official','unofficial','community','textbook') { |
$domdefaults{$item} = $domconfig{'requestcourses'}{$item}; |
$domdefaults{$item} = $domconfig{'requestcourses'}{$item}; |
} |
} |
} |
} |
Line 2041 sub get_domain_defaults {
|
Line 2068 sub get_domain_defaults {
|
$domdefaults{'requestauthor'} = $domconfig{'requestauthor'}; |
$domdefaults{'requestauthor'} = $domconfig{'requestauthor'}; |
} |
} |
if (ref($domconfig{'inststatus'}) eq 'HASH') { |
if (ref($domconfig{'inststatus'}) eq 'HASH') { |
foreach my $item ('inststatustypes','inststatusorder') { |
foreach my $item ('inststatustypes','inststatusorder','inststatusguest') { |
$domdefaults{$item} = $domconfig{'inststatus'}{$item}; |
$domdefaults{$item} = $domconfig{'inststatus'}{$item}; |
} |
} |
} |
} |
if (ref($domconfig{'coursedefaults'}) eq 'HASH') { |
if (ref($domconfig{'coursedefaults'}) eq 'HASH') { |
$domdefaults{'canuse_pdfforms'} = $domconfig{'coursedefaults'}{'canuse_pdfforms'}; |
$domdefaults{'canuse_pdfforms'} = $domconfig{'coursedefaults'}{'canuse_pdfforms'}; |
if (ref($domconfig{'coursedefaults'}{'coursecredits'}) eq 'HASH') { |
foreach my $type (@coursetypes) { |
$domdefaults{'officialcredits'} = $domconfig{'coursedefaults'}{'coursecredits'}{'official'}; |
if (ref($domconfig{'coursedefaults'}{'coursecredits'}) eq 'HASH') { |
$domdefaults{'unofficialcredits'} = $domconfig{'coursedefaults'}{'coursecredits'}{'unofficial'}; |
unless ($type eq 'community') { |
} |
$domdefaults{$type.'credits'} = $domconfig{'coursedefaults'}{'coursecredits'}{$type}; |
if (ref($domconfig{'coursedefaults'}{'uploadquota'}) eq 'HASH') { |
} |
$domdefaults{'officialquota'} = $domconfig{'coursedefaults'}{'uploadquota'}{'official'}; |
} |
$domdefaults{'unofficialquota'} = $domconfig{'coursedefaults'}{'uploadquota'}{'unofficial'}; |
if (ref($domconfig{'coursedefaults'}{'uploadquota'}) eq 'HASH') { |
$domdefaults{'communityquota'} = $domconfig{'coursedefaults'}{'uploadquota'}{'community'}; |
$domdefaults{$type.'quota'} = $domconfig{'coursedefaults'}{'uploadquota'}{$type}; |
|
} |
} |
} |
} |
} |
if (ref($domconfig{'usersessions'}) eq 'HASH') { |
if (ref($domconfig{'usersessions'}) eq 'HASH') { |
Line 2065 sub get_domain_defaults {
|
Line 2093 sub get_domain_defaults {
|
$domdefaults{'hostedsessions'} = $domconfig{'usersessions'}{'hosted'}; |
$domdefaults{'hostedsessions'} = $domconfig{'usersessions'}{'hosted'}; |
} |
} |
} |
} |
|
if (ref($domconfig{'selfenrollment'}) eq 'HASH') { |
|
if (ref($domconfig{'selfenrollment'}{'admin'}) eq 'HASH') { |
|
my @settings = ('types','registered','enroll_dates','access_dates','section', |
|
'approval','limit'); |
|
foreach my $type (@coursetypes) { |
|
if (ref($domconfig{'selfenrollment'}{'admin'}{$type}) eq 'HASH') { |
|
my @mgrdc = (); |
|
foreach my $item (@settings) { |
|
if ($domconfig{'selfenrollment'}{'admin'}{$type}{$item} eq '0') { |
|
push(@mgrdc,$item); |
|
} |
|
} |
|
if (@mgrdc) { |
|
$domdefaults{$type.'selfenrolladmdc'} = join(',',@mgrdc); |
|
} |
|
} |
|
} |
|
} |
|
if (ref($domconfig{'selfenrollment'}{'default'}) eq 'HASH') { |
|
foreach my $type (@coursetypes) { |
|
if (ref($domconfig{'selfenrollment'}{'default'}{$type}) eq 'HASH') { |
|
foreach my $item (keys(%{$domconfig{'selfenrollment'}{'default'}{$type}})) { |
|
$domdefaults{$type.'selfenroll'.$item} = $domconfig{'selfenrollment'}{'default'}{$type}{$item}; |
|
} |
|
} |
|
} |
|
} |
|
} |
|
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); |
&do_cache_new('domdefaults',$domain,\%domdefaults,$cachetime); |
return %domdefaults; |
return %domdefaults; |
} |
} |
Line 4178 sub courseiddump {
|
Line 4244 sub courseiddump {
|
my ($domfilter,$descfilter,$sincefilter,$instcodefilter,$ownerfilter, |
my ($domfilter,$descfilter,$sincefilter,$instcodefilter,$ownerfilter, |
$coursefilter,$hostidflag,$hostidref,$typefilter,$regexp_ok, |
$coursefilter,$hostidflag,$hostidref,$typefilter,$regexp_ok, |
$selfenrollonly,$catfilter,$showhidden,$caller,$cloner,$cc_clone, |
$selfenrollonly,$catfilter,$showhidden,$caller,$cloner,$cc_clone, |
$cloneonly,$createdbefore,$createdafter,$creationcontext,$domcloner)=@_; |
$cloneonly,$createdbefore,$createdafter,$creationcontext,$domcloner, |
|
$hasuniquecode)=@_; |
my $as_hash = 1; |
my $as_hash = 1; |
my %returnhash; |
my %returnhash; |
if (!$domfilter) { $domfilter=''; } |
if (!$domfilter) { $domfilter=''; } |
Line 4201 sub courseiddump {
|
Line 4268 sub courseiddump {
|
&escape($catfilter), $showhidden, $caller, |
&escape($catfilter), $showhidden, $caller, |
&escape($cloner), &escape($cc_clone), $cloneonly, |
&escape($cloner), &escape($cc_clone), $cloneonly, |
&escape($createdbefore), &escape($createdafter), |
&escape($createdbefore), &escape($createdafter), |
&escape($creationcontext), $domcloner))); |
&escape($creationcontext), $domcloner, $hasuniquecode))); |
} else { |
} else { |
$rep = &reply('courseiddump:'.&host_domain($tryserver).':'. |
$rep = &reply('courseiddump:'.&host_domain($tryserver).':'. |
$sincefilter.':'.&escape($descfilter).':'. |
$sincefilter.':'.&escape($descfilter).':'. |
Line 4212 sub courseiddump {
|
Line 4279 sub courseiddump {
|
$showhidden.':'.$caller.':'.&escape($cloner).':'. |
$showhidden.':'.$caller.':'.&escape($cloner).':'. |
&escape($cc_clone).':'.$cloneonly.':'. |
&escape($cc_clone).':'.$cloneonly.':'. |
&escape($createdbefore).':'.&escape($createdafter).':'. |
&escape($createdbefore).':'.&escape($createdafter).':'. |
&escape($creationcontext).':'.$domcloner, |
&escape($creationcontext).':'.$domcloner.':'.$hasuniquecode, |
$tryserver); |
$tryserver); |
} |
} |
|
|
Line 5212 sub set_arearole {
|
Line 5279 sub set_arearole {
|
sub custom_roleprivs { |
sub custom_roleprivs { |
my ($allroles,$trole,$tdomain,$trest,$spec,$area) = @_; |
my ($allroles,$trole,$tdomain,$trest,$spec,$area) = @_; |
my ($rdummy,$rdomain,$rauthor,$rrole)=split(/\//,$trole); |
my ($rdummy,$rdomain,$rauthor,$rrole)=split(/\//,$trole); |
my $homsvr=homeserver($rauthor,$rdomain); |
my $homsvr = &homeserver($rauthor,$rdomain); |
if (&hostname($homsvr) ne '') { |
if (&hostname($homsvr) ne '') { |
my ($rdummy,$roledef)= |
my ($rdummy,$roledef)= |
&get('roles',["rolesdef_$rrole"],$rdomain,$rauthor); |
&get('roles',["rolesdef_$rrole"],$rdomain,$rauthor); |
Line 5333 sub set_userprivs {
|
Line 5400 sub set_userprivs {
|
|
|
sub role_status { |
sub role_status { |
my ($rolekey,$update,$refresh,$now,$role,$where,$trolecode,$tstatus,$tstart,$tend) = @_; |
my ($rolekey,$update,$refresh,$now,$role,$where,$trolecode,$tstatus,$tstart,$tend) = @_; |
my @pwhere = (); |
|
if (exists($env{$rolekey}) && $env{$rolekey} ne '') { |
if (exists($env{$rolekey}) && $env{$rolekey} ne '') { |
(undef,undef,$$role,@pwhere)=split(/\./,$rolekey); |
my ($one,$two) = split(m{\./},$rolekey,2); |
|
(undef,undef,$$role) = split(/\./,$one,3); |
unless (!defined($$role) || $$role eq '') { |
unless (!defined($$role) || $$role eq '') { |
$$where=join('.',@pwhere); |
$$where = '/'.$two; |
$$trolecode=$$role.'.'.$$where; |
$$trolecode=$$role.'.'.$$where; |
($$tstart,$$tend)=split(/\./,$env{$rolekey}); |
($$tstart,$$tend)=split(/\./,$env{$rolekey}); |
$$tstatus='is'; |
$$tstatus='is'; |
Line 5543 sub unserialize {
|
Line 5610 sub unserialize {
|
return {} if $rep =~ /^error/; |
return {} if $rep =~ /^error/; |
|
|
my %returnhash=(); |
my %returnhash=(); |
foreach my $item (split /\&/, $rep) { |
foreach my $item (split(/\&/,$rep)) { |
my ($key, $value) = split(/=/, $item, 2); |
my ($key, $value) = split(/=/, $item, 2); |
$key = unescape($key) unless $escapedkeys; |
$key = unescape($key) unless $escapedkeys; |
next if $key =~ /^error: 2 /; |
next if $key =~ /^error: 2 /; |
$returnhash{$key} = Apache::lonnet::thaw_unescape($value); |
$returnhash{$key} = &thaw_unescape($value); |
} |
} |
#return %returnhash; |
#return %returnhash; |
return \%returnhash; |
return \%returnhash; |
Line 6208 sub usertools_access {
|
Line 6275 sub usertools_access {
|
official => 1, |
official => 1, |
unofficial => 1, |
unofficial => 1, |
community => 1, |
community => 1, |
|
textbook => 1, |
); |
); |
} elsif ($context eq 'requestauthor') { |
} elsif ($context eq 'requestauthor') { |
%tools = ( |
%tools = ( |
Line 6733 sub allowed {
|
Line 6801 sub allowed {
|
&& &is_portfolio_url($uri)) { |
&& &is_portfolio_url($uri)) { |
$thisallowed = &portfolio_access($uri); |
$thisallowed = &portfolio_access($uri); |
} |
} |
|
|
# Full access at system, domain or course-wide level? Exit. |
# Full access at system, domain or course-wide level? Exit. |
if ($thisallowed=~/F/) { |
if ($thisallowed=~/F/) { |
return 'F'; |
return 'F'; |
Line 7819 sub auto_courserequest_checks {
|
Line 7887 sub auto_courserequest_checks {
|
} |
} |
|
|
sub auto_courserequest_validation { |
sub auto_courserequest_validation { |
my ($dom,$owner,$crstype,$inststatuslist,$instcode,$instseclist) = @_; |
my ($dom,$owner,$crstype,$inststatuslist,$instcode,$instseclist,$custominfo) = @_; |
my ($homeserver,$response); |
my ($homeserver,$response); |
if ($dom =~ /^$match_domain$/) { |
if ($dom =~ /^$match_domain$/) { |
$homeserver = &domain($dom,'primary'); |
$homeserver = &domain($dom,'primary'); |
} |
} |
unless ($homeserver eq 'no_host') { |
unless ($homeserver eq 'no_host') { |
|
my $customdata; |
|
if (ref($custominfo) eq 'HASH') { |
|
$customdata = &freeze_escape($custominfo); |
|
} |
$response=&unescape(&reply('autocrsreqvalidation:'.$dom.':'.&escape($owner). |
$response=&unescape(&reply('autocrsreqvalidation:'.$dom.':'.&escape($owner). |
':'.&escape($crstype).':'.&escape($inststatuslist). |
':'.&escape($crstype).':'.&escape($inststatuslist). |
':'.&escape($instcode).':'.&escape($instseclist), |
':'.&escape($instcode).':'.&escape($instseclist).':'. |
$homeserver)); |
$customdata,$homeserver)); |
} |
} |
return $response; |
return $response; |
} |
} |
Line 7848 sub auto_validate_class_sec {
|
Line 7919 sub auto_validate_class_sec {
|
return $response; |
return $response; |
} |
} |
|
|
|
sub auto_crsreq_update { |
|
my ($cdom,$cnum,$crstype,$action,$ownername,$ownerdomain,$fullname,$title, |
|
$code,$accessstart,$accessend,$inbound) = @_; |
|
my ($homeserver,%crsreqresponse); |
|
if ($cdom =~ /^$match_domain$/) { |
|
$homeserver = &domain($cdom,'primary'); |
|
} |
|
unless (($homeserver eq 'no_host') || ($homeserver eq '')) { |
|
my $info; |
|
if (ref($inbound) eq 'HASH') { |
|
$info = &freeze_escape($inbound); |
|
} |
|
my $response=&reply('autocrsrequpdate:'.$cdom.':'.$cnum.':'.&escape($crstype). |
|
':'.&escape($action).':'.&escape($ownername).':'. |
|
&escape($ownerdomain).':'.&escape($fullname).':'. |
|
&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) { |
|
my ($key,$value) = split('=',$item); |
|
$crsreqresponse{&unescape($key)} = &thaw_unescape($value); |
|
} |
|
} |
|
} |
|
return \%crsreqresponse; |
|
} |
|
|
# ------------------------------------------------------- Course Group routines |
# ------------------------------------------------------- Course Group routines |
|
|
sub get_coursegroups { |
sub get_coursegroups { |
Line 10123 sub metadata {
|
Line 10223 sub metadata {
|
($uri =~ m|/$|) || ($uri =~ m|/.meta$|) || ($uri =~ m{^/*uploaded/.+\.sequence$})) { |
($uri =~ m|/$|) || ($uri =~ m|/.meta$|) || ($uri =~ m{^/*uploaded/.+\.sequence$})) { |
return undef; |
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)$/) { |
&& &Apache::lonxml::get_state('target') =~ /^(|meta)$/) { |
return undef; |
return undef; |
} |
} |
Line 11181 sub rndseed_CODE_64bit5 {
|
Line 11281 sub rndseed_CODE_64bit5 {
|
sub setup_random_from_rndseed { |
sub setup_random_from_rndseed { |
my ($rndseed)=@_; |
my ($rndseed)=@_; |
if ($rndseed =~/([,:])/) { |
if ($rndseed =~/([,:])/) { |
my ($num1,$num2)=split(/[,:]/,$rndseed); |
my ($num1,$num2) = map { abs($_); } (split(/[,:]/,$rndseed)); |
&Math::Random::random_set_seed(abs($num1),abs($num2)); |
if ((!$num1) || (!$num2) || ($num1 > 2147483562) || ($num2 > 2147483398)) { |
|
&Math::Random::random_set_seed_from_phrase($rndseed); |
|
} else { |
|
&Math::Random::random_set_seed($num1,$num2); |
|
} |
} else { |
} else { |
&Math::Random::random_set_seed_from_phrase($rndseed); |
&Math::Random::random_set_seed_from_phrase($rndseed); |
} |
} |
Line 11573 sub default_login_domain {
|
Line 11677 sub default_login_domain {
|
sub declutter { |
sub declutter { |
my $thisfn=shift; |
my $thisfn=shift; |
if ($thisfn=~m|^/enc/|) { $thisfn=&Apache::lonenc::unencrypted($thisfn); } |
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/^\///; |
$thisfn=~s|^adm/wrapper/||; |
$thisfn=~s|^adm/wrapper/||; |
$thisfn=~s|^adm/coursedocs/showdoc/||; |
$thisfn=~s|^adm/coursedocs/showdoc/||; |
Line 11753 sub parse_dns_checksums_tab {
|
Line 11859 sub parse_dns_checksums_tab {
|
sub fetch_dns_checksums { |
sub fetch_dns_checksums { |
my %checksums; |
my %checksums; |
my $machine_dom = &Apache::lonnet::host_domain($perlvar{'lonHostID'}); |
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); |
my ($release,$timestamp) = split(/\-/,$loncaparev); |
&get_dns("/adm/dns/checksums/$release",\&parse_dns_checksums_tab,1,1, |
&get_dns("/adm/dns/checksums/$release",\&parse_dns_checksums_tab,1,1, |
\%checksums); |
\%checksums); |
Line 12133 sub fetch_dns_checksums {
|
Line 12239 sub fetch_dns_checksums {
|
} |
} |
|
|
sub all_loncaparevs { |
sub all_loncaparevs { |
return qw(1.1 1.2 1.3 2.0 2.1 2.2 2.3 2.4 2.5 2.6 2.7 2.8 2.9 2.10); |
return qw(1.1 1.2 1.3 2.0 2.1 2.2 2.3 2.4 2.5 2.6 2.7 2.8 2.9 2.10 2.11); |
} |
} |
|
|
# ---------------------------------------------------------- Read loncaparev table |
# ---------------------------------------------------------- Read loncaparev table |
Line 12311 $readit=1;
|
Line 12417 $readit=1;
|
if ($test != 0) { $_64bit=1; } else { $_64bit=0; } |
if ($test != 0) { $_64bit=1; } else { $_64bit=0; } |
&logthis(" Detected 64bit platform ($_64bit)"); |
&logthis(" Detected 64bit platform ($_64bit)"); |
} |
} |
|
|
{ |
|
eval { |
|
($apache) = |
|
(Apache2::ServerUtil::get_server_version() =~ m{Apache/(\d+\.\d+)}); |
|
}; |
|
if ($@) { |
|
$apache = 1.3; |
|
} |
|
} |
|
|
|
} |
} |
} |
} |
|
|
Line 13278 requestcourses: ability to request cours
|
Line 13373 requestcourses: ability to request cours
|
=over |
=over |
|
|
=item |
=item |
official, unofficial, community |
official, unofficial, community, textbook |
|
|
=back |
=back |
|
|
Line 13288 inststatus: types of institutional affil
|
Line 13383 inststatus: types of institutional affil
|
=over |
=over |
|
|
=item |
=item |
inststatustypes, inststatusorder |
inststatustypes, inststatusorder, inststatusguest |
|
|
=back |
=back |
|
|
Line 13299 for course's uploaded content.
|
Line 13394 for course's uploaded content.
|
=over |
=over |
|
|
=item |
=item |
canuse_pdfforms, officialcredits, unofficialcredits, officialquota, unofficialquota, communityquota |
canuse_pdfforms, officialcredits, unofficialcredits, textbookcredits, officialquota, unofficialquota, |
|
communityquota, textbookquota |
|
|
=back |
=back |
|
|
Line 13552 filelocation except for hrefs
|
Line 13648 filelocation except for hrefs
|
|
|
=item * |
=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 |
=back |
|
|