version 1.1166, 2012/04/25 21:22:15
|
version 1.1172.2.2, 2012/05/28 15:02:06
|
Line 75 use LWP::UserAgent();
|
Line 75 use LWP::UserAgent();
|
use HTTP::Date; |
use HTTP::Date; |
use Image::Magick; |
use Image::Magick; |
|
|
|
use Encode; |
|
|
use vars qw(%perlvar %spareid %pr %prp $memcache %packagetab $tmpdir |
use vars qw(%perlvar %spareid %pr %prp $memcache %packagetab $tmpdir |
$_64bit %env %protocol %loncaparevs %serverhomeIDs %needsrelease |
$_64bit %env %protocol %loncaparevs %serverhomeIDs %needsrelease |
%managerstab); |
%managerstab); |
Line 2567 sub ssi {
|
Line 2569 sub ssi {
|
} |
} |
|
|
$request->header(Cookie => $ENV{'HTTP_COOKIE'}); |
$request->header(Cookie => $ENV{'HTTP_COOKIE'}); |
my $response=$ua->request($request); |
my $response= $ua->request($request); |
|
my $content = Encode::decode_utf8($response->content); |
if (wantarray) { |
if (wantarray) { |
return ($response->content, $response); |
return ($content, $response); |
} else { |
} else { |
return $response->content; |
return $content; |
} |
} |
} |
} |
|
|
Line 3489 sub statslog {
|
Line 3491 sub statslog {
|
|
|
sub userrolelog { |
sub userrolelog { |
my ($trole,$username,$domain,$area,$tstart,$tend)=@_; |
my ($trole,$username,$domain,$area,$tstart,$tend)=@_; |
if (($trole=~/^ca/) || ($trole=~/^aa/) || |
if ( $trole =~ /^(ca|aa|in|cc|ep|cr|ta|co)/ ) { |
($trole=~/^in/) || ($trole=~/^cc/) || |
|
($trole=~/^ep/) || ($trole=~/^cr/) || |
|
($trole=~/^ta/) || ($trole=~/^co/)) { |
|
my (undef,$rudom,$runame,$rsec)=split(/\//,$area); |
my (undef,$rudom,$runame,$rsec)=split(/\//,$area); |
$userrolehash |
$userrolehash |
{$trole.':'.$username.':'.$domain.':'.$runame.':'.$rudom.':'.$rsec} |
{$trole.':'.$username.':'.$domain.':'.$runame.':'.$rudom.':'.$rsec} |
=$tend.':'.$tstart; |
=$tend.':'.$tstart; |
} |
} |
if (($env{'request.role'} =~ /dc\./) && |
if ($env{'request.role'} =~ /dc\./ && $trole =~ /^(au|in|cc|ep|cr|ta|co)/) { |
(($trole=~/^au/) || ($trole=~/^in/) || |
|
($trole=~/^cc/) || ($trole=~/^ep/) || |
|
($trole=~/^cr/) || ($trole=~/^ta/) || |
|
($trole=~/^co/))) { |
|
$userrolehash |
$userrolehash |
{$trole.':'.$username.':'.$domain.':'.$env{'user.name'}.':'.$env{'user.domain'}.':'} |
{$trole.':'.$username.':'.$domain.':'.$env{'user.name'}.':'.$env{'user.domain'}.':'} |
=$tend.':'.$tstart; |
=$tend.':'.$tstart; |
} |
} |
if (($trole=~/^dc/) || ($trole=~/^ad/) || |
if ($trole =~ /^(dc|ad|li|au|dg|sc)/ ) { |
($trole=~/^li/) || ($trole=~/^li/) || |
|
($trole=~/^au/) || ($trole=~/^dg/) || |
|
($trole=~/^sc/)) { |
|
my (undef,$rudom,$runame,$rsec)=split(/\//,$area); |
my (undef,$rudom,$runame,$rsec)=split(/\//,$area); |
$domainrolehash |
$domainrolehash |
{$trole.':'.$username.':'.$domain.':'.$runame.':'.$rudom.':'.$rsec} |
{$trole.':'.$username.':'.$domain.':'.$runame.':'.$rudom.':'.$rsec} |
Line 3968 my $cachedtime=();
|
Line 3960 my $cachedtime=();
|
sub load_all_first_access { |
sub load_all_first_access { |
my ($uname,$udom)=@_; |
my ($uname,$udom)=@_; |
if (($cachedkey eq $uname.':'.$udom) && |
if (($cachedkey eq $uname.':'.$udom) && |
(abs($cachedtime-time)<5)) { |
(abs($cachedtime-time)<5) && (!$env{'form.markaccess'})) { |
return; |
return; |
} |
} |
$cachedtime=time; |
$cachedtime=time; |
Line 4612 sub update_released_required {
|
Line 4604 sub update_released_required {
|
|
|
sub privileged { |
sub privileged { |
my ($username,$domain)=@_; |
my ($username,$domain)=@_; |
my $rolesdump=&reply("dump:$domain:$username:roles", |
|
&homeserver($username,$domain)); |
my %rolesdump = &dump("roles", $domain, $username) or return 0; |
if (($rolesdump eq 'con_lost') || ($rolesdump eq '') || |
my $now = time; |
($rolesdump =~ /^error:/)) { |
|
return 0; |
for my $role (@rolesdump{grep { ! /^rolesdef_/ } keys %rolesdump}) { |
} |
my ($trole, $tend, $tstart) = split(/_/, $role); |
my $now=time; |
if (($trole eq 'dc') || ($trole eq 'su')) { |
if ($rolesdump ne '') { |
return 1 unless ($tend && $tend < $now) |
foreach my $entry (split(/&/,$rolesdump)) { |
or ($tstart && $tstart > $now); |
if ($entry!~/^rolesdef_/) { |
} |
my ($area,$role)=split(/=/,$entry); |
|
$area=~s/\_\w\w$//; |
|
my ($trole,$tend,$tstart)=split(/_/,$role); |
|
if (($trole eq 'dc') || ($trole eq 'su')) { |
|
my $active=1; |
|
if ($tend) { |
|
if ($tend<$now) { $active=0; } |
|
} |
|
if ($tstart) { |
|
if ($tstart>$now) { $active=0; } |
|
} |
|
if ($active) { return 1; } |
|
} |
|
} |
|
} |
} |
} |
|
return 0; |
return 0; |
} |
} |
|
|
# -------------------------------------------------------- Get user privileges |
# -------------------------------------------------------- Get user privileges |
|
|
sub rolesinit { |
sub rolesinit { |
my ($domain,$username,$authhost)=@_; |
my ($domain, $username) = @_; |
my $now=time; |
my %userroles = ('user.login.time' => time); |
my %userroles = ('user.login.time' => $now); |
my %rolesdump = &dump("roles", $domain, $username) or return \%userroles; |
my $rolesdump=reply("dump:$domain:$username:roles",$authhost); |
|
if (($rolesdump eq 'con_lost') || ($rolesdump eq '') || |
# firstaccess and timerinterval are related to timed maps/resources. |
($rolesdump =~ /^error:/)) { |
# also, blocking can be triggered by an activating timer |
return \%userroles; |
# it's saved in the user's %env. |
} |
my %firstaccess = &dump('firstaccesstimes', $domain, $username); |
my %firstaccess = &dump('firstaccesstimes',$domain,$username); |
my %timerinterval = &dump('timerinterval', $domain, $username); |
my %timerinterval = &dump('timerinterval',$domain,$username); |
my (%coursetimerstarts, %firstaccchk, %firstaccenv, %coursetimerintervals, |
my (%coursetimerstarts,%firstaccchk,%firstaccenv, |
%timerintchk, %timerintenv); |
%coursetimerintervals,%timerintchk,%timerintenv); |
|
foreach my $key (keys(%firstaccess)) { |
foreach my $key (keys(%firstaccess)) { |
my ($cid,$rest) = split(/\0/,$key); |
my ($cid, $rest) = split(/\0/, $key); |
$coursetimerstarts{$cid}{$rest} = $firstaccess{$key}; |
$coursetimerstarts{$cid}{$rest} = $firstaccess{$key}; |
} |
} |
|
|
foreach my $key (keys(%timerinterval)) { |
foreach my $key (keys(%timerinterval)) { |
my ($cid,$rest) = split(/\0/,$key); |
my ($cid,$rest) = split(/\0/,$key); |
$coursetimerintervals{$cid}{$rest} = $timerinterval{$key}; |
$coursetimerintervals{$cid}{$rest} = $timerinterval{$key}; |
} |
} |
|
|
my %allroles=(); |
my %allroles=(); |
my %allgroups=(); |
my %allgroups=(); |
|
|
if ($rolesdump ne '') { |
for my $area (grep { ! /^rolesdef_/ } keys %rolesdump) { |
foreach my $entry (split(/&/,$rolesdump)) { |
my $role = $rolesdump{$area}; |
if ($entry!~/^rolesdef_/) { |
$area =~ s/\_\w\w$//; |
my ($area,$role)=split(/=/,$entry); |
|
$area=~s/\_\w\w$//; |
my ($trole, $tend, $tstart, $group_privs); |
my ($trole,$tend,$tstart,$group_privs); |
|
if ($role=~/^cr/) { |
if ($role =~ /^cr/) { |
if ($role=~m|^(cr/$match_domain/$match_username/[a-zA-Z0-9]+)_(.*)$|) { |
# Custom role, defined by a user |
($trole,my $trest)=($role=~m|^(cr/$match_domain/$match_username/[a-zA-Z0-9]+)_(.*)$|); |
# e.g., user.role.cr/msu/smith/mynewrole |
($tend,$tstart)=split('_',$trest); |
if ($role =~ m|^(cr/$match_domain/$match_username/[a-zA-Z0-9]+)_(.*)$|) { |
} else { |
$trole = $1; |
$trole=$role; |
($tend, $tstart) = split('_', $2); |
} |
} else { |
} elsif ($role =~ m|^gr/|) { |
$trole = $role; |
($trole,$tend,$tstart) = split(/_/,$role); |
} |
next if ($tstart eq '-1'); |
} elsif ($role =~ m|^gr/|) { |
($trole,$group_privs) = split(/\//,$trole); |
# Role of member in a group, defined within a course/community |
$group_privs = &unescape($group_privs); |
# e.g., user.role.gr/msu/04935610a19ee4a5fmsul1/leopards |
} else { |
($trole, $tend, $tstart) = split(/_/, $role); |
($trole,$tend,$tstart)=split(/_/,$role); |
next if $tstart eq '-1'; |
} |
($trole, $group_privs) = split(/\//, $trole); |
my %new_role = &set_arearole($trole,$area,$tstart,$tend,$domain, |
$group_privs = &unescape($group_privs); |
$username); |
} else { |
@userroles{keys(%new_role)} = @new_role{keys(%new_role)}; |
# Just a normal role, defined in roles.tab |
if (($tend!=0) && ($tend<$now)) { $trole=''; } |
($trole, $tend, $tstart) = split(/_/,$role); |
if (($tstart!=0) && ($tstart>$now)) { $trole=''; } |
} |
if (($area ne '') && ($trole ne '')) { |
|
my $spec=$trole.'.'.$area; |
my %new_role = &set_arearole($trole,$area,$tstart,$tend,$domain, |
my ($tdummy,$tdomain,$trest)=split(/\//,$area); |
$username); |
if ($trole =~ /^cr\//) { |
@userroles{keys(%new_role)} = @new_role{keys(%new_role)}; |
&custom_roleprivs(\%allroles,$trole,$tdomain,$trest,$spec,$area); |
|
} elsif ($trole eq 'gr') { |
# role expired or not available yet? |
&group_roleprivs(\%allgroups,$area,$group_privs,$tend,$tstart); |
$trole = '' if ($tend != 0 && $tend < $userroles{'user.login.time'}) or |
} else { |
($tstart != 0 && $tstart > $userroles{'user.login.time'}); |
&standard_roleprivs(\%allroles,$trole,$tdomain,$spec,$trest,$area); |
|
} |
next if $area eq '' or $trole eq ''; |
if ($trole ne 'gr') { |
|
my $cid = $tdomain.'_'.$trest; |
my $spec = "$trole.$area"; |
unless ($firstaccchk{$cid}) { |
my ($tdummy, $tdomain, $trest) = split(/\//, $area); |
if (ref($coursetimerstarts{$cid}) eq 'HASH') { |
|
foreach my $item (keys(%{$coursetimerstarts{$cid}})) { |
if ($trole =~ /^cr\//) { |
$firstaccenv{'course.'.$cid.'.firstaccess.'.$item} = |
# Custom role, defined by a user |
$coursetimerstarts{$cid}{$item}; |
&custom_roleprivs(\%allroles,$trole,$tdomain,$trest,$spec,$area); |
} |
} elsif ($trole eq 'gr') { |
} |
# Role of a member in a group, defined within a course/community |
$firstaccchk{$cid} = 1; |
&group_roleprivs(\%allgroups,$area,$group_privs,$tend,$tstart); |
} |
next; |
unless ($timerintchk{$cid}) { |
} else { |
if (ref($coursetimerintervals{$cid}) eq 'HASH') { |
# Normal role, defined in roles.tab |
foreach my $item (keys(%{$coursetimerintervals{$cid}})) { |
&standard_roleprivs(\%allroles,$trole,$tdomain,$spec,$trest,$area); |
$timerintenv{'course.'.$cid.'.timerinterval.'.$item} = |
} |
$coursetimerintervals{$cid}{$item}; |
|
} |
my $cid = $tdomain.'_'.$trest; |
} |
unless ($firstaccchk{$cid}) { |
$timerintchk{$cid} = 1; |
if (ref($coursetimerstarts{$cid}) eq 'HASH') { |
} |
foreach my $item (keys(%{$coursetimerstarts{$cid}})) { |
|
$firstaccenv{'course.'.$cid.'.firstaccess.'.$item} = |
|
$coursetimerstarts{$cid}{$item}; |
} |
} |
} |
} |
} |
$firstaccchk{$cid} = 1; |
|
} |
|
unless ($timerintchk{$cid}) { |
|
if (ref($coursetimerintervals{$cid}) eq 'HASH') { |
|
foreach my $item (keys(%{$coursetimerintervals{$cid}})) { |
|
$timerintenv{'course.'.$cid.'.timerinterval.'.$item} = |
|
$coursetimerintervals{$cid}{$item}; |
|
} |
|
} |
|
$timerintchk{$cid} = 1; |
} |
} |
my ($author,$adv) = &set_userprivs(\%userroles,\%allroles,\%allgroups); |
|
$userroles{'user.adv'} = $adv; |
|
$userroles{'user.author'} = $author; |
|
$env{'user.adv'}=$adv; |
|
} |
} |
|
|
|
@userroles{'user.author', 'user.adv'} = &set_userprivs(\%userroles, |
|
\%allroles, \%allgroups); |
|
$env{'user.adv'} = $userroles{'user.adv'}; |
|
|
return (\%userroles,\%firstaccenv,\%timerintenv); |
return (\%userroles,\%firstaccenv,\%timerintenv); |
} |
} |
|
|
Line 5071 sub dump {
|
Line 5063 sub dump {
|
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); |
|
|
if ($regexp) { |
if ($regexp) { |
$regexp=&escape($regexp); |
$regexp=&escape($regexp); |
} else { |
} else { |
Line 8099 sub generate_coursenum {
|
Line 8092 sub generate_coursenum {
|
} |
} |
|
|
sub is_course { |
sub is_course { |
my ($cdom,$cnum) = @_; |
my ($cdom, $cnum) = scalar(@_) == 1 ? |
my %courses = &courseiddump($cdom,'.',1,'.','.',$cnum,undef, |
($_[0] =~ /^($match_domain)_($match_courseid)$/) : @_; |
undef,'.'); |
|
if (exists($courses{$cdom.'_'.$cnum})) { |
return unless $cdom and $cnum; |
return 1; |
|
} |
my %courses = &courseiddump($cdom, '.', 1, '.', '.', $cnum, undef, undef, |
return 0; |
'.'); |
|
|
|
return unless exists($courses{$cdom.'_'.$cnum}); |
|
return wantarray ? ($cdom, $cnum) : $cdom.'_'.$cnum; |
} |
} |
|
|
sub store_userdata { |
sub store_userdata { |
Line 10765 sub declutter {
|
Line 10761 sub declutter {
|
$thisfn=~s|^adm/wrapper/||; |
$thisfn=~s|^adm/wrapper/||; |
$thisfn=~s|^adm/coursedocs/showdoc/||; |
$thisfn=~s|^adm/coursedocs/showdoc/||; |
$thisfn=~s/^res\///; |
$thisfn=~s/^res\///; |
|
$thisfn=~s/^priv\///; |
unless (($thisfn =~ /^ext/) || ($thisfn =~ /\.(page|sequence)___\d+___ext/)) { |
unless (($thisfn =~ /^ext/) || ($thisfn =~ /\.(page|sequence)___\d+___ext/)) { |
$thisfn=~s/\?.+$//; |
$thisfn=~s/\?.+$//; |
} |
} |
Line 11683 B<idput($udom,%ids)>: store away a list
|
Line 11680 B<idput($udom,%ids)>: store away a list
|
|
|
=item * |
=item * |
X<rolesinit()> |
X<rolesinit()> |
B<rolesinit($udom,$username,$authhost)>: get user privileges |
B<rolesinit($udom,$username)>: get user privileges. |
|
returns user role, first access and timer interval hashes |
|
|
|
=item * |
|
X<privileged()> |
|
B<privileged($username,$domain)>: returns a true if user has a |
|
privileged and active role (i.e. su or dc), false otherwise. |
|
|
=item * |
=item * |
X<getsection()> |
X<getsection()> |
Line 11976 createcourse($udom,$description,$url,$co
|
Line 11979 createcourse($udom,$description,$url,$co
|
|
|
generate_coursenum($udom,$crstype) : get a unique (unused) course number in domain $udom for course type $crstype (Course or Community). |
generate_coursenum($udom,$crstype) : get a unique (unused) course number in domain $udom for course type $crstype (Course or Community). |
|
|
|
=item * |
|
|
|
is_course($courseid), is_course($cdom, $cnum) |
|
|
|
Accepts either a combined $courseid (in the form of domain_courseid) or the |
|
two component version $cdom, $cnum. It checks if the specified course exists. |
|
|
|
Returns: |
|
undef if the course doesn't exist, otherwise |
|
in scalar context the combined courseid. |
|
in list context the two components of the course identifier, domain and |
|
courseid. |
|
|
=back |
=back |
|
|
=head2 Resource Subroutines |
=head2 Resource Subroutines |