version 1.678, 2005/11/15 21:35:02
|
version 1.683.2.13, 2006/01/26 06:34:33
|
Line 40 qw(%perlvar %hostname %badServerCache %i
|
Line 40 qw(%perlvar %hostname %badServerCache %i
|
%courselogs %accesshash %userrolehash %domainrolehash $processmarker $dumpcount |
%courselogs %accesshash %userrolehash %domainrolehash $processmarker $dumpcount |
%coursedombuf %coursenumbuf %coursehombuf %coursedescrbuf %courseinstcodebuf %courseownerbuf |
%coursedombuf %coursenumbuf %coursehombuf %coursedescrbuf %courseinstcodebuf %courseownerbuf |
%domaindescription %domain_auth_def %domain_auth_arg_def |
%domaindescription %domain_auth_def %domain_auth_arg_def |
%domain_lang_def %domain_city %domain_longi %domain_lati $tmpdir $_64bit |
%domain_lang_def %domain_city %domain_longi %domain_lati %domain_primary |
%env); |
$tmpdir $_64bit %env); |
|
|
use IO::Socket; |
use IO::Socket; |
use GDBM_File; |
use GDBM_File; |
Line 271 sub transfer_profile_to_env {
|
Line 271 sub transfer_profile_to_env {
|
my %Remove; |
my %Remove; |
for ($envi=0;$envi<=$#profile;$envi++) { |
for ($envi=0;$envi<=$#profile;$envi++) { |
chomp($profile[$envi]); |
chomp($profile[$envi]); |
my ($envname,$envvalue)=split(/=/,$profile[$envi]); |
my ($envname,$envvalue)=split(/=/,$profile[$envi],2); |
$env{$envname} = $envvalue; |
$env{$envname} = $envvalue; |
if (my ($key,$time) = ($envname =~ /^(cgi\.(\d+)_\d+\.)/)) { |
if (my ($key,$time) = ($envname =~ /^(cgi\.(\d+)_\d+\.)/)) { |
if ($time < time-300) { |
if ($time < time-300) { |
Line 323 sub appenv {
|
Line 323 sub appenv {
|
for (my $i=0; $i<=$#oldenv; $i++) { |
for (my $i=0; $i<=$#oldenv; $i++) { |
chomp($oldenv[$i]); |
chomp($oldenv[$i]); |
if ($oldenv[$i] ne '') { |
if ($oldenv[$i] ne '') { |
my ($name,$value)=split(/=/,$oldenv[$i]); |
my ($name,$value)=split(/=/,$oldenv[$i],2); |
unless (defined($newenv{$name})) { |
unless (defined($newenv{$name})) { |
$newenv{$name}=$value; |
$newenv{$name}=$value; |
} |
} |
Line 382 sub delenv {
|
Line 382 sub delenv {
|
} |
} |
foreach (@oldenv) { |
foreach (@oldenv) { |
if ($_=~/^$delthis/) { |
if ($_=~/^$delthis/) { |
my ($key,undef) = split('=',$_); |
my ($key,undef) = split('=',$_,2); |
delete($env{$key}); |
delete($env{$key}); |
} else { |
} else { |
print $fh $_; |
print $fh $_; |
Line 1853 sub courseiddump {
|
Line 1853 sub courseiddump {
|
# ---------------------------------------------------------- DC e-mail |
# ---------------------------------------------------------- DC e-mail |
|
|
sub dcmailput { |
sub dcmailput { |
my ($domain,$msgid,$contents,$server)=@_; |
my ($domain,$msgid,$message,$server)=@_; |
my $status = &Apache::lonnet::critical( |
my $status = &Apache::lonnet::critical( |
'dcmailput:'.$domain.':'.&Apache::lonnet::escape($msgid).'='. |
'dcmailput:'.$domain.':'.&Apache::lonnet::escape($msgid).'='. |
&Apache::lonnet::escape($$contents{$server}),$server); |
&Apache::lonnet::escape($message),$server); |
return $status; |
return $status; |
} |
} |
|
|
sub dcmaildump { |
sub dcmaildump { |
my ($dom,$startdate,$enddate,$senders) = @_; |
my ($dom,$startdate,$enddate,$senders) = @_; |
my %returnhash=(); |
my %returnhash=(); |
foreach my $tryserver (keys(%libserv)) { |
if (exists($domain_primary{$dom})) { |
if ($hostdom{$tryserver} eq $dom) { |
my $cmd='dcmaildump:'.$dom.':'.&escape($startdate).':'. |
%{$returnhash{$tryserver}}=(); |
&escape($enddate).':'; |
my $cmd='dcmaildump:'.$dom.':'. |
my @esc_senders=map { &escape($_)} @$senders; |
&escape($startdate).':'.&escape($enddate).':'; |
$cmd.=&escape(join('&',@esc_senders)); |
my @esc_senders=map { &escape($_)} @$senders; |
foreach (split(/\&/,&reply($cmd,$domain_primary{$dom}))) { |
$cmd.=&escape(join('&',@esc_senders)); |
my ($key,$value) = split(/\=/,$_); |
foreach (split(/\&/,&reply($cmd,$tryserver))) { |
if (($key) && ($value)) { |
my ($key,$value) = split(/\=/,$_); |
$returnhash{&unescape($key)} = &unescape($value); |
if (($key) && ($value)) { |
|
$returnhash{$tryserver}{&unescape($key)} = &unescape($value); |
|
} |
|
} |
} |
} |
} |
} |
} |
Line 2693 sub set_userprivs {
|
Line 2690 sub set_userprivs {
|
my $author=0; |
my $author=0; |
my $adv=0; |
my $adv=0; |
my %grouproles = (); |
my %grouproles = (); |
my %groups_checked = (); |
|
if (keys(%{$allgroups}) > 0) { |
if (keys(%{$allgroups}) > 0) { |
foreach my $role (keys %{$allroles}) { |
foreach my $role (keys %{$allroles}) { |
my ($trole,$area); |
my ($trole,$area,$sec,$extendedarea); |
if ($role =~ m|^(\w+)\.(/\w+/\w+)|) { |
if ($role =~ m|^(\w+)\.(/\w+/\w+)(/?\w*)|) { |
$trole = $1; |
$trole = $1; |
$area = $2; |
$area = $2; |
unless ($groups_checked{$area}) { |
$sec = $3; |
$groups_checked{$area} = 1; |
$extendedarea = $area.$sec; |
if (exists($$allgroups{$area})) { |
if (exists($$allgroups{$area})) { |
foreach my $group (keys(%{$$allgroups{$area}})) { |
foreach my $group (keys(%{$$allgroups{$area}})) { |
my $spec = $trole.'.'.$area; |
my $spec = $trole.'.'.$extendedarea; |
$grouproles{$spec.'.'.$area.'/'.$group} = |
$grouproles{$spec.'.'.$area.'/'.$group} = |
$$allgroups{$area}{$group}; |
$$allgroups{$area}{$group}; |
} |
|
} |
} |
} |
} |
} |
} |
Line 3015 sub tmpput {
|
Line 3010 sub tmpput {
|
|
|
# ------------------------------------------------------------ tmpget interface |
# ------------------------------------------------------------ tmpget interface |
sub tmpget { |
sub tmpget { |
my ($token)=@_; |
my ($token,$server)=@_; |
my $rep=&reply("tmpget:$token",$perlvar{'lonHostID'}); |
if (!defined($server)) { $server = $perlvar{'lonHostID'}; } |
|
my $rep=&reply("tmpget:$token",$server); |
my %returnhash; |
my %returnhash; |
foreach my $item (split(/\&/,$rep)) { |
foreach my $item (split(/\&/,$rep)) { |
my ($key,$value)=split(/=/,$item); |
my ($key,$value)=split(/=/,$item); |
Line 3025 sub tmpget {
|
Line 3021 sub tmpget {
|
return %returnhash; |
return %returnhash; |
} |
} |
|
|
|
# ------------------------------------------------------------ tmpget interface |
|
sub tmpdel { |
|
my ($token,$server)=@_; |
|
if (!defined($server)) { $server = $perlvar{'lonHostID'}; } |
|
return &reply("tmpdel:$token",$server); |
|
} |
|
|
# ---------------------------------------------- Custom access rule evaluation |
# ---------------------------------------------- Custom access rule evaluation |
|
|
sub customaccess { |
sub customaccess { |
Line 3343 sub allowed {
|
Line 3346 sub allowed {
|
my $unamedom=$env{'user.name'}.':'.$env{'user.domain'}; |
my $unamedom=$env{'user.name'}.':'.$env{'user.domain'}; |
if ($env{'course.'.$env{'request.course.id'}.'.'.$priv.'.roles.denied'} |
if ($env{'course.'.$env{'request.course.id'}.'.'.$priv.'.roles.denied'} |
=~/\Q$rolecode\E/) { |
=~/\Q$rolecode\E/) { |
&logthis($env{'user.domain'}.':'.$env{'user.name'}.':'.$env{'user.home'}.':'. |
if ($priv ne 'pch') { |
'Denied by role: '.$priv.' for '.$uri.' as '.$rolecode.' in '. |
&logthis($env{'user.domain'}.':'.$env{'user.name'}.':'.$env{'user.home'}.':'. |
$env{'request.course.id'}); |
'Denied by role: '.$priv.' for '.$uri.' as '.$rolecode.' in '. |
|
$env{'request.course.id'}); |
|
} |
return ''; |
return ''; |
} |
} |
|
|
if ($env{'course.'.$env{'request.course.id'}.'.'.$priv.'.users.denied'} |
if ($env{'course.'.$env{'request.course.id'}.'.'.$priv.'.users.denied'} |
=~/\Q$unamedom\E/) { |
=~/\Q$unamedom\E/) { |
&logthis($env{'user.domain'}.':'.$env{'user.name'}.':'.$env{'user.home'}. |
if ($priv ne 'pch') { |
'Denied by user: '.$priv.' for '.$uri.' as '.$unamedom.' in '. |
&logthis($env{'user.domain'}.':'.$env{'user.name'}.':'.$env{'user.home'}. |
$env{'request.course.id'}); |
'Denied by user: '.$priv.' for '.$uri.' as '.$unamedom.' in '. |
|
$env{'request.course.id'}); |
|
} |
return ''; |
return ''; |
} |
} |
} |
} |
Line 3363 sub allowed {
|
Line 3370 sub allowed {
|
if ($thisallowed=~/R/) { |
if ($thisallowed=~/R/) { |
my $rolecode=(split(/\./,$env{'request.role'}))[0]; |
my $rolecode=(split(/\./,$env{'request.role'}))[0]; |
if (&metadata($uri,'roledeny')=~/\Q$rolecode\E/) { |
if (&metadata($uri,'roledeny')=~/\Q$rolecode\E/) { |
&logthis($env{'user.domain'}.':'.$env{'user.name'}.':'.$env{'user.home'}.':'. |
if ($priv ne 'pch') { |
'Denied by role: '.$priv.' for '.$uri.' as '.$rolecode); |
&logthis($env{'user.domain'}.':'.$env{'user.name'}.':'.$env{'user.home'}.':'. |
return ''; |
'Denied by role: '.$priv.' for '.$uri.' as '.$rolecode); |
|
} |
|
return ''; |
} |
} |
} |
} |
|
|
Line 3396 sub is_on_map {
|
Line 3405 sub is_on_map {
|
my $filename=$uriparts[$#uriparts]; |
my $filename=$uriparts[$#uriparts]; |
my $pathname=$uri; |
my $pathname=$uri; |
$pathname=~s|/\Q$filename\E$||; |
$pathname=~s|/\Q$filename\E$||; |
$pathname=~s/^adm\/wrapper\///; |
$pathname=~s/^adm\/wrapper\///; |
|
$pathname=~s/^adm\/coursedocs\/showdoc\///; |
#Trying to find the conditional for the file |
#Trying to find the conditional for the file |
my $match=($env{'acc.res.'.$env{'request.course.id'}.'.'.$pathname}=~ |
my $match=($env{'acc.res.'.$env{'request.course.id'}.'.'.$pathname}=~ |
/\&\Q$filename\E\:([\d\|]+)\&/); |
/\&\Q$filename\E\:([\d\|]+)\&/); |
Line 3702 sub auto_instcode_format {
|
Line 3712 sub auto_instcode_format {
|
return $response; |
return $response; |
} |
} |
|
|
|
# ------------------------------------------------------- Course Group routines |
|
|
|
sub get_coursegroups { |
|
my ($cdom,$cnum,$group) = @_; |
|
return(&dump('coursegroups',$cdom,$cnum,$group)); |
|
} |
|
|
|
sub modify_coursegroup { |
|
my ($cdom,$cnum,$groupsettings) = @_; |
|
return(&put('coursegroups',$groupsettings,$cdom,$cnum)); |
|
} |
|
|
|
sub modify_group_roles { |
|
my ($cdom,$cnum,$group_id,$user,$end,$start,$userprivs) = @_; |
|
my $url = '/'.$cdom.'/'.$cnum.'/'.$group_id; |
|
my $role = 'gr/'.&escape($userprivs); |
|
my ($uname,$udom) = split(/:/,$user); |
|
my $result = &assignrole($udom,$uname,$url,$role,$end,$start); |
|
return $result; |
|
} |
|
|
|
sub modify_coursegroup_membership { |
|
my ($cdom,$cnum,$membership) = @_; |
|
my $result = &put('groupmembership',$membership,$cdom,$cnum); |
|
return $result; |
|
} |
|
|
|
sub get_active_groups { |
|
my ($udom,$uname,$cdom,$cnum) = @_; |
|
my $now = time; |
|
my %groups = (); |
|
foreach my $key (keys(%env)) { |
|
if ($key =~ m-user\.role\.gr\./([^/]+)/([^/]+)/(\w+)$-) { |
|
my ($start,$end) = split(/\./,$env{$key}); |
|
if (($end!=0) && ($end<$now)) { next; } |
|
if (($start!=0) && ($start>$now)) { next; } |
|
if ($1 eq $cdom && $2 eq $cnum) { |
|
$groups{$3} = $env{$key} ; |
|
} |
|
} |
|
} |
|
return %groups; |
|
} |
|
|
|
sub get_group_membership { |
|
my ($cdom,$cnum,$group) = @_; |
|
return(&dump('groupmembership',$cdom,$cnum,$group)); |
|
} |
|
|
|
sub get_users_groups { |
|
my ($udom,$uname,$courseid) = @_; |
|
my $cachetime=1800; |
|
$courseid=~s/\_/\//g; |
|
$courseid=~s/^(\w)/\/$1/; |
|
|
|
my $hashid="$udom:$uname:$courseid"; |
|
my ($result,$cached)=&is_cached_new('getgroups',$hashid); |
|
if (defined($cached)) { return $result; } |
|
|
|
my %roleshash = &dump('roles',$udom,$uname,$courseid); |
|
my ($tmp) = keys(%roleshash); |
|
if ($tmp=~/^error:/) { |
|
&logthis('Error retrieving roles: '.$tmp.' for '.$uname.':'.$udom); |
|
return ''; |
|
} else { |
|
my $grouplist; |
|
foreach my $key (keys %roleshash) { |
|
if ($key =~ /^\Q$courseid\E\/(\w+)\_gr$/) { |
|
unless ($roleshash{$key} =~ /_1_1$/) { # deleted membership |
|
$grouplist .= $1.':'; |
|
} |
|
} |
|
} |
|
$grouplist =~ s/:$//; |
|
return &do_cache_new('getgroups',$hashid,$grouplist,$cachetime); |
|
} |
|
} |
|
|
|
sub devalidate_getgroups_cache { |
|
my ($udom,$uname,$cdom,$cnum)=@_; |
|
my $courseid = $cdom.'_'.$cnum; |
|
$courseid=~s/\_/\//g; |
|
$courseid=~s/^(\w)/\/$1/; |
|
my $hashid="$udom:$uname:$courseid"; |
|
&devalidate_cache_new('getgroups',$hashid); |
|
} |
|
|
# ------------------------------------------------------------------ Plain Text |
# ------------------------------------------------------------------ Plain Text |
|
|
sub plaintext { |
sub plaintext { |
Line 3894 sub modifyuser {
|
Line 3991 sub modifyuser {
|
} |
} |
my $reply = &put('environment', \%names, $udom,$uname); |
my $reply = &put('environment', \%names, $udom,$uname); |
if ($reply ne 'ok') { return 'error: '.$reply; } |
if ($reply ne 'ok') { return 'error: '.$reply; } |
|
&devalidate_cache_new('namescache',$uname.':'.$udom); |
&logthis('Success modifying user '.$udom.', '.$uname.', '.$uid.', '. |
&logthis('Success modifying user '.$udom.', '.$uname.', '.$uid.', '. |
$umode.', '.$first.', '.$middle.', '. |
$umode.', '.$first.', '.$middle.', '. |
$last.', '.$gene.' by '. |
$last.', '.$gene.' by '. |
Line 4832 sub EXT {
|
Line 4930 sub EXT {
|
if ($space eq 'time') { |
if ($space eq 'time') { |
return time; |
return time; |
} |
} |
|
} elsif ($realm eq 'server') { |
|
# ----------------------------------------------------------------- system.time |
|
if ($space eq 'name') { |
|
return $ENV{'SERVER_NAME'}; |
|
} |
} |
} |
return ''; |
return ''; |
} |
} |
Line 5063 sub metadata {
|
Line 5166 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,60*60*24); |
&do_cache_new('meta',$uri,\%metaentry,60*60); |
# this is the end of "was not already recently cached |
# this is the end of "was not already recently cached |
} |
} |
return $metaentry{':'.$what}; |
return $metaentry{':'.$what}; |
Line 5159 sub get_slot {
|
Line 5262 sub get_slot {
|
$cdom=$env{'course.'.$courseid.'.domain'}; |
$cdom=$env{'course.'.$courseid.'.domain'}; |
$cnum=$env{'course.'.$courseid.'.num'}; |
$cnum=$env{'course.'.$courseid.'.num'}; |
} |
} |
my %slotinfo=&get('slots',[$which],$cdom,$cnum); |
my $key=join("\0",'slots',$cdom,$cnum,$which); |
&Apache::lonhomework::showhash(%slotinfo); |
my %slotinfo; |
my ($tmp)=keys(%slotinfo); |
if (exists($remembered{$key})) { |
if ($tmp=~/^error:/) { return (); } |
$slotinfo{$which} = $remembered{$key}; |
|
} else { |
|
%slotinfo=&get('slots',[$which],$cdom,$cnum); |
|
&Apache::lonhomework::showhash(%slotinfo); |
|
my ($tmp)=keys(%slotinfo); |
|
if ($tmp=~/^error:/) { return (); } |
|
$remembered{$key} = $slotinfo{$which}; |
|
} |
if (ref($slotinfo{$which}) eq 'HASH') { |
if (ref($slotinfo{$which}) eq 'HASH') { |
return %{$slotinfo{$which}}; |
return %{$slotinfo{$which}}; |
} |
} |
Line 5196 sub symbverify {
|
Line 5306 sub symbverify {
|
my $thisfn=$thisurl; |
my $thisfn=$thisurl; |
# wrapper not part of symbs |
# wrapper not part of symbs |
$thisfn=~s/^\/adm\/wrapper//; |
$thisfn=~s/^\/adm\/wrapper//; |
|
$thisfn=~s/^\/adm\/coursedocs\/showdoc\///; |
$thisfn=&declutter($thisfn); |
$thisfn=&declutter($thisfn); |
# direct jump to resource in page or to a sequence - will construct own symbs |
# direct jump to resource in page or to a sequence - will construct own symbs |
if ($thisfn=~/\.(page|sequence)$/) { return 1; } |
if ($thisfn=~/\.(page|sequence)$/) { return 1; } |
Line 5250 sub symbclean {
|
Line 5361 sub symbclean {
|
# remove wrapper |
# remove wrapper |
|
|
$symb=~s/(\_\_\_\d+\_\_\_)adm\/wrapper\/(res\/)*/$1/; |
$symb=~s/(\_\_\_\d+\_\_\_)adm\/wrapper\/(res\/)*/$1/; |
|
$symb=~s/(\_\_\_\d+\_\_\_)adm\/coursedocs\/showdoc\/(res\/)*/$1/; |
return $symb; |
return $symb; |
} |
} |
|
|
Line 5326 sub symbread {
|
Line 5438 sub symbread {
|
if ( ($thisfn =~ m/^(uploaded|editupload)\//) && ($thisfn !~ m/\.(page|sequence)$/) ) { |
if ( ($thisfn =~ m/^(uploaded|editupload)\//) && ($thisfn !~ m/\.(page|sequence)$/) ) { |
$targetfn = 'adm/wrapper/'.$thisfn; |
$targetfn = 'adm/wrapper/'.$thisfn; |
} |
} |
|
if ($targetfn =~ m|^adm/wrapper/(ext/.*)|) { |
|
$targetfn=$1; |
|
} |
if (tie(%hash,'GDBM_File',$env{'request.course.fn'}.'_symb.db', |
if (tie(%hash,'GDBM_File',$env{'request.course.fn'}.'_symb.db', |
&GDBM_READER(),0640)) { |
&GDBM_READER(),0640)) { |
$syval=$hash{$targetfn}; |
$syval=$hash{$targetfn}; |
Line 5897 sub filelocation {
|
Line 6012 sub filelocation {
|
my ($dir,$file) = @_; |
my ($dir,$file) = @_; |
my $location; |
my $location; |
$file=~ s/^\s*(\S+)\s*$/$1/; ## strip off leading and trailing spaces |
$file=~ s/^\s*(\S+)\s*$/$1/; ## strip off leading and trailing spaces |
|
|
|
if ($file =~ m-^/adm/-) { |
|
$file=~s-^/adm/wrapper/-/-; |
|
$file=~s-^/adm/coursedocs/showdoc/-/-; |
|
} |
if ($file=~m:^/~:) { # is a contruction space reference |
if ($file=~m:^/~:) { # is a contruction space reference |
$location = $file; |
$location = $file; |
$location =~ s:/~(.*?)/(.*):/home/$1/public_html/$2:; |
$location =~ s:/~(.*?)/(.*):/home/$1/public_html/$2:; |
Line 5936 sub hreflocation {
|
Line 6056 sub hreflocation {
|
my ($dir,$file)=@_; |
my ($dir,$file)=@_; |
unless (($file=~m-^http://-i) || ($file=~m-^/-)) { |
unless (($file=~m-^http://-i) || ($file=~m-^/-)) { |
$file=filelocation($dir,$file); |
$file=filelocation($dir,$file); |
|
} elsif ($file=~m-^/adm/-) { |
|
$file=~s-^/adm/wrapper/-/-; |
|
$file=~s-^/adm/coursedocs/showdoc/-/-; |
} |
} |
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--; |
Line 5979 sub declutter {
|
Line 6102 sub declutter {
|
if ($thisfn=~m|^/enc/|) { $thisfn=&Apache::lonenc::unencrypted($thisfn); } |
if ($thisfn=~m|^/enc/|) { $thisfn=&Apache::lonenc::unencrypted($thisfn); } |
$thisfn=~s/^\Q$perlvar{'lonDocRoot'}\E//; |
$thisfn=~s/^\Q$perlvar{'lonDocRoot'}\E//; |
$thisfn=~s/^\///; |
$thisfn=~s/^\///; |
|
$thisfn=~s|^adm/wrapper/||; |
|
$thisfn=~s|^adm/coursedocs/showdoc/||; |
$thisfn=~s/^res\///; |
$thisfn=~s/^res\///; |
$thisfn=~s/\?.+$//; |
$thisfn=~s/\?.+$//; |
return $thisfn; |
return $thisfn; |
Line 5991 sub clutter {
|
Line 6116 sub clutter {
|
unless ($thisfn=~/^\/(uploaded|editupload|adm|userfiles|ext|raw|priv|public)\//) { |
unless ($thisfn=~/^\/(uploaded|editupload|adm|userfiles|ext|raw|priv|public)\//) { |
$thisfn='/res'.$thisfn; |
$thisfn='/res'.$thisfn; |
} |
} |
|
if ($thisfn !~m|/adm|) { |
|
if ($thisfn =~ m|/ext/|) { |
|
$thisfn='/adm/wrapper'.$thisfn; |
|
} else { |
|
my ($ext) = ($thisfn =~ /\.(\w+)$/); |
|
my $embstyle=&Apache::loncommon::fileembstyle($ext); |
|
if ($embstyle eq 'ssi' |
|
|| ($embstyle eq 'hdn') |
|
|| ($embstyle eq 'rat') |
|
|| ($embstyle eq 'prv') |
|
|| ($embstyle eq 'ign')) { |
|
#do nothing with these |
|
} elsif (($embstyle eq 'img') |
|
|| ($embstyle eq 'emb') |
|
|| ($embstyle eq 'wrp')) { |
|
$thisfn='/adm/wrapper'.$thisfn; |
|
} elsif ($embstyle eq 'unk' |
|
&& $thisfn!~/\.(sequence|page)$/) { |
|
$thisfn='/adm/coursedocs/showdoc'.$thisfn; |
|
} else { |
|
#&logthis("Got a blank emb style"); |
|
} |
|
} |
|
} |
return $thisfn; |
return $thisfn; |
} |
} |
|
|
Line 6099 BEGIN {
|
Line 6248 BEGIN {
|
# next if /^\#/; |
# next if /^\#/; |
chomp; |
chomp; |
my ($domain, $domain_description, $def_auth, $def_auth_arg, |
my ($domain, $domain_description, $def_auth, $def_auth_arg, |
$def_lang, $city, $longi, $lati) = split(/:/,$_); |
$def_lang, $city, $longi, $lati, $primary) = split(/:/,$_); |
$domain_auth_def{$domain}=$def_auth; |
$domain_auth_def{$domain}=$def_auth; |
$domain_auth_arg_def{$domain}=$def_auth_arg; |
$domain_auth_arg_def{$domain}=$def_auth_arg; |
$domaindescription{$domain}=$domain_description; |
$domaindescription{$domain}=$domain_description; |
Line 6107 BEGIN {
|
Line 6256 BEGIN {
|
$domain_city{$domain}=$city; |
$domain_city{$domain}=$city; |
$domain_longi{$domain}=$longi; |
$domain_longi{$domain}=$longi; |
$domain_lati{$domain}=$lati; |
$domain_lati{$domain}=$lati; |
|
$domain_primary{$domain}=$primary; |
|
|
# &logthis("Domain.tab: $domain, $domain_auth_def{$domain}, $domain_auth_arg_def{$domain},$domaindescription{$domain}"); |
# &logthis("Domain.tab: $domain, $domain_auth_def{$domain}, $domain_auth_arg_def{$domain},$domaindescription{$domain}"); |
# &logthis("Domain.tab: $domain ".$domaindescription{$domain} ); |
# &logthis("Domain.tab: $domain ".$domaindescription{$domain} ); |
Line 6133 BEGIN {
|
Line 6283 BEGIN {
|
} |
} |
close($config); |
close($config); |
# FIXME: dev server don't want this, production servers _do_ want this |
# FIXME: dev server don't want this, production servers _do_ want this |
#&get_iphost(); |
&get_iphost(); |
} |
} |
|
|
sub get_iphost { |
sub get_iphost { |