version 1.1130, 2011/08/17 00:32:27
|
version 1.1147, 2011/12/05 01:14:21
|
Line 76 use HTTP::Date;
|
Line 76 use HTTP::Date;
|
use Image::Magick; |
use Image::Magick; |
|
|
use vars qw(%perlvar %spareid %pr %prp $memcache %packagetab $tmpdir |
use vars qw(%perlvar %spareid %pr %prp $memcache %packagetab $tmpdir |
$_64bit %env %protocol %loncaparevs %serverhomeIDs %needsrelease); |
$_64bit %env %protocol %loncaparevs %serverhomeIDs %needsrelease |
|
%managerstab); |
|
|
my (%badServerCache, $memcache, %courselogs, %accesshash, %domainrolehash, |
my (%badServerCache, $memcache, %courselogs, %accesshash, %domainrolehash, |
%userrolehash, $processmarker, $dumpcount, %coursedombuf, |
%userrolehash, $processmarker, $dumpcount, %coursedombuf, |
Line 1919 sub get_domain_defaults {
|
Line 1920 sub get_domain_defaults {
|
$domdefaults{'auth_arg_def'} = $domconfig{'defaults'}{'auth_arg_def'}; |
$domdefaults{'auth_arg_def'} = $domconfig{'defaults'}{'auth_arg_def'}; |
$domdefaults{'timezone_def'} = $domconfig{'defaults'}{'timezone_def'}; |
$domdefaults{'timezone_def'} = $domconfig{'defaults'}{'timezone_def'}; |
$domdefaults{'datelocale_def'} = $domconfig{'defaults'}{'datelocale_def'}; |
$domdefaults{'datelocale_def'} = $domconfig{'defaults'}{'datelocale_def'}; |
|
$domdefaults{'portal_def'} = $domconfig{'defaults'}{'portal_def'}; |
} else { |
} else { |
$domdefaults{'lang_def'} = &domain($domain,'lang_def'); |
$domdefaults{'lang_def'} = &domain($domain,'lang_def'); |
$domdefaults{'auth_def'} = &domain($domain,'auth_def'); |
$domdefaults{'auth_def'} = &domain($domain,'auth_def'); |
Line 2212 sub is_cached_new {
|
Line 2214 sub is_cached_new {
|
my ($name,$id,$debug) = @_; |
my ($name,$id,$debug) = @_; |
$id=&make_key($name,$id); |
$id=&make_key($name,$id); |
if (exists($remembered{$id})) { |
if (exists($remembered{$id})) { |
if ($debug) { &Apache::lonnet::logthis("Earyl return $id of $remembered{$id} "); } |
if ($debug) { &Apache::lonnet::logthis("Early return $id of $remembered{$id} "); } |
$accessed{$id}=[&gettimeofday()]; |
$accessed{$id}=[&gettimeofday()]; |
$hits++; |
$hits++; |
return ($remembered{$id},1); |
return ($remembered{$id},1); |
Line 2428 sub subscribe {
|
Line 2430 sub subscribe {
|
sub repcopy { |
sub repcopy { |
my $filename=shift; |
my $filename=shift; |
$filename=~s/\/+/\//g; |
$filename=~s/\/+/\//g; |
if ($filename=~m|^/home/httpd/html/adm/|) { return 'ok'; } |
my $londocroot = $perlvar{'lonDocRoot'}; |
if ($filename=~m|^/home/httpd/html/lonUsers/|) { return 'ok'; } |
if ($filename=~m{^\Q$londocroot/adm/\E}) { return 'ok'; } |
if ($filename=~m|^/home/httpd/html/userfiles/| or |
if ($filename=~m{^\Q$londocroot/lonUsers/\E}) { return 'ok'; } |
$filename=~m -^/*(uploaded|editupload)/-) { |
if ($filename=~m{^\Q$londocroot/userfiles/\E} or |
|
$filename=~m{^/*(uploaded|editupload)/}) { |
return &repcopy_userfile($filename); |
return &repcopy_userfile($filename); |
} |
} |
$filename=~s/[\n\r]//g; |
$filename=~s/[\n\r]//g; |
Line 2458 sub repcopy {
|
Line 2461 sub repcopy {
|
unless ($home eq $perlvar{'lonHostID'}) { |
unless ($home eq $perlvar{'lonHostID'}) { |
my @parts=split(/\//,$filename); |
my @parts=split(/\//,$filename); |
my $path="/$parts[1]/$parts[2]/$parts[3]/$parts[4]"; |
my $path="/$parts[1]/$parts[2]/$parts[3]/$parts[4]"; |
if ($path ne "$perlvar{'lonDocRoot'}/res") { |
if ($path ne "$londocroot/res") { |
&logthis("Malconfiguration for replication: $filename"); |
&logthis("Malconfiguration for replication: $filename"); |
return 'bad_request'; |
return 'bad_request'; |
} |
} |
Line 3336 sub courseacclog {
|
Line 3339 sub courseacclog {
|
my $fnsymb=shift; |
my $fnsymb=shift; |
unless ($env{'request.course.id'}) { return ''; } |
unless ($env{'request.course.id'}) { return ''; } |
my $what=$fnsymb.':'.$env{'user.name'}.':'.$env{'user.domain'}; |
my $what=$fnsymb.':'.$env{'user.name'}.':'.$env{'user.domain'}; |
if ($fnsymb=~/(problem|exam|quiz|assess|survey|form|task|page)$/) { |
if ($fnsymb=~/$LONCAPA::assess_re/) { |
$what.=':POST'; |
$what.=':POST'; |
# FIXME: Probably ought to escape things.... |
# FIXME: Probably ought to escape things.... |
foreach my $key (keys(%env)) { |
foreach my $key (keys(%env)) { |
Line 3986 sub hashref2str {
|
Line 3989 sub hashref2str {
|
$result.='='; |
$result.='='; |
#print("Got a ref of ".(ref($key))." skipping."); |
#print("Got a ref of ".(ref($key))." skipping."); |
} else { |
} else { |
if ($key) {$result.=&escape($key).'=';} else { last; } |
if (defined($key)) {$result.=&escape($key).'=';} else { last; } |
} |
} |
|
|
if(ref($hashref->{$key}) eq 'ARRAY') { |
if(ref($hashref->{$key}) eq 'ARRAY') { |
Line 5909 sub allowed {
|
Line 5912 sub allowed {
|
} |
} |
} |
} |
|
|
|
# User who is not author or co-author might still be able to edit |
|
# resource of an author in the domain (e.g., if Domain Coordinator). |
|
if (($priv eq 'eco') && ($thisallowed eq '') && ($env{'request.course.id'}) && |
|
(&allowed('mdc',$env{'request.course.id'}))) { |
|
if ($env{"user.priv.cm./$uri/"}=~/\Q$priv\E\&([^\:]*)/) { |
|
$thisallowed.=$1; |
|
} |
|
} |
|
|
# Course: uri itself is a course |
# Course: uri itself is a course |
my $courseuri=$uri; |
my $courseuri=$uri; |
$courseuri=~s/\_(\d)/\/$1/; |
$courseuri=~s/\_(\d)/\/$1/; |
Line 6179 sub allowed {
|
Line 6191 sub allowed {
|
} |
} |
return 'F'; |
return 'F'; |
} |
} |
|
# |
|
# Removes the versino from a URI and |
|
# splits it in to its filename and path to the filename. |
|
# Seems like File::Basename could have done this more clearly. |
|
# Parameters: |
|
# $uri - input URI |
|
# Returns: |
|
# Two element list consisting of |
|
# $pathname - the URI up to and excluding the trailing / |
|
# $filename - The part of the URI following the last / |
|
# NOTE: |
|
# Another realization of this is simply: |
|
# use File::Basename; |
|
# ... |
|
# $uri = shift; |
|
# $filename = basename($uri); |
|
# $path = dirname($uri); |
|
# return ($filename, $path); |
|
# |
|
# The implementation below is probably faster however. |
|
# |
sub split_uri_for_cond { |
sub split_uri_for_cond { |
my $uri=&deversion(&declutter(shift)); |
my $uri=&deversion(&declutter(shift)); |
my @uriparts=split(/\//,$uri); |
my @uriparts=split(/\//,$uri); |
Line 7075 sub assignrole {
|
Line 7107 sub assignrole {
|
return 'refused'; |
return 'refused'; |
} |
} |
} |
} |
|
} elsif ($role eq 'au') { |
|
if ($url ne '/'.$udom.'/') { |
|
&logthis('Attempt by '.$env{'user.name'}.':'.$env{'user.domain'}. |
|
' to assign author role for '.$uname.':'.$udom. |
|
' in domain: '.$url.' refused (wrong domain).'); |
|
return 'refused'; |
|
} |
} |
} |
$mrole=$role; |
$mrole=$role; |
} |
} |
Line 8222 sub dirlist {
|
Line 8261 sub dirlist {
|
|
|
if($udom) { |
if($udom) { |
if($uname) { |
if($uname) { |
|
my $uhome = &homeserver($uname,$udom); |
|
if ($uhome eq 'no_host') { |
|
return ([],'no_host'); |
|
} |
$listing = &reply('ls3:'.&escape('/'.$uri).':'.$getpropath.':' |
$listing = &reply('ls3:'.&escape('/'.$uri).':'.$getpropath.':' |
.$getuserdir.':'.&escape($dirRoot) |
.$getuserdir.':'.&escape($dirRoot) |
.':'.&escape($uname).':'.&escape($udom), |
.':'.&escape($uname).':'.&escape($udom),$uhome); |
&homeserver($uname,$udom)); |
|
if ($listing eq 'unknown_cmd') { |
if ($listing eq 'unknown_cmd') { |
$listing = &reply('ls2:'.$dirRoot.'/'.$uri, |
$listing = &reply('ls2:'.$dirRoot.'/'.$uri,$uhome); |
&homeserver($uname,$udom)); |
|
} else { |
} else { |
@listing_results = map { &unescape($_); } split(/:/,$listing); |
@listing_results = map { &unescape($_); } split(/:/,$listing); |
} |
} |
if ($listing eq 'unknown_cmd') { |
if ($listing eq 'unknown_cmd') { |
$listing = &reply('ls:'.$dirRoot.'/'.$uri, |
$listing = &reply('ls:'.$dirRoot.'/'.$uri,$uhome); |
&homeserver($uname,$udom)); |
|
@listing_results = split(/:/,$listing); |
@listing_results = split(/:/,$listing); |
} else { |
} else { |
@listing_results = map { &unescape($_); } split(/:/,$listing); |
@listing_results = map { &unescape($_); } split(/:/,$listing); |
} |
} |
return @listing_results; |
if (($listing eq 'no_such_host') || ($listing eq 'con_lost') || |
|
($listing eq 'rejected') || ($listing eq 'refused') || |
|
($listing eq 'no_such_dir') || ($listing eq 'empty')) { |
|
return ([],$listing); |
|
} else { |
|
return (\@listing_results); |
|
} |
} elsif(!$alternateRoot) { |
} elsif(!$alternateRoot) { |
my %allusers; |
my (%allusers,%listerror); |
my %servers = &get_servers($udom,'library'); |
my %servers = &get_servers($udom,'library'); |
foreach my $tryserver (keys(%servers)) { |
foreach my $tryserver (keys(%servers)) { |
$listing = &reply('ls3:'.&escape("/res/$udom").':::::'. |
$listing = &reply('ls3:'.&escape("/res/$udom").':::::'. |
Line 8260 sub dirlist {
|
Line 8306 sub dirlist {
|
@listing_results = |
@listing_results = |
map { &unescape($_); } split(/:/,$listing); |
map { &unescape($_); } split(/:/,$listing); |
} |
} |
if ($listing_results[0] ne 'no_such_dir' && |
if (($listing eq 'no_such_host') || ($listing eq 'con_lost') || |
$listing_results[0] ne 'empty' && |
($listing eq 'rejected') || ($listing eq 'refused') || |
$listing_results[0] ne 'con_lost') { |
($listing eq 'no_such_dir') || ($listing eq 'empty')) { |
|
$listerror{$tryserver} = $listing; |
|
} else { |
foreach my $line (@listing_results) { |
foreach my $line (@listing_results) { |
my ($entry) = split(/&/,$line,2); |
my ($entry) = split(/&/,$line,2); |
$allusers{$entry} = 1; |
$allusers{$entry} = 1; |
} |
} |
} |
} |
} |
} |
my $alluserstr=''; |
my @alluserslist=(); |
foreach my $user (sort(keys(%allusers))) { |
foreach my $user (sort(keys(%allusers))) { |
$alluserstr.=$user.'&user:'; |
push(@alluserslist,$user.'&user'); |
} |
} |
$alluserstr=~s/:$//; |
return (\@alluserslist); |
return split(/:/,$alluserstr); |
|
} else { |
} else { |
return ('missing user name'); |
return ([],'missing username'); |
} |
} |
} elsif(!defined($getpropath)) { |
} elsif(!defined($getpropath)) { |
my @all_domains = sort(&all_domains()); |
my $path = $perlvar{'lonDocRoot'}.'/res/'; |
foreach my $domain (@all_domains) { |
my @all_domains = map { $path.$_.'/&domain'; } (sort(&all_domains())); |
$domain = $perlvar{'lonDocRoot'}.'/res/'.$domain.'/&domain'; |
return (\@all_domains); |
} |
|
return @all_domains; |
|
} else { |
} else { |
return ('missing domain'); |
return ([],'missing domain'); |
} |
} |
} |
} |
|
|
Line 8298 sub GetFileTimestamp {
|
Line 8343 sub GetFileTimestamp {
|
my ($studentDomain,$studentName,$filename,$getuserdir)=@_; |
my ($studentDomain,$studentName,$filename,$getuserdir)=@_; |
$studentDomain = &LONCAPA::clean_domain($studentDomain); |
$studentDomain = &LONCAPA::clean_domain($studentDomain); |
$studentName = &LONCAPA::clean_username($studentName); |
$studentName = &LONCAPA::clean_username($studentName); |
my ($fileStat) = |
my ($fileref,$error) = &dirlist($filename,$studentDomain,$studentName, |
&Apache::lonnet::dirlist($filename,$studentDomain,$studentName, |
undef,$getuserdir); |
undef,$getuserdir); |
if (($error eq 'empty') || ($error eq 'no_such_dir')) { |
my @stats = split('&', $fileStat); |
return -1; |
if($stats[0] ne 'empty' && $stats[0] ne 'no_such_dir') { |
} |
|
if (ref($fileref) eq 'ARRAY') { |
|
my @stats = split('&',$fileref->[0]); |
# @stats contains first the filename, then the stat output |
# @stats contains first the filename, then the stat output |
return $stats[10]; # so this is 10 instead of 9. |
return $stats[10]; # so this is 10 instead of 9. |
} else { |
} else { |
Line 8334 sub stat_file {
|
Line 8381 sub stat_file {
|
if ($file =~ /^userfiles\//) { |
if ($file =~ /^userfiles\//) { |
$getpropath = 1; |
$getpropath = 1; |
} |
} |
my ($result) = &dirlist($file,$udom,$uname,$getpropath); |
my ($listref,$error) = &dirlist($file,$udom,$uname,$getpropath); |
my @stats = split('&', $result); |
if (($error eq 'empty') || ($error eq 'no_such_dir')) { |
|
return (); |
if($stats[0] ne 'empty' && $stats[0] ne 'no_such_dir') { |
} else { |
shift(@stats); #filename is first |
if (ref($listref) eq 'ARRAY') { |
return @stats; |
my @stats = split('&',$listref->[0]); |
|
shift(@stats); #filename is first |
|
return @stats; |
|
} |
} |
} |
return (); |
return (); |
} |
} |
Line 8660 sub EXT {
|
Line 8710 sub EXT {
|
} elsif ($realm eq 'request') { |
} elsif ($realm eq 'request') { |
# ------------------------------------------------------------- request.browser |
# ------------------------------------------------------------- request.browser |
if ($space eq 'browser') { |
if ($space eq 'browser') { |
if ($qualifier eq 'textremote') { |
return $env{'browser.'.$qualifier}; |
if (&Apache::lonlocal::mt('textual_remote_display') eq 'on') { |
|
return 1; |
|
} else { |
|
return 0; |
|
} |
|
} else { |
|
return $env{'browser.'.$qualifier}; |
|
} |
|
# ------------------------------------------------------------ request.filename |
# ------------------------------------------------------------ request.filename |
} else { |
} else { |
return $env{'request.'.$spacequalifierrest}; |
return $env{'request.'.$spacequalifierrest}; |
Line 8952 sub metadata {
|
Line 8994 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 =~ /^~/ || $uri =~ m{home/$match_username/public_html/}) |
if (($uri =~ /^priv/ || $uri=~/home\/httpd\/html\/priv/) |
&& &Apache::lonxml::get_state('target') =~ /^(|meta)$/) { |
&& &Apache::lonxml::get_state('target') =~ /^(|meta)$/) { |
return undef; |
return undef; |
} |
} |
Line 8989 sub metadata {
|
Line 9031 sub metadata {
|
my %metathesekeys=(); |
my %metathesekeys=(); |
unless ($filename=~/\.meta$/) { $filename.='.meta'; } |
unless ($filename=~/\.meta$/) { $filename.='.meta'; } |
my $metastring; |
my $metastring; |
if ($uri =~ /^~/ || $uri =~ m{home/$match_username/public_html/}) { |
if ($uri =~ /^priv/ || $uri=~/home\/httpd\/html\/priv/) { |
my $which = &hreflocation('','/'.($liburi || $uri)); |
my $which = &hreflocation('','/'.($liburi || $uri)); |
$metastring = |
$metastring = |
&Apache::lonnet::ssi_body($which, |
&Apache::lonnet::ssi_body($which, |
Line 9686 sub getCODE {
|
Line 9728 sub getCODE {
|
} |
} |
return undef; |
return undef; |
} |
} |
|
# |
|
# Determines the random seed for a specific context: |
|
# |
|
# parameters: |
|
# symb - in course context the symb for the seed. |
|
# course_id - The course id of the form domain_coursenum. |
|
# domain - Domain for the user. |
|
# course - Course for the user. |
|
# cenv - environment of the course. |
|
# |
|
# NOTE: |
|
# All parameters are picked out of the environment if missing |
|
# or not defined. |
|
# If a symb cannot be determined the current time is used instead. |
|
# |
|
# For a given well defined symb, courside, domain, username, |
|
# and course environment, the seed is reproducible. |
|
# |
sub rndseed { |
sub rndseed { |
my ($symb,$courseid,$domain,$username)=@_; |
my ($symb,$courseid,$domain,$username, $cenv)=@_; |
my ($wsymb,$wcourseid,$wdomain,$wusername)=&whichuser(); |
my ($wsymb,$wcourseid,$wdomain,$wusername)=&whichuser(); |
if (!defined($symb)) { |
if (!defined($symb)) { |
unless ($symb=$wsymb) { return time; } |
unless ($symb=$wsymb) { return time; } |
} |
} |
if (!$courseid) { $courseid=$wcourseid; } |
if (!defined $courseid) { |
if (!$domain) { $domain=$wdomain; } |
$courseid=$wcourseid; |
if (!$username) { $username=$wusername } |
} |
my $which=&get_rand_alg(); |
if (!defined $domain) { $domain=$wdomain; } |
|
if (!defined $username) { $username=$wusername } |
|
|
|
my $which; |
|
if (defined($cenv->{'rndseed'})) { |
|
$which = $cenv->{'rndseed'}; |
|
} else { |
|
$which =&get_rand_alg($courseid); |
|
} |
if (defined(&getCODE())) { |
if (defined(&getCODE())) { |
|
|
if ($which eq '64bit5') { |
if ($which eq '64bit5') { |
return &rndseed_CODE_64bit5($symb,$courseid,$domain,$username); |
return &rndseed_CODE_64bit5($symb,$courseid,$domain,$username); |
} elsif ($which eq '64bit4') { |
} elsif ($which eq '64bit4') { |
Line 10022 sub getfile {
|
Line 10089 sub getfile {
|
|
|
sub repcopy_userfile { |
sub repcopy_userfile { |
my ($file)=@_; |
my ($file)=@_; |
if ($file =~ m -^/*(uploaded|editupload)/-) { $file=&filelocation("",$file); } |
my $londocroot = $perlvar{'lonDocRoot'}; |
if ($file =~ m|^/home/httpd/html/lonUsers/|) { return 'ok'; } |
if ($file =~ m{^/*(uploaded|editupload)/}) { $file=&filelocation("",$file); } |
|
if ($file =~ m{^\Q$londocroot/lonUsers/\E}) { return 'ok'; } |
my ($cdom,$cnum,$filename) = |
my ($cdom,$cnum,$filename) = |
($file=~m|^\Q$perlvar{'lonDocRoot'}\E/+userfiles/+($match_domain)/+($match_name)/+(.*)|); |
($file=~m|^\Q$perlvar{'lonDocRoot'}\E/+userfiles/+($match_domain)/+($match_name)/+(.*)|); |
my $uri="/uploaded/$cdom/$cnum/$filename"; |
my $uri="/uploaded/$cdom/$cnum/$filename"; |
Line 10152 sub filelocation {
|
Line 10220 sub filelocation {
|
$file=~s-^/adm/coursedocs/showdoc/-/-; |
$file=~s-^/adm/coursedocs/showdoc/-/-; |
} |
} |
|
|
if ($file=~m:^/~:) { # is a contruction space reference |
if ($file =~ m-^\Q$Apache::lonnet::perlvar{'lonTabDir'}\E/-) { |
$location = $file; |
|
$location =~ s:/~(.*?)/(.*):/home/$1/public_html/$2:; |
|
} elsif ($file=~m{^/home/$match_username/public_html/}) { |
|
# is a correct contruction space reference |
|
$location = $file; |
|
} elsif ($file =~ m-^\Q$Apache::lonnet::perlvar{'lonTabDir'}\E/-) { |
|
$location = $file; |
$location = $file; |
} elsif ($file=~/^\/*(uploaded|editupload)/) { # is an uploaded file |
} elsif ($file=~/^\/*(uploaded|editupload)/) { # is an uploaded file |
my ($udom,$uname,$filename)= |
my ($udom,$uname,$filename)= |
Line 10177 sub filelocation {
|
Line 10239 sub filelocation {
|
$location = $perlvar{'lonDocRoot'}.'/'.$file; |
$location = $perlvar{'lonDocRoot'}.'/'.$file; |
} else { |
} else { |
$file=~s/^\Q$perlvar{'lonDocRoot'}\E//; |
$file=~s/^\Q$perlvar{'lonDocRoot'}\E//; |
$file=~s:^/res/:/:; |
$file=~s:^/(res|priv)/:/:; |
|
my $space=$1; |
if ( !( $file =~ m:^/:) ) { |
if ( !( $file =~ m:^/:) ) { |
$location = $dir. '/'.$file; |
$location = $dir. '/'.$file; |
} else { |
} else { |
$location = '/home/httpd/html/res'.$file; |
$location = $perlvar{'lonDocRoot'}.'/'.$space.$file; |
} |
} |
} |
} |
$location=~s://+:/:g; # remove duplicate / |
$location=~s://+:/:g; # remove duplicate / |
Line 10206 sub hreflocation {
|
Line 10269 sub hreflocation {
|
} |
} |
if ($file=~m-^\Q$perlvar{'lonDocRoot'}\E-) { |
if ($file=~m-^\Q$perlvar{'lonDocRoot'}\E-) { |
$file=~s-^\Q$perlvar{'lonDocRoot'}\E--; |
$file=~s-^\Q$perlvar{'lonDocRoot'}\E--; |
} elsif ($file=~m-/home/($match_username)/public_html/-) { |
|
$file=~s-^/home/($match_username)/public_html/-/~$1/-; |
|
} elsif ($file=~m-^\Q$perlvar{'lonUsersDir'}\E-) { |
} elsif ($file=~m-^\Q$perlvar{'lonUsersDir'}\E-) { |
$file=~s-^/home/httpd/lonUsers/($match_domain)/./././($match_name)/userfiles/ |
$file=~s{^/home/httpd/lonUsers/($match_domain)/./././($match_name)/userfiles/} |
-/uploaded/$1/$2/-x; |
{/uploaded/$1/$2/}x; |
} |
} |
if ($file=~ m{^/userfiles/}) { |
if ($file=~ m{^/userfiles/}) { |
$file =~ s{^/userfiles/}{/uploaded/}; |
$file =~ s{^/userfiles/}{/uploaded/}; |
Line 10218 sub hreflocation {
|
Line 10279 sub hreflocation {
|
return $file; |
return $file; |
} |
} |
|
|
|
|
|
|
|
|
|
|
sub current_machine_domains { |
sub current_machine_domains { |
return &machine_domains(&hostname($perlvar{'lonHostID'})); |
return &machine_domains(&hostname($perlvar{'lonHostID'})); |
} |
} |
Line 10406 sub get_dns {
|
Line 10471 sub get_dns {
|
while (%alldns) { |
while (%alldns) { |
my ($dns) = keys(%alldns); |
my ($dns) = keys(%alldns); |
my $ua=new LWP::UserAgent; |
my $ua=new LWP::UserAgent; |
|
$ua->timeout(30); |
my $request=new HTTP::Request('GET',"$alldns{$dns}://$dns$url"); |
my $request=new HTTP::Request('GET',"$alldns{$dns}://$dns$url"); |
my $response=$ua->request($request); |
my $response=$ua->request($request); |
delete($alldns{$dns}); |
delete($alldns{$dns}); |
Line 10921 BEGIN {
|
Line 10987 BEGIN {
|
} |
} |
} |
} |
|
|
|
# ---------------------------------------------------------- Read managers table |
|
{ |
|
if (-e "$perlvar{'lonTabDir'}/managers.tab") { |
|
if (open(my $config,"<$perlvar{'lonTabDir'}/managers.tab")) { |
|
while (my $configline=<$config>) { |
|
chomp($configline); |
|
next if ($configline =~ /^\#/); |
|
if (($configline =~ /^[\w\-]+$/) || ($configline =~ /^[\w\-]+\:[\w\-]+$/)) { |
|
$managerstab{$configline} = 1; |
|
} |
|
} |
|
close($config); |
|
} |
|
} |
|
} |
|
|
# ------------- set up temporary directory |
# ------------- set up temporary directory |
{ |
{ |
$tmpdir = LONCAPA::tempdir(); |
$tmpdir = LONCAPA::tempdir(); |
Line 11773 or lonTabs/domain.tab.
|
Line 11855 or lonTabs/domain.tab.
|
|
|
=item * |
=item * |
|
|
dirlist($uri) : return directory list based on URI |
dirlist() : return directory list based on URI (first arg). |
|
|
|
Inputs: 1 required, 5 optional. |
|
|
|
=over |
|
|
|
=item |
|
$uri - path to file in filesystem (starts: /res or /userfiles/). Required. |
|
|
|
=item |
|
$userdomain - domain of user/course to be listed. Extracted from $uri if absent. |
|
|
|
=item |
|
$username - username of user/course to be listed. Extracted from $uri if absent. |
|
|
|
=item |
|
$getpropath - boolean: 1 if prepend path using &propath(). |
|
|
|
=item |
|
$getuserdir - boolean: 1 if prepend path for "userfiles". |
|
|
|
=item |
|
$alternateRoot - path to prepend in place of path from $uri. |
|
|
|
=back |
|
|
|
Returns: Array of up to two items. |
|
|
|
=over |
|
|
|
a reference to an array of files/subdirectories |
|
|
|
=over |
|
|
|
Each element in the array of files/subdirectories is a & separated list of |
|
item name and the result of running stat on the item. If dirlist was requested |
|
for a file instead of a directory, the item name will be ''. For a directory |
|
listing, if the item is a metadata file, the element will end &N&M |
|
(where N amd M are either 0 or 1, corresponding to obsolete set (1), or |
|
default copyright set (1). |
|
|
|
=back |
|
|
|
a scalar containing error condition (if encountered). |
|
|
|
=over |
|
|
|
=item |
|
no_host (no homeserver identified for $username:$domain). |
|
|
|
=item |
|
no_such_host (server contacted for listing not identified as valid host). |
|
|
|
=item |
|
con_lost (connection to remote server failed). |
|
|
|
=item |
|
refused (invalid $username:$domain received on lond side). |
|
|
|
=item |
|
no_such_dir (directory at specified path on lond side does not exist). |
|
|
|
=item |
|
empty (directory at specified path on lond side is empty). |
|
|
|
=over |
|
|
|
This is currently not encountered because the &ls3, &ls2, |
|
&ls (_handler) routines on the lond side do not filter out |
|
. and .. from a directory listing. |
|
|
|
=back |
|
|
|
=back |
|
|
|
=back |
|
|
=item * |
=item * |
|
|