--- loncom/lonnet/perl/lonnet.pm	2012/04/24 20:31:59	1.1165
+++ loncom/lonnet/perl/lonnet.pm	2012/05/28 15:02:06	1.1172.2.2
@@ -1,7 +1,7 @@
 # The LearningOnline Network
 # TCP networking package
 #
-# $Id: lonnet.pm,v 1.1165 2012/04/24 20:31:59 droeschl Exp $
+# $Id: lonnet.pm,v 1.1172.2.2 2012/05/28 15:02:06 raeburn Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -75,6 +75,8 @@ use LWP::UserAgent();
 use HTTP::Date;
 use Image::Magick;
 
+use Encode;
+
 use vars qw(%perlvar %spareid %pr %prp $memcache %packagetab $tmpdir
             $_64bit %env %protocol %loncaparevs %serverhomeIDs %needsrelease
             %managerstab);
@@ -2155,8 +2157,7 @@ sub getsection {
     # If there is a role which has expired, return it.
     #
     $courseid = &courseid_to_courseurl($courseid);
-    my $extra = &freeze_escape({'skipcheck' => 1});
-    my %roleshash = &dump('roles',$udom,$unam,$courseid,undef,$extra);
+    my %roleshash = &dump('roles',$udom,$unam,$courseid);
     foreach my $key (keys(%roleshash)) {
         next if ($key !~/^\Q$courseid\E(?:\/)*(\w+)*\_st$/);
         my $section=$1;
@@ -2568,12 +2569,12 @@ sub ssi {
     }
 
     $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) {
-	return ($response->content, $response);
+	return ($content, $response);
     } else {
-	return $response->content;
+	return $content;
     }
 }
 
@@ -3490,28 +3491,18 @@ sub statslog {
   
 sub userrolelog {
     my ($trole,$username,$domain,$area,$tstart,$tend)=@_;
-    if (($trole=~/^ca/) || ($trole=~/^aa/) ||
-        ($trole=~/^in/) || ($trole=~/^cc/) ||
-        ($trole=~/^ep/) || ($trole=~/^cr/) ||
-        ($trole=~/^ta/) || ($trole=~/^co/)) {
+    if ( $trole =~ /^(ca|aa|in|cc|ep|cr|ta|co)/ ) {
        my (undef,$rudom,$runame,$rsec)=split(/\//,$area);
        $userrolehash
          {$trole.':'.$username.':'.$domain.':'.$runame.':'.$rudom.':'.$rsec}
                     =$tend.':'.$tstart;
     }
-    if (($env{'request.role'} =~ /dc\./) &&
-	(($trole=~/^au/) || ($trole=~/^in/) ||
-	 ($trole=~/^cc/) || ($trole=~/^ep/) ||
-	 ($trole=~/^cr/) || ($trole=~/^ta/) ||
-         ($trole=~/^co/))) {
+    if ($env{'request.role'} =~ /dc\./ && $trole =~ /^(au|in|cc|ep|cr|ta|co)/) {
        $userrolehash
          {$trole.':'.$username.':'.$domain.':'.$env{'user.name'}.':'.$env{'user.domain'}.':'}
                     =$tend.':'.$tstart;
     }
-    if (($trole=~/^dc/) || ($trole=~/^ad/) ||
-        ($trole=~/^li/) || ($trole=~/^li/) ||
-        ($trole=~/^au/) || ($trole=~/^dg/) ||
-        ($trole=~/^sc/)) {
+    if ($trole =~ /^(dc|ad|li|au|dg|sc)/ ) {
        my (undef,$rudom,$runame,$rsec)=split(/\//,$area);
        $domainrolehash
          {$trole.':'.$username.':'.$domain.':'.$runame.':'.$rudom.':'.$rsec}
@@ -3620,8 +3611,7 @@ sub get_my_roles {
     unless (defined($udom)) { $udom=$env{'user.domain'}; }
     my (%dumphash,%nothide);
     if ($context eq 'userroles') {
-        my $extra = &freeze_escape({'skipcheck' => 1});
-        %dumphash = &dump('roles',$udom,$uname,'.',undef,$extra);
+        %dumphash = &dump('roles',$udom,$uname);
     } else {
         %dumphash=
             &dump('nohist_userroles',$udom,$uname);
@@ -3970,7 +3960,7 @@ my $cachedtime=();
 sub load_all_first_access {
     my ($uname,$udom)=@_;
     if (($cachedkey eq $uname.':'.$udom) &&
-        (abs($cachedtime-time)<5)) {
+        (abs($cachedtime-time)<5) && (!$env{'form.markaccess'})) {
         return;
     }
     $cachedtime=time;
@@ -4614,127 +4604,126 @@ sub update_released_required {
 
 sub privileged {
     my ($username,$domain)=@_;
-    my $rolesdump=&reply("dump:$domain:$username:roles",
-			&homeserver($username,$domain));
-    if (($rolesdump eq 'con_lost') || ($rolesdump eq '') || 
-        ($rolesdump =~ /^error:/)) {
-        return 0;
-    }
-    my $now=time;
-    if ($rolesdump ne '') {
-        foreach my $entry (split(/&/,$rolesdump)) {
-	    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; }
-		}
-	    }
+
+    my %rolesdump = &dump("roles", $domain, $username) or return 0;
+    my $now = time;
+
+    for my $role (@rolesdump{grep { ! /^rolesdef_/ } keys %rolesdump}) {
+            my ($trole, $tend, $tstart) = split(/_/, $role);
+            if (($trole eq 'dc') || ($trole eq 'su')) {
+                return 1 unless ($tend && $tend < $now) 
+                    or ($tstart && $tstart > $now);
+            }
 	}
-    }
+
     return 0;
 }
 
 # -------------------------------------------------------- Get user privileges
 
 sub rolesinit {
-    my ($domain,$username,$authhost)=@_;
-    my $now=time;
-    my %userroles = ('user.login.time' => $now);
-    my $extra = &freeze_escape({'skipcheck' => 1});
-    my $rolesdump=reply("dump:$domain:$username:roles:.::$extra",$authhost);
-    if (($rolesdump eq 'con_lost') || ($rolesdump eq '') || 
-        ($rolesdump =~ /^error:/)) {
-        return \%userroles;
-    }
-    my %firstaccess = &dump('firstaccesstimes',$domain,$username);
-    my %timerinterval = &dump('timerinterval',$domain,$username);
-    my (%coursetimerstarts,%firstaccchk,%firstaccenv,
-        %coursetimerintervals,%timerintchk,%timerintenv);
+    my ($domain, $username) = @_;
+    my %userroles = ('user.login.time' => time);
+    my %rolesdump = &dump("roles", $domain, $username) or return \%userroles;
+
+    # firstaccess and timerinterval are related to timed maps/resources. 
+    # also, blocking can be triggered by an activating timer
+    # it's saved in the user's %env.
+    my %firstaccess = &dump('firstaccesstimes', $domain, $username);
+    my %timerinterval = &dump('timerinterval', $domain, $username);
+    my (%coursetimerstarts, %firstaccchk, %firstaccenv, %coursetimerintervals,
+        %timerintchk, %timerintenv);
+
     foreach my $key (keys(%firstaccess)) {
-        my ($cid,$rest) = split(/\0/,$key);
+        my ($cid, $rest) = split(/\0/, $key);
         $coursetimerstarts{$cid}{$rest} = $firstaccess{$key};
     }
+
     foreach my $key (keys(%timerinterval)) {
         my ($cid,$rest) = split(/\0/,$key);
         $coursetimerintervals{$cid}{$rest} = $timerinterval{$key};
     }
+
     my %allroles=();
     my %allgroups=();
 
-    if ($rolesdump ne '') {
-        foreach my $entry (split(/&/,$rolesdump)) {
-	  if ($entry!~/^rolesdef_/) {
-            my ($area,$role)=split(/=/,$entry);
-	    $area=~s/\_\w\w$//;
-            my ($trole,$tend,$tstart,$group_privs);
-	    if ($role=~/^cr/) { 
-		if ($role=~m|^(cr/$match_domain/$match_username/[a-zA-Z0-9]+)_(.*)$|) {
-		    ($trole,my $trest)=($role=~m|^(cr/$match_domain/$match_username/[a-zA-Z0-9]+)_(.*)$|);
-		    ($tend,$tstart)=split('_',$trest);
-		} else {
-		    $trole=$role;
-		}
-            } elsif ($role =~ m|^gr/|) {
-                ($trole,$tend,$tstart) = split(/_/,$role);
-                next if ($tstart eq '-1');
-                ($trole,$group_privs) = split(/\//,$trole);
-                $group_privs = &unescape($group_privs);
-	    } else {
-		($trole,$tend,$tstart)=split(/_/,$role);
-	    }
-	    my %new_role = &set_arearole($trole,$area,$tstart,$tend,$domain,
-					 $username);
-	    @userroles{keys(%new_role)} = @new_role{keys(%new_role)};
-            if (($tend!=0) && ($tend<$now)) { $trole=''; }
-            if (($tstart!=0) && ($tstart>$now)) { $trole=''; }
-            if (($area ne '') && ($trole ne '')) {
-		my $spec=$trole.'.'.$area;
-		my ($tdummy,$tdomain,$trest)=split(/\//,$area);
-		if ($trole =~ /^cr\//) {
-                    &custom_roleprivs(\%allroles,$trole,$tdomain,$trest,$spec,$area);
-                } elsif ($trole eq 'gr') {
-                    &group_roleprivs(\%allgroups,$area,$group_privs,$tend,$tstart);
-		} else {
-                    &standard_roleprivs(\%allroles,$trole,$tdomain,$spec,$trest,$area);
-		}
-                if ($trole ne 'gr') {
-                    my $cid = $tdomain.'_'.$trest;
-                    unless ($firstaccchk{$cid}) {
-                        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;
-                    }
+    for my $area (grep { ! /^rolesdef_/ } keys %rolesdump) {
+        my $role = $rolesdump{$area};
+        $area =~ s/\_\w\w$//;
+
+        my ($trole, $tend, $tstart, $group_privs);
+
+        if ($role =~ /^cr/) {
+        # Custom role, defined by a user 
+        # e.g., user.role.cr/msu/smith/mynewrole
+            if ($role =~ m|^(cr/$match_domain/$match_username/[a-zA-Z0-9]+)_(.*)$|) {
+                $trole = $1;
+                ($tend, $tstart) = split('_', $2);
+            } else {
+                $trole = $role;
+            }
+        } elsif ($role =~ m|^gr/|) {
+        # Role of member in a group, defined within a course/community
+        # e.g., user.role.gr/msu/04935610a19ee4a5fmsul1/leopards
+            ($trole, $tend, $tstart) = split(/_/, $role);
+            next if $tstart eq '-1';
+            ($trole, $group_privs) = split(/\//, $trole);
+            $group_privs = &unescape($group_privs);
+        } else {
+        # Just a normal role, defined in roles.tab
+            ($trole, $tend, $tstart) = split(/_/,$role);
+        }
+
+        my %new_role = &set_arearole($trole,$area,$tstart,$tend,$domain,
+                 $username);
+        @userroles{keys(%new_role)} = @new_role{keys(%new_role)};
+
+        # role expired or not available yet?
+        $trole = '' if ($tend != 0 && $tend < $userroles{'user.login.time'}) or 
+            ($tstart != 0 && $tstart > $userroles{'user.login.time'});
+
+        next if $area eq '' or $trole eq '';
+
+        my $spec = "$trole.$area";
+        my ($tdummy, $tdomain, $trest) = split(/\//, $area);
+
+        if ($trole =~ /^cr\//) {
+        # Custom role, defined by a user
+            &custom_roleprivs(\%allroles,$trole,$tdomain,$trest,$spec,$area);
+        } elsif ($trole eq 'gr') {
+        # Role of a member in a group, defined within a course/community
+            &group_roleprivs(\%allgroups,$area,$group_privs,$tend,$tstart);
+            next;
+        } else {
+        # Normal role, defined in roles.tab
+            &standard_roleprivs(\%allroles,$trole,$tdomain,$spec,$trest,$area);
+        }
+
+        my $cid = $tdomain.'_'.$trest;
+        unless ($firstaccchk{$cid}) {
+            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);
 }
 
@@ -5070,16 +5059,17 @@ sub del {
 # -------------------------------------------------------------- dump interface
 
 sub dump {
-    my ($namespace,$udomain,$uname,$regexp,$range,$extra)=@_;
+    my ($namespace,$udomain,$uname,$regexp,$range)=@_;
     if (!$udomain) { $udomain=$env{'user.domain'}; }
     if (!$uname) { $uname=$env{'user.name'}; }
     my $uhome=&homeserver($uname,$udomain);
+
     if ($regexp) {
 	$regexp=&escape($regexp);
     } else {
 	$regexp='.';
     }
-    my $rep=&reply("dump:$udomain:$uname:$namespace:$regexp:$range:$extra",$uhome);
+    my $rep=&reply("dump:$udomain:$uname:$namespace:$regexp:$range",$uhome);
     my @pairs=split(/\&/,$rep);
     my %returnhash=();
     if (!($rep =~ /^error/ )) {
@@ -7289,8 +7279,7 @@ sub get_users_groups {
     } else {  
         $grouplist = '';
         my $courseurl = &courseid_to_courseurl($courseid);
-        my $extra = &freeze_escape({'skipcheck' => 1});
-        my %roleshash = &dump('roles',$udom,$uname,$courseurl,undef,$extra);
+        my %roleshash = &dump('roles',$udom,$uname,$courseurl);
         my $access_end = $env{'course.'.$courseid.
                               '.default_enrollment_end_date'};
         my $now = time;
@@ -8103,13 +8092,16 @@ sub generate_coursenum {
 }
 
 sub is_course {
-    my ($cdom,$cnum) = @_;
-    my %courses = &courseiddump($cdom,'.',1,'.','.',$cnum,undef,
-				undef,'.');
-    if (exists($courses{$cdom.'_'.$cnum})) {
-        return 1;
-    }
-    return 0;
+    my ($cdom, $cnum) = scalar(@_) == 1 ? 
+         ($_[0] =~ /^($match_domain)_($match_courseid)$/)  :  @_;
+
+    return unless $cdom and $cnum;
+
+    my %courses = &courseiddump($cdom, '.', 1, '.', '.', $cnum, undef, undef,
+        '.');
+
+    return unless exists($courses{$cdom.'_'.$cnum});
+    return wantarray ? ($cdom, $cnum) : $cdom.'_'.$cnum;
 }
 
 sub store_userdata {
@@ -10769,6 +10761,7 @@ sub declutter {
     $thisfn=~s|^adm/wrapper/||;
     $thisfn=~s|^adm/coursedocs/showdoc/||;
     $thisfn=~s/^res\///;
+    $thisfn=~s/^priv\///;
     unless (($thisfn =~ /^ext/) || ($thisfn =~ /\.(page|sequence)___\d+___ext/)) {
         $thisfn=~s/\?.+$//;
     }
@@ -11687,7 +11680,13 @@ B<idput($udom,%ids)>: store away a list
 
 =item *
 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 *
 X<getsection()>
@@ -11980,6 +11979,19 @@ 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).
 
+=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
 
 =head2 Resource Subroutines