version 1.191, 2001/12/18 20:59:38
|
version 1.197, 2002/01/04 16:31:41
|
Line 64
|
Line 64
|
# 12/5 Guy Albertelli |
# 12/5 Guy Albertelli |
# 12/6,12/7,12/12 Gerd Kortemeyer |
# 12/6,12/7,12/12 Gerd Kortemeyer |
# 12/18 Scott Harrison |
# 12/18 Scott Harrison |
|
# 12/21,12/22,12/27,12/28 Gerd Kortemeyer |
|
# YEAR=2002 |
|
# 1/4 Gerd Kortemeyer |
# |
# |
### |
### |
|
|
Line 75 use LWP::UserAgent();
|
Line 78 use LWP::UserAgent();
|
use HTTP::Headers; |
use HTTP::Headers; |
use vars |
use vars |
qw(%perlvar %hostname %homecache %hostip %spareid %hostdom |
qw(%perlvar %hostname %homecache %hostip %spareid %hostdom |
%libserv %pr %prp %fe %fd %metacache %packagetab |
%libserv %pr %prp %metacache %packagetab |
%courselogs %accesshash $processmarker $dumpcount |
%courselogs %accesshash $processmarker $dumpcount |
%coursedombuf %coursehombuf); |
%coursedombuf %coursehombuf); |
use IO::Socket; |
use IO::Socket; |
Line 83 use GDBM_File;
|
Line 86 use GDBM_File;
|
use Apache::Constants qw(:common :http); |
use Apache::Constants qw(:common :http); |
use HTML::TokeParser; |
use HTML::TokeParser; |
use Fcntl qw(:flock); |
use Fcntl qw(:flock); |
|
my $readit; |
|
|
# --------------------------------------------------------------------- Logging |
# --------------------------------------------------------------------- Logging |
|
|
Line 708 sub courseacclog {
|
Line 712 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 ($what=~/(problem|exam|quiz|assess|survey|form)$/) { |
if ($fnsymb=~/(problem|exam|quiz|assess|survey|form)$/) { |
$what.=':POST'; |
$what.=':POST'; |
foreach (keys %ENV) { |
foreach (keys %ENV) { |
if ($_=~/^form\.(.*)/) { |
if ($_=~/^form\.(.*)/) { |
Line 1273 sub del {
|
Line 1277 sub del {
|
# -------------------------------------------------------------- dump interface |
# -------------------------------------------------------------- dump interface |
|
|
sub dump { |
sub dump { |
my ($namespace,$udomain,$uname)=@_; |
my ($namespace,$udomain,$uname,$regexp)=@_; |
if (!$udomain) { $udomain=$ENV{'user.domain'}; } |
if (!$udomain) { $udomain=$ENV{'user.domain'}; } |
if (!$uname) { $uname=$ENV{'user.name'}; } |
if (!$uname) { $uname=$ENV{'user.name'}; } |
my $uhome=&homeserver($uname,$udomain); |
my $uhome=&homeserver($uname,$udomain); |
my $rep=reply("dump:$udomain:$uname:$namespace",$uhome); |
if ($regexp) { |
|
$regexp=&escape($regexp); |
|
} else { |
|
$regexp='.'; |
|
} |
|
my $rep=reply("dump:$udomain:$uname:$namespace:$regexp",$uhome); |
my @pairs=split(/\&/,$rep); |
my @pairs=split(/\&/,$rep); |
my %returnhash=(); |
my %returnhash=(); |
foreach (@pairs) { |
foreach (@pairs) { |
Line 1548 sub allowed {
|
Line 1557 sub allowed {
|
if ($thisallowed=~/C/) { |
if ($thisallowed=~/C/) { |
my $rolecode=(split(/\./,$ENV{'request.role'}))[0]; |
my $rolecode=(split(/\./,$ENV{'request.role'}))[0]; |
if ($ENV{'course.'.$ENV{'request.course.id'}.'.'.$priv.'.roles.denied'} |
if ($ENV{'course.'.$ENV{'request.course.id'}.'.'.$priv.'.roles.denied'} |
=~/\,$rolecode\,/) { |
=~/$rolecode/) { |
&log($ENV{'user.domain'},$ENV{'user.name'},$ENV{'user.host'}, |
&log($ENV{'user.domain'},$ENV{'user.name'},$ENV{'user.host'}, |
'Denied by role: '.$priv.' for '.$uri.' as '.$rolecode.' in '. |
'Denied by role: '.$priv.' for '.$uri.' as '.$rolecode.' in '. |
$ENV{'request.course.id'}); |
$ENV{'request.course.id'}); |
Line 1697 sub assignrole {
|
Line 1706 sub assignrole {
|
} |
} |
|
|
# -------------------------------------------------- Modify user authentication |
# -------------------------------------------------- Modify user authentication |
|
# Overrides without validation |
|
|
sub modifyuserauth { |
sub modifyuserauth { |
my ($udom,$uname,$umode,$upass)=@_; |
my ($udom,$uname,$umode,$upass)=@_; |
my $uhome=&homeserver($uname,$udom); |
my $uhome=&homeserver($uname,$udom); |
&logthis('Call to modify user authentication'.$udom.', '.$uname.', '. |
unless (&allowed('mau',$udom)) { return 'refused'; } |
|
&logthis('Call to modify user authentication '.$udom.', '.$uname.', '. |
$umode.' by '.$ENV{'user.name'}.' at '.$ENV{'user.domain'}); |
$umode.' by '.$ENV{'user.name'}.' at '.$ENV{'user.domain'}); |
my $reply=&reply('encrypt:changeuserauth:'.$udom.':'.$uname.':'.$umode.':'. |
my $reply=&reply('encrypt:changeuserauth:'.$udom.':'.$uname.':'.$umode.':'. |
&escape($upass),$uhome); |
&escape($upass),$uhome); |
|
&log($ENV{'user.domain'},$ENV{'user.name'},$ENV{'user.home'}, |
|
'Authentication changed for '.$udom.', '.$uname.', '.$umode. |
|
'(Remote '.$ENV{'REMOTE_ADDR'}.'): '.$reply); |
|
&log($udom,,$uname,$uhome, |
|
'Authentication changed by '.$ENV{'user.domain'}.', '. |
|
$ENV{'user.name'}.', '.$umode. |
|
'(Remote '.$ENV{'REMOTE_ADDR'}.'): '.$reply); |
unless ($reply eq 'ok') { |
unless ($reply eq 'ok') { |
|
&logthis('Authentication mode error: '.$reply); |
return 'error: '.$reply; |
return 'error: '.$reply; |
} |
} |
return 'ok'; |
return 'ok'; |
Line 1714 sub modifyuserauth {
|
Line 1734 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)=@_; |
&logthis('Call to modify user '.$udom.', '.$uname.', '.$uid.', '. |
&logthis('Call to modify user '.$udom.', '.$uname.', '.$uid.', '. |
$umode.', '.$first.', '.$middle.', '. |
$umode.', '.$first.', '.$middle.', '. |
$last.', '.$gene.' by '. |
$last.', '.$gene.'(forceid: '.$forceid.') by '. |
$ENV{'user.name'}.' at '.$ENV{'user.domain'}); |
$ENV{'user.name'}.' at '.$ENV{'user.domain'}); |
my $uhome=&homeserver($uname,$udom); |
my $uhome=&homeserver($uname,$udom); |
# ----------------------------------------------------------------- Create User |
# ----------------------------------------------------------------- Create User |
Line 1755 sub modifyuser {
|
Line 1776 sub modifyuser {
|
if ($uid) { |
if ($uid) { |
$uid=~tr/A-Z/a-z/; |
$uid=~tr/A-Z/a-z/; |
my %uidhash=&idrget($udom,$uname); |
my %uidhash=&idrget($udom,$uname); |
if (($uidhash{$uname}) && ($uidhash{$uname}!~/error\:/)) { |
if (($uidhash{$uname}) && ($uidhash{$uname}!~/error\:/) |
|
&& (!$forceid)) { |
unless ($uid eq $uidhash{$uname}) { |
unless ($uid eq $uidhash{$uname}) { |
return 'error: mismatch '.$uidhash{$uname}.' versus '.$uid; |
return 'error: mismatch '.$uidhash{$uname}.' versus '.$uid; |
} |
} |
Line 1784 sub modifyuser {
|
Line 1806 sub modifyuser {
|
|
|
sub modifystudent { |
sub modifystudent { |
my ($udom,$uname,$uid,$umode,$upass,$first,$middle,$last,$gene,$usec, |
my ($udom,$uname,$uid,$umode,$upass,$first,$middle,$last,$gene,$usec, |
$end,$start)=@_; |
$end,$start,$forceid)=@_; |
my $cid=''; |
my $cid=''; |
unless ($cid=$ENV{'request.course.id'}) { |
unless ($cid=$ENV{'request.course.id'}) { |
return 'not_in_class'; |
return 'not_in_class'; |
} |
} |
# --------------------------------------------------------------- Make the user |
# --------------------------------------------------------------- Make the user |
my $reply=&modifyuser |
my $reply=&modifyuser |
($udom,$uname,$uid,$umode,$upass,$first,$middle,$last,$gene); |
($udom,$uname,$uid,$umode,$upass,$first,$middle,$last,$gene,$forceid); |
unless ($reply eq 'ok') { return $reply; } |
unless ($reply eq 'ok') { return $reply; } |
my $uhome=&homeserver($uname,$udom); |
my $uhome=&homeserver($uname,$udom); |
if (($uhome eq '') || ($uhome eq 'no_host')) { |
if (($uhome eq '') || ($uhome eq 'no_host')) { |
Line 2549 sub goodbye {
|
Line 2571 sub goodbye {
|
|
|
BEGIN { |
BEGIN { |
# ------------------------------------------------------------ Read access.conf |
# ------------------------------------------------------------ Read access.conf |
|
unless ($readit) { |
{ |
{ |
my $config=Apache::File->new("/etc/httpd/conf/access.conf"); |
my $config=Apache::File->new("/etc/httpd/conf/access.conf"); |
|
|
Line 2627 BEGIN {
|
Line 2650 BEGIN {
|
} |
} |
} |
} |
|
|
# ------------------------------------------------------------- Read file types |
|
{ |
|
my $config=Apache::File->new("$perlvar{'lonTabDir'}/filetypes.tab"); |
|
|
|
while (my $configline=<$config>) { |
|
next if ($configline =~ /^\#/); |
|
chomp($configline); |
|
my ($ending,$emb,@descr)=split(/\s+/,$configline); |
|
if ($descr[0] ne '') { |
|
$fe{$ending}=lc($emb); |
|
$fd{$ending}=join(' ',@descr); |
|
} |
|
} |
|
} |
|
|
|
%metacache=(); |
%metacache=(); |
|
|
$processmarker=$$.'_'.time.'_'.$perlvar{'lonHostID'}; |
$processmarker=$$.'_'.time.'_'.$perlvar{'lonHostID'}; |
Line 2649 $dumpcount=0;
|
Line 2657 $dumpcount=0;
|
|
|
&logtouch(); |
&logtouch(); |
&logthis('<font color=yellow>INFO: Read configuration</font>'); |
&logthis('<font color=yellow>INFO: Read configuration</font>'); |
|
$readit=1; |
|
} |
} |
} |
|
|
1; |
1; |
Line 2869 namesp ($udomain and $uname are optional
|
Line 2879 namesp ($udomain and $uname are optional
|
|
|
=item * |
=item * |
|
|
dump($namespace,$udomain,$uname) : dumps the complete namespace into a hash |
dump($namespace,$udomain,$uname,$regexp) : |
($udomain and $uname are optional) |
dumps the complete (or key matching regexp) namespace into a hash |
|
($udomain, $uname and $regexp are optional) |
|
|
=item * |
=item * |
|
|