version 1.683.2.1, 2005/12/06 04:00:56
|
version 1.683.2.5, 2006/01/05 19:39:52
|
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 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 3013 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 3023 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 3341 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 3361 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 5412 sub symbread {
|
Line 5423 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 6185 BEGIN {
|
Line 6199 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 6193 BEGIN {
|
Line 6207 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} ); |