version 1.784, 2006/09/28 01:38:59
|
version 1.792, 2006/10/16 19:18:15
|
Line 52 use Storable qw(lock_store lock_nstore l
|
Line 52 use Storable qw(lock_store lock_nstore l
|
use Time::HiRes qw( gettimeofday tv_interval ); |
use Time::HiRes qw( gettimeofday tv_interval ); |
use Cache::Memcached; |
use Cache::Memcached; |
use Digest::MD5; |
use Digest::MD5; |
|
use Math::Random; |
use lib '/home/httpd/lib/perl'; |
use lib '/home/httpd/lib/perl'; |
use LONCAPA; |
use LONCAPA; |
use LONCAPA::Configuration; |
use LONCAPA::Configuration; |
Line 303 sub convert_and_load_session_env {
|
Line 304 sub convert_and_load_session_env {
|
} |
} |
my %temp_env; |
my %temp_env; |
foreach my $line (@profile) { |
foreach my $line (@profile) { |
|
if ($line !~ m/=/) { |
|
return 0; |
|
} |
chomp($line); |
chomp($line); |
my ($envname,$envvalue)=split(/=/,$line,2); |
my ($envname,$envvalue)=split(/=/,$line,2); |
$temp_env{&unescape($envname)} = &unescape($envvalue); |
$temp_env{&unescape($envname)} = &unescape($envvalue); |
Line 314 sub convert_and_load_session_env {
|
Line 318 sub convert_and_load_session_env {
|
@env{keys(%temp_env)} = @disk_env{keys(%temp_env)}; |
@env{keys(%temp_env)} = @disk_env{keys(%temp_env)}; |
untie(%disk_env); |
untie(%disk_env); |
} |
} |
|
return 1; |
} |
} |
|
|
# ------------------------------------------- Transfer profile into environment |
# ------------------------------------------- Transfer profile into environment |
my $env_loaded; |
my $env_loaded; |
sub transfer_profile_to_env { |
sub transfer_profile_to_env { |
if ($env_loaded) { return; } |
my ($lonidsdir,$handle,$force_transfer) = @_; |
|
if (!$force_transfer && $env_loaded) { return; } |
|
|
my ($lonidsdir,$handle)=@_; |
|
if (!defined($lonidsdir)) { |
if (!defined($lonidsdir)) { |
$lonidsdir = $perlvar{'lonIDsDir'}; |
$lonidsdir = $perlvar{'lonIDsDir'}; |
} |
} |
Line 329 sub transfer_profile_to_env {
|
Line 334 sub transfer_profile_to_env {
|
($handle) = ($env{'user.environment'} =~m|/([^/]+)\.id$| ); |
($handle) = ($env{'user.environment'} =~m|/([^/]+)\.id$| ); |
} |
} |
|
|
my %remove; |
my $convert; |
if (tie(my %disk_env,'GDBM_File',"$lonidsdir/$handle.id",&GDBM_READER(), |
{ |
0640)) { |
open(my $idf,"$lonidsdir/$handle.id"); |
@env{keys(%disk_env)} = @disk_env{keys(%disk_env)}; |
flock($idf,LOCK_SH); |
untie(%disk_env); |
if (tie(my %disk_env,'GDBM_File',"$lonidsdir/$handle.id", |
} else { |
&GDBM_READER(),0640)) { |
&convert_and_load_session_env($lonidsdir,$handle); |
@env{keys(%disk_env)} = @disk_env{keys(%disk_env)}; |
|
untie(%disk_env); |
|
} else { |
|
$convert = 1; |
|
} |
|
} |
|
if ($convert) { |
|
if (!&convert_and_load_session_env($lonidsdir,$handle)) { |
|
&logthis("Failed to load session, or convert session."); |
|
} |
} |
} |
|
|
|
my %remove; |
while ( my $envname = each(%env) ) { |
while ( my $envname = each(%env) ) { |
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 398 sub delenv {
|
Line 413 sub delenv {
|
return 'ok'; |
return 'ok'; |
} |
} |
|
|
|
=pod |
|
|
|
=item * get_env_multiple($name) |
|
|
|
gets $name from the %env hash, it seemlessly handles the cases where multiple |
|
values may be defined and end up as an array ref. |
|
|
|
returns an array of values |
|
|
|
=cut |
|
|
|
sub get_env_multiple { |
|
my ($name) = @_; |
|
my @values; |
|
if (defined($env{$name})) { |
|
# exists is it an array |
|
if (ref($env{$name})) { |
|
@values=@{ $env{$name} }; |
|
} else { |
|
$values[0]=$env{$name}; |
|
} |
|
} |
|
return(@values); |
|
} |
|
|
# ------------------------------------------ Find out current server userload |
# ------------------------------------------ Find out current server userload |
# there is a copy in lond |
# there is a copy in lond |
sub userload { |
sub userload { |
Line 1170 sub absolute_url {
|
Line 1210 sub absolute_url {
|
return $protocol.$host_name; |
return $protocol.$host_name; |
} |
} |
|
|
sub absolute_url { |
|
my ($host_name) = @_; |
|
my $protocol = ($ENV{'SERVER_PORT'} == 443?'https://':'http://'); |
|
if ($host_name eq '') { |
|
$host_name = $ENV{'SERVER_NAME'}; |
|
} |
|
return $protocol.$host_name; |
|
} |
|
|
|
sub ssi { |
sub ssi { |
|
|
my ($fn,%form)=@_; |
my ($fn,%form)=@_; |
Line 1948 sub courseidput {
|
Line 1979 sub courseidput {
|
} |
} |
|
|
sub courseiddump { |
sub courseiddump { |
my ($domfilter,$descfilter,$sincefilter,$instcodefilter,$ownerfilter,$coursefilter,$hostidflag,$hostidref,$typefilter)=@_; |
my ($domfilter,$descfilter,$sincefilter,$instcodefilter,$ownerfilter,$coursefilter,$hostidflag,$hostidref,$typefilter,$regexp_ok)=@_; |
my %returnhash=(); |
my %returnhash=(); |
unless ($domfilter) { $domfilter=''; } |
unless ($domfilter) { $domfilter=''; } |
foreach my $tryserver (keys %libserv) { |
foreach my $tryserver (keys %libserv) { |
Line 1957 sub courseiddump {
|
Line 1988 sub courseiddump {
|
foreach ( |
foreach ( |
split(/\&/,&reply('courseiddump:'.$hostdom{$tryserver}.':'. |
split(/\&/,&reply('courseiddump:'.$hostdom{$tryserver}.':'. |
$sincefilter.':'.&escape($descfilter).':'. |
$sincefilter.':'.&escape($descfilter).':'. |
&escape($instcodefilter).':'.&escape($ownerfilter).':'.&escape($coursefilter).':'.&escape($typefilter), |
&escape($instcodefilter).':'.&escape($ownerfilter).':'.&escape($coursefilter).':'.&escape($typefilter).':'.&escape($regexp_ok), |
$tryserver))) { |
$tryserver))) { |
my ($key,$value)=split(/\=/,$_); |
my ($key,$value)=split(/\=/,$_); |
if (($key) && ($value)) { |
if (($key) && ($value)) { |
Line 2030 sub get_domain_roles {
|
Line 2061 sub get_domain_roles {
|
|
|
sub get_first_access { |
sub get_first_access { |
my ($type,$argsymb)=@_; |
my ($type,$argsymb)=@_; |
my ($symb,$courseid,$udom,$uname)=&Apache::lonxml::whichuser(); |
my ($symb,$courseid,$udom,$uname)=&whichuser(); |
if ($argsymb) { $symb=$argsymb; } |
if ($argsymb) { $symb=$argsymb; } |
my ($map,$id,$res)=&decode_symb($symb); |
my ($map,$id,$res)=&decode_symb($symb); |
if ($type eq 'map') { |
if ($type eq 'map') { |
Line 2044 sub get_first_access {
|
Line 2075 sub get_first_access {
|
|
|
sub set_first_access { |
sub set_first_access { |
my ($type)=@_; |
my ($type)=@_; |
my ($symb,$courseid,$udom,$uname)=&Apache::lonxml::whichuser(); |
my ($symb,$courseid,$udom,$uname)=&whichuser(); |
my ($map,$id,$res)=&decode_symb($symb); |
my ($map,$id,$res)=&decode_symb($symb); |
if ($type eq 'map') { |
if ($type eq 'map') { |
$res=&symbread($map); |
$res=&symbread($map); |
Line 4226 sub auto_instcode_format {
|
Line 4257 sub auto_instcode_format {
|
} |
} |
} |
} |
|
|
|
sub auto_instcode_defaults { |
|
my ($domain,$returnhash,$code_order) = @_; |
|
my @homeservers; |
|
foreach my $tryserver (keys %libserv) { |
|
if ($hostdom{$tryserver} eq $domain) { |
|
if (!grep/^\Q$tryserver\E$/,@homeservers) { |
|
push(@homeservers,$tryserver); |
|
} |
|
} |
|
} |
|
my $ok_response = 0; |
|
my $response; |
|
while (@homeservers > 0 && $ok_response == 0) { |
|
my $server = shift(@homeservers); |
|
$response=&reply('autoinstcodedefaults:'.$domain,$server); |
|
if ($response !~ /(con_lost|error|no_such_host|refused)/) { |
|
foreach (split(/\&/,$response)) { |
|
my ($name,$value)=split(/\=/,$_); |
|
if ($name eq 'code_order') { |
|
@{$code_order} = split(/\&/,&unescape($value)); |
|
} else { |
|
$$returnhash{&unescape($name)}=&unescape($value); |
|
} |
|
} |
|
} |
|
$ok_response = 1; |
|
} |
|
if ($ok_response) { |
|
return 'ok'; |
|
} else { |
|
return $response; |
|
} |
|
} |
|
|
sub auto_validate_class_sec { |
sub auto_validate_class_sec { |
my ($cdom,$cnum,$owner,$inst_class) = @_; |
my ($cdom,$cnum,$owner,$inst_class) = @_; |
my $homeserver = &homeserver($cnum,$cdom); |
my $homeserver = &homeserver($cnum,$cdom); |
Line 5272 sub GetFileTimestamp {
|
Line 5337 sub GetFileTimestamp {
|
|
|
sub stat_file { |
sub stat_file { |
my ($uri) = @_; |
my ($uri) = @_; |
$uri = &clutter($uri); |
$uri = &clutter_with_no_wrapper($uri); |
|
|
# we want just the url part without the unneeded accessor url bits |
|
if ($uri =~ m-^/adm/-) { |
|
$uri=~s-^/adm/wrapper/-/-; |
|
$uri=~s-^/adm/coursedocs/showdoc/-/-; |
|
} |
|
my ($udom,$uname,$file,$dir); |
my ($udom,$uname,$file,$dir); |
if ($uri =~ m-^/(uploaded|editupload)/-) { |
if ($uri =~ m-^/(uploaded|editupload)/-) { |
($udom,$uname,$file) = |
($udom,$uname,$file) = |
Line 5510 sub EXT {
|
Line 5570 sub EXT {
|
$symbparm=&get_symb_from_alias($symbparm); |
$symbparm=&get_symb_from_alias($symbparm); |
} |
} |
if (!($uname && $udom)) { |
if (!($uname && $udom)) { |
(my $cursymb,$courseid,$udom,$uname,$publicuser)= |
(my $cursymb,$courseid,$udom,$uname,$publicuser)= &whichuser($symbparm); |
&Apache::lonxml::whichuser($symbparm); |
|
if (!$symbparm) { $symbparm=$cursymb; } |
if (!$symbparm) { $symbparm=$cursymb; } |
} else { |
} else { |
$courseid=$env{'request.course.id'}; |
$courseid=$env{'request.course.id'}; |
Line 6165 sub gettitle {
|
Line 6224 sub gettitle {
|
sub get_slot { |
sub get_slot { |
my ($which,$cnum,$cdom)=@_; |
my ($which,$cnum,$cdom)=@_; |
if (!$cnum || !$cdom) { |
if (!$cnum || !$cdom) { |
(undef,my $courseid)=&Apache::lonxml::whichuser(); |
(undef,my $courseid)=&whichuser(); |
$cdom=$env{'course.'.$courseid.'.domain'}; |
$cdom=$env{'course.'.$courseid.'.domain'}; |
$cnum=$env{'course.'.$courseid.'.num'}; |
$cnum=$env{'course.'.$courseid.'.num'}; |
} |
} |
Line 6214 sub symblist {
|
Line 6273 sub symblist {
|
sub symbverify { |
sub symbverify { |
my ($symb,$thisurl)=@_; |
my ($symb,$thisurl)=@_; |
my $thisfn=$thisurl; |
my $thisfn=$thisurl; |
# wrapper not part of symbs |
|
$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 6499 sub latest_rnd_algorithm_id {
|
Line 6555 sub latest_rnd_algorithm_id {
|
|
|
sub get_rand_alg { |
sub get_rand_alg { |
my ($courseid)=@_; |
my ($courseid)=@_; |
if (!$courseid) { $courseid=(&Apache::lonxml::whichuser())[1]; } |
if (!$courseid) { $courseid=(&whichuser())[1]; } |
if ($courseid) { |
if ($courseid) { |
return $env{"course.$courseid.rndseed"}; |
return $env{"course.$courseid.rndseed"}; |
} |
} |
Line 6525 sub getCODE {
|
Line 6581 sub getCODE {
|
sub rndseed { |
sub rndseed { |
my ($symb,$courseid,$domain,$username)=@_; |
my ($symb,$courseid,$domain,$username)=@_; |
|
|
my ($wsymb,$wcourseid,$wdomain,$wusername)=&Apache::lonxml::whichuser(); |
my ($wsymb,$wcourseid,$wdomain,$wusername)=&whichuser(); |
if (!$symb) { |
if (!$symb) { |
unless ($symb=$wsymb) { return time; } |
unless ($symb=$wsymb) { return time; } |
} |
} |
Line 6566 sub rndseed_32bit {
|
Line 6622 sub rndseed_32bit {
|
my $domainseed=unpack("%32C*",$domain) << 7; |
my $domainseed=unpack("%32C*",$domain) << 7; |
my $courseseed=unpack("%32C*",$courseid); |
my $courseseed=unpack("%32C*",$courseid); |
my $num=$symbseed+$nameseed+$domainseed+$courseseed+$namechck+$symbchck; |
my $num=$symbseed+$nameseed+$domainseed+$courseseed+$namechck+$symbchck; |
#&Apache::lonxml::debug("$symbseed:$nameseed;$domainseed|$courseseed;$namechck:$symbchck"); |
#&logthis("$symbseed:$nameseed;$domainseed|$courseseed;$namechck:$symbchck"); |
#&Apache::lonxml::debug("rndseed :$num:$symb"); |
#&logthis("rndseed :$num:$symb"); |
if ($_64bit) { $num=(($num<<32)>>32); } |
if ($_64bit) { $num=(($num<<32)>>32); } |
return $num; |
return $num; |
} |
} |
Line 6587 sub rndseed_64bit {
|
Line 6643 sub rndseed_64bit {
|
|
|
my $num1=$symbchck+$symbseed+$namechck; |
my $num1=$symbchck+$symbseed+$namechck; |
my $num2=$nameseed+$domainseed+$courseseed; |
my $num2=$nameseed+$domainseed+$courseseed; |
#&Apache::lonxml::debug("$symbseed:$nameseed;$domainseed|$courseseed;$namechck:$symbchck"); |
#&logthis("$symbseed:$nameseed;$domainseed|$courseseed;$namechck:$symbchck"); |
#&Apache::lonxml::debug("rndseed :$num:$symb"); |
#&logthis("rndseed :$num:$symb"); |
if ($_64bit) { $num1=(($num1<<32)>>32); $num2=(($num2<<32)>>32); } |
if ($_64bit) { $num1=(($num1<<32)>>32); $num2=(($num2<<32)>>32); } |
if ($_64bit) { $num1=(($num1<<32)>>32); $num2=(($num2<<32)>>32); } |
if ($_64bit) { $num1=(($num1<<32)>>32); $num2=(($num2<<32)>>32); } |
return "$num1,$num2"; |
return "$num1,$num2"; |
Line 6611 sub rndseed_64bit2 {
|
Line 6667 sub rndseed_64bit2 {
|
|
|
my $num1=$symbchck+$symbseed+$namechck; |
my $num1=$symbchck+$symbseed+$namechck; |
my $num2=$nameseed+$domainseed+$courseseed; |
my $num2=$nameseed+$domainseed+$courseseed; |
#&Apache::lonxml::debug("$symbseed:$nameseed;$domainseed|$courseseed;$namechck:$symbchck"); |
#&logthis("$symbseed:$nameseed;$domainseed|$courseseed;$namechck:$symbchck"); |
#&Apache::lonxml::debug("rndseed :$num:$symb"); |
#&logthis("rndseed :$num:$symb"); |
return "$num1,$num2"; |
return "$num1,$num2"; |
} |
} |
} |
} |
Line 6633 sub rndseed_64bit3 {
|
Line 6689 sub rndseed_64bit3 {
|
|
|
my $num1=$symbchck+$symbseed+$namechck; |
my $num1=$symbchck+$symbseed+$namechck; |
my $num2=$nameseed+$domainseed+$courseseed; |
my $num2=$nameseed+$domainseed+$courseseed; |
#&Apache::lonxml::debug("$symbseed:$nameseed;$domainseed|$courseseed;$namechck:$symbchck"); |
#&logthis("$symbseed:$nameseed;$domainseed|$courseseed;$namechck:$symbchck"); |
#&Apache::lonxml::debug("rndseed :$num1:$num2:$_64bit"); |
#&logthis("rndseed :$num1:$num2:$_64bit"); |
if ($_64bit) { $num1=(($num1<<32)>>32); $num2=(($num2<<32)>>32); } |
if ($_64bit) { $num1=(($num1<<32)>>32); $num2=(($num2<<32)>>32); } |
|
|
return "$num1:$num2"; |
return "$num1:$num2"; |
Line 6657 sub rndseed_64bit4 {
|
Line 6713 sub rndseed_64bit4 {
|
|
|
my $num1=$symbchck+$symbseed+$namechck; |
my $num1=$symbchck+$symbseed+$namechck; |
my $num2=$nameseed+$domainseed+$courseseed; |
my $num2=$nameseed+$domainseed+$courseseed; |
#&Apache::lonxml::debug("$symbseed:$nameseed;$domainseed|$courseseed;$namechck:$symbchck"); |
#&logthis("$symbseed:$nameseed;$domainseed|$courseseed;$namechck:$symbchck"); |
#&Apache::lonxml::debug("rndseed :$num1:$num2:$_64bit"); |
#&logthis("rndseed :$num1:$num2:$_64bit"); |
if ($_64bit) { $num1=(($num1<<32)>>32); $num2=(($num2<<32)>>32); } |
if ($_64bit) { $num1=(($num1<<32)>>32); $num2=(($num2<<32)>>32); } |
|
|
return "$num1:$num2"; |
return "$num1:$num2"; |
Line 6682 sub rndseed_CODE_64bit {
|
Line 6738 sub rndseed_CODE_64bit {
|
my $courseseed=unpack("%32S*",$courseid.' '); |
my $courseseed=unpack("%32S*",$courseid.' '); |
my $num1=$symbseed+$CODEchck; |
my $num1=$symbseed+$CODEchck; |
my $num2=$CODEseed+$courseseed+$symbchck; |
my $num2=$CODEseed+$courseseed+$symbchck; |
#&Apache::lonxml::debug("$symbseed:$CODEchck|$CODEseed:$courseseed:$symbchck"); |
#&logthis("$symbseed:$CODEchck|$CODEseed:$courseseed:$symbchck"); |
#&Apache::lonxml::debug("rndseed :$num1:$num2:$symb"); |
#&logthis("rndseed :$num1:$num2:$symb"); |
if ($_64bit) { $num1=(($num1<<32)>>32); } |
if ($_64bit) { $num1=(($num1<<32)>>32); } |
if ($_64bit) { $num2=(($num2<<32)>>32); } |
if ($_64bit) { $num2=(($num2<<32)>>32); } |
return "$num1:$num2"; |
return "$num1:$num2"; |
Line 6701 sub rndseed_CODE_64bit4 {
|
Line 6757 sub rndseed_CODE_64bit4 {
|
my $courseseed=unpack("%32S*",$courseid.' '); |
my $courseseed=unpack("%32S*",$courseid.' '); |
my $num1=$symbseed+$CODEchck; |
my $num1=$symbseed+$CODEchck; |
my $num2=$CODEseed+$courseseed+$symbchck; |
my $num2=$CODEseed+$courseseed+$symbchck; |
#&Apache::lonxml::debug("$symbseed:$CODEchck|$CODEseed:$courseseed:$symbchck"); |
#&logthis("$symbseed:$CODEchck|$CODEseed:$courseseed:$symbchck"); |
#&Apache::lonxml::debug("rndseed :$num1:$num2:$symb"); |
#&logthis("rndseed :$num1:$num2:$symb"); |
if ($_64bit) { $num1=(($num1<<32)>>32); } |
if ($_64bit) { $num1=(($num1<<32)>>32); } |
if ($_64bit) { $num2=(($num2<<32)>>32); } |
if ($_64bit) { $num2=(($num2<<32)>>32); } |
return "$num1:$num2"; |
return "$num1:$num2"; |
Line 6763 sub ireceipt {
|
Line 6819 sub ireceipt {
|
my $return =&recprefix($fucourseid).'-'; |
my $return =&recprefix($fucourseid).'-'; |
if ($env{"course.$fucourseid.receiptalg"} eq 'receipt2' || |
if ($env{"course.$fucourseid.receiptalg"} eq 'receipt2' || |
$env{'request.state'} eq 'construct') { |
$env{'request.state'} eq 'construct') { |
&Apache::lonxml::debug("doing receipt2 using parts $cpart, uname $cuname and udom $cudom gets ".($cpart%$cuname). |
#&logthis("doing receipt2 using parts $cpart, uname $cuname and udom $cudom gets ".($cpart%$cuname)." and ".($cpart%$cudom)); |
" and ".($cpart%$cudom)); |
|
|
|
$return.= ($cunique%$cuname+ |
$return.= ($cunique%$cuname+ |
$cunique%$cudom+ |
$cunique%$cudom+ |
Line 6787 sub ireceipt {
|
Line 6842 sub ireceipt {
|
|
|
sub receipt { |
sub receipt { |
my ($part)=@_; |
my ($part)=@_; |
my ($symb,$courseid,$domain,$name) = &Apache::lonxml::whichuser(); |
my ($symb,$courseid,$domain,$name) = &whichuser(); |
return &ireceipt($name,$domain,$courseid,$symb,$part); |
return &ireceipt($name,$domain,$courseid,$symb,$part); |
} |
} |
|
|
|
sub whichuser { |
|
my ($passedsymb)=@_; |
|
my ($symb,$courseid,$domain,$name,$publicuser); |
|
if (defined($env{'form.grade_symb'})) { |
|
my ($tmp_courseid)=&get_env_multiple('form.grade_courseid'); |
|
my $allowed=&allowed('vgr',$tmp_courseid); |
|
if (!$allowed && |
|
exists($env{'request.course.sec'}) && |
|
$env{'request.course.sec'} !~ /^\s*$/) { |
|
$allowed=&allowed('vgr',$tmp_courseid. |
|
'/'.$env{'request.course.sec'}); |
|
} |
|
if ($allowed) { |
|
($symb)=&get_env_multiple('form.grade_symb'); |
|
$courseid=$tmp_courseid; |
|
($domain)=&get_env_multiple('form.grade_domain'); |
|
($name)=&get_env_multiple('form.grade_username'); |
|
return ($symb,$courseid,$domain,$name,$publicuser); |
|
} |
|
} |
|
if (!$passedsymb) { |
|
$symb=&symbread(); |
|
} else { |
|
$symb=$passedsymb; |
|
} |
|
$courseid=$env{'request.course.id'}; |
|
$domain=$env{'user.domain'}; |
|
$name=$env{'user.name'}; |
|
if ($name eq 'public' && $domain eq 'public') { |
|
if (!defined($env{'form.username'})) { |
|
$env{'form.username'}.=time.rand(10000000); |
|
} |
|
$name.=$env{'form.username'}; |
|
} |
|
return ($symb,$courseid,$domain,$name,$publicuser); |
|
|
|
} |
|
|
# ------------------------------------------------------------ Serves up a file |
# ------------------------------------------------------------ Serves up a file |
# returns either the contents of the file or |
# returns either the contents of the file or |
# -1 if the file doesn't exist |
# -1 if the file doesn't exist |
Line 7053 sub clutter {
|
Line 7146 sub clutter {
|
return $thisfn; |
return $thisfn; |
} |
} |
|
|
|
sub clutter_with_no_wrapper { |
|
my $uri = &clutter(shift); |
|
if ($uri =~ m-^/adm/-) { |
|
$uri =~ s-^/adm/wrapper/-/-; |
|
$uri =~ s-^/adm/coursedocs/showdoc/-/-; |
|
} |
|
return $uri; |
|
} |
|
|
sub freeze_escape { |
sub freeze_escape { |
my ($value)=@_; |
my ($value)=@_; |
if (ref($value)) { |
if (ref($value)) { |
Line 7189 sub get_iphost {
|
Line 7291 sub get_iphost {
|
chomp($configline); |
chomp($configline); |
if ($configline) { |
if ($configline) { |
my ($host,$type) = split(':',$configline,2); |
my ($host,$type) = split(':',$configline,2); |
if ($type eq '') { $type = 'default' }; |
if (!defined($type) || $type eq '') { $type = 'default' }; |
push(@{ $spareid{$type} }, $host); |
push(@{ $spareid{$type} }, $host); |
} |
} |
} |
} |