version 1.197, 2002/01/04 16:31:41
|
version 1.201, 2002/02/14 20:44:26
|
Line 66
|
Line 66
|
# 12/18 Scott Harrison |
# 12/18 Scott Harrison |
# 12/21,12/22,12/27,12/28 Gerd Kortemeyer |
# 12/21,12/22,12/27,12/28 Gerd Kortemeyer |
# YEAR=2002 |
# YEAR=2002 |
# 1/4 Gerd Kortemeyer |
# 1/4,2/4,2/7 Gerd Kortemeyer |
# |
# |
### |
### |
|
|
Line 80 use vars
|
Line 80 use vars
|
qw(%perlvar %hostname %homecache %hostip %spareid %hostdom |
qw(%perlvar %hostname %homecache %hostip %spareid %hostdom |
%libserv %pr %prp %metacache %packagetab |
%libserv %pr %prp %metacache %packagetab |
%courselogs %accesshash $processmarker $dumpcount |
%courselogs %accesshash $processmarker $dumpcount |
%coursedombuf %coursehombuf); |
%coursedombuf %coursehombuf %courseresdatacache); |
use IO::Socket; |
use IO::Socket; |
use GDBM_File; |
use GDBM_File; |
use Apache::Constants qw(:common :http); |
use Apache::Constants qw(:common :http); |
Line 391 sub queryauthenticate {
|
Line 391 sub queryauthenticate {
|
sub authenticate { |
sub authenticate { |
my ($uname,$upass,$udom)=@_; |
my ($uname,$upass,$udom)=@_; |
$upass=escape($upass); |
$upass=escape($upass); |
|
$uname=~s/\W//g; |
if (($perlvar{'lonRole'} eq 'library') && |
if (($perlvar{'lonRole'} eq 'library') && |
($udom eq $perlvar{'lonDefDomain'})) { |
($udom eq $perlvar{'lonDefDomain'})) { |
my $answer=reply("encrypt:auth:$udom:$uname:$upass",$perlvar{'lonHostID'}); |
my $answer=reply("encrypt:auth:$udom:$uname:$upass",$perlvar{'lonHostID'}); |
Line 640 sub ssi {
|
Line 641 sub ssi {
|
|
|
if (%form) { |
if (%form) { |
$request=new HTTP::Request('POST',"http://".$ENV{'HTTP_HOST'}.$fn); |
$request=new HTTP::Request('POST',"http://".$ENV{'HTTP_HOST'}.$fn); |
$request->content(join '&', map { "$_=$form{$_}" } keys %form); |
$request->content(join('&',map { &escape($_).'='.&escape($form{$_}) } keys %form)); |
} else { |
} else { |
$request=new HTTP::Request('GET',"http://".$ENV{'HTTP_HOST'}.$fn); |
$request=new HTTP::Request('GET',"http://".$ENV{'HTTP_HOST'}.$fn); |
} |
} |
Line 1736 sub modifyuserauth {
|
Line 1737 sub modifyuserauth {
|
sub modifyuser { |
sub modifyuser { |
my ($udom,$uname,$uid,$umode,$upass,$first,$middle,$last,$gene, |
my ($udom,$uname,$uid,$umode,$upass,$first,$middle,$last,$gene, |
$forceid)=@_; |
$forceid)=@_; |
|
$udom=~s/\W//g; |
|
$uname=~s/\W//g; |
&logthis('Call to modify user '.$udom.', '.$uname.', '.$uid.', '. |
&logthis('Call to modify user '.$udom.', '.$uname.', '.$uid.', '. |
$umode.', '.$first.', '.$middle.', '. |
$umode.', '.$first.', '.$middle.', '. |
$last.', '.$gene.'(forceid: '.$forceid.') by '. |
$last.', '.$gene.'(forceid: '.$forceid.') by '. |
Line 2021 sub condval {
|
Line 2024 sub condval {
|
return $result; |
return $result; |
} |
} |
|
|
|
# --------------------------------------------------- Course Resourcedata Query |
|
|
|
sub courseresdata { |
|
my ($coursenum,$coursedomain,@which)=@_; |
|
my $coursehom=&homeserver($coursenum,$coursedomain); |
|
my $hashid=$coursenum.':'.$coursedomain; |
|
unless (defined($courseresdatacache{$hashid.'.time'})) { |
|
unless (time-$courseresdatacache{$hashid.'.time'}<300) { |
|
my $coursehom=&homeserver($coursenum,$coursedomain); |
|
if ($coursehom) { |
|
my $dumpreply=&reply('dump:'.$coursedomain.':'.$coursenum. |
|
':resourcedata:.',$coursehom); |
|
unless ($dumpreply=~/^error\:/) { |
|
$courseresdatacache{$hashid.'.time'}=time; |
|
$courseresdatacache{$hashid}=$dumpreply; |
|
} |
|
} |
|
} |
|
} |
|
my @pairs=split(/\&/,$courseresdatacache{$hashid}); |
|
my %returnhash=(); |
|
foreach (@pairs) { |
|
my ($key,$value)=split(/=/,$_); |
|
$returnhash{unescape($key)}=unescape($value); |
|
} |
|
my $item; |
|
foreach $item (@which) { |
|
if ($returnhash{$item}) { return $returnhash{$item}; } |
|
} |
|
return ''; |
|
} |
|
|
# --------------------------------------------------------- Value of a Variable |
# --------------------------------------------------------- Value of a Variable |
|
|
sub EXT { |
sub EXT { |
Line 2141 sub EXT {
|
Line 2176 sub EXT {
|
|
|
# -------------------------------------------------------- second, check course |
# -------------------------------------------------------- second, check course |
|
|
my $reply=&reply('get:'. |
my $coursereply=&courseresdata( |
$ENV{'course.'.$ENV{'request.course.id'}.'.domain'}.':'. |
$ENV{'course.'.$ENV{'request.course.id'}.'.num'}, |
$ENV{'course.'.$ENV{'request.course.id'}.'.num'}. |
$ENV{'course.'.$ENV{'request.course.id'}.'.domain'}, |
':resourcedata:'. |
($seclevelr,$seclevelm,$seclevel, |
&escape($seclevelr).'&'.&escape($seclevelm).'&'.&escape($seclevel).'&'. |
$courselevelr,$courselevelm,$courselevel)); |
&escape($courselevelr).'&'.&escape($courselevelm).'&'.&escape($courselevel), |
if ($coursereply) { return $coursereply; } |
$ENV{'course.'.$ENV{'request.course.id'}.'.home'}); |
|
if ($reply!~/^error\:/) { |
|
foreach (split(/\&/,$reply)) { |
|
if ($_) { return &unescape($_); } |
|
} |
|
} |
|
if (($reply=~/^con_lost/) || ($reply=~/^error\:/)) { |
|
&logthis("<font color=blue>WARNING:". |
|
" Getting ".$reply." asking for ".$varname." for ". |
|
$ENV{'course.'.$ENV{'request.course.id'}.'.num'}. |
|
' at '. |
|
$ENV{'course.'.$ENV{'request.course.id'}.'.domain'}. |
|
' from '. |
|
$ENV{'course.'.$ENV{'request.course.id'}.'.home'}. |
|
"</font>"); |
|
} |
|
# ------------------------------------------------------ third, check map parms |
# ------------------------------------------------------ third, check map parms |
my %parmhash=(); |
my %parmhash=(); |
my $thisparm=''; |
my $thisparm=''; |