--- loncom/lonnet/perl/lonnet.pm	2011/10/31 13:44:37	1.1141
+++ loncom/lonnet/perl/lonnet.pm	2012/08/27 15:03:52	1.1172.2.9
@@ -1,7 +1,7 @@
 # The LearningOnline Network
 # TCP networking package
 #
-# $Id: lonnet.pm,v 1.1141 2011/10/31 13:44:37 raeburn Exp $
+# $Id: lonnet.pm,v 1.1172.2.9 2012/08/27 15:03:52 raeburn Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -96,6 +96,7 @@ use Math::Random;
 use File::MMagic;
 use LONCAPA qw(:DEFAULT :match);
 use LONCAPA::Configuration;
+use LONCAPA::lonmetadata;
 
 use File::Copy;
 
@@ -107,31 +108,33 @@ require Exporter;
 our @ISA = qw (Exporter);
 our @EXPORT = qw(%env);
 
-
-# --------------------------------------------------------------------- Logging
+# ------------------------------------ Logging (parameters, docs, slots, roles)
 {
     my $logid;
-    sub instructor_log {
-	my ($hash_name,$storehash,$delflag,$uname,$udom,$cnum,$cdom)=@_;
-        if (($cnum eq '') || ($cdom eq '')) {
-            $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
-            $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
+    sub write_log {
+	my ($context,$hash_name,$storehash,$delflag,$uname,$udom,$cnum,$cdom)=@_;
+        if ($context eq 'course') {
+            if (($cnum eq '') || ($cdom eq '')) {
+                $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
+                $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
+            }
         }
 	$logid++;
         my $now = time();
 	my $id=$now.'00000'.$$.'00000'.$logid;
-	return &Apache::lonnet::put('nohist_'.$hash_name,
-				    { $id => {
-					'exe_uname' => $env{'user.name'},
-					'exe_udom'  => $env{'user.domain'},
-					'exe_time'  => $now,
-					'exe_ip'    => $ENV{'REMOTE_ADDR'},
-					'delflag'   => $delflag,
-					'logentry'  => $storehash,
-					'uname'     => $uname,
-					'udom'      => $udom,
-				    }
-				  },$cdom,$cnum);
+        my $logentry = {
+                         $id => {
+                                  'exe_uname' => $env{'user.name'},
+                                  'exe_udom'  => $env{'user.domain'},
+                                  'exe_time'  => $now,
+                                  'exe_ip'    => $ENV{'REMOTE_ADDR'},
+                                  'delflag'   => $delflag,
+                                  'logentry'  => $storehash,
+                                  'uname'     => $uname,
+                                  'udom'      => $udom,
+                                }
+                       };
+        return &put('nohist_'.$hash_name,$logentry,$cdom,$cnum);
     }
 }
 
@@ -595,13 +598,21 @@ sub transfer_profile_to_env {
 
 # ---------------------------------------------------- Check for valid session 
 sub check_for_valid_session {
-    my ($r) = @_;
+    my ($r,$name) = @_;
     my %cookies=CGI::Cookie->parse($r->header_in('Cookie'));
-    my $lonid=$cookies{'lonID'};
+    if ($name eq '') {
+        $name = 'lonID';
+    }
+    my $lonid=$cookies{$name};
     return undef if (!$lonid);
 
     my $handle=&LONCAPA::clean_handle($lonid->value);
-    my $lonidsdir=$r->dir_config('lonIDsDir');
+    my $lonidsdir;
+    if ($name eq 'lonDAV') {
+        $lonidsdir=$r->dir_config('lonDAVsessDir');
+    } else {
+        $lonidsdir=$r->dir_config('lonIDsDir');
+    }
     return undef if (!-e "$lonidsdir/$handle.id");
 
     my $opened = open(my $idf,'+<',"$lonidsdir/$handle.id");
@@ -930,7 +941,7 @@ sub choose_server {
     my %domconfhash = &Apache::loncommon::get_domainconf($udom);
     my %servers = &get_servers($udom);
     my $lowest_load = 30000;
-    my ($login_host,$hostname,$portal_path);
+    my ($login_host,$hostname,$portal_path,$isredirect);
     foreach my $lonhost (keys(%servers)) {
         my $loginvia;
         if ($checkloginvia) {
@@ -941,12 +952,14 @@ sub choose_server {
                     &compare_server_load($server, $login_host, $lowest_load);
                 if ($login_host eq $server) {
                     $portal_path = $path;
+                    $isredirect = 1;
                 }
             } else {
                 ($login_host, $lowest_load) =
                     &compare_server_load($lonhost, $login_host, $lowest_load);
                 if ($login_host eq $lonhost) {
                     $portal_path = '';
+                    $isredirect = ''; 
                 }
             }
         } else {
@@ -957,7 +970,7 @@ sub choose_server {
     if ($login_host ne '') {
         $hostname = &hostname($login_host);
     }
-    return ($login_host,$hostname,$portal_path);
+    return ($login_host,$hostname,$portal_path,$isredirect);
 }
 
 # --------------------------------------------- Try to change a user's password
@@ -1225,6 +1238,7 @@ sub check_loadbalancing {
     my ($is_balancer,$dom_in_use,$homeintdom,$rule_in_effect,
         $offloadto,$otherserver);
     my $lonhost = $perlvar{'lonHostID'};
+    my @hosts = &current_machine_ids();
     my $uprimary_id = &Apache::lonnet::domain($udom,'primary');
     my $uintdom = &Apache::lonnet::internet_dom($uprimary_id);
     my $intdom = &Apache::lonnet::internet_dom($lonhost);
@@ -1251,7 +1265,6 @@ sub check_loadbalancing {
         my $currtargets = $result->{'targets'};
         my $currrules = $result->{'rules'};
         if ($currbalancer ne '') {
-            my @hosts = &current_machine_ids();
             if (grep(/^\Q$currbalancer\E$/,@hosts)) {
                 $is_balancer = 1;
             }
@@ -1339,31 +1352,43 @@ sub check_loadbalancing {
             $offloadto = &this_host_spares($dom_in_use);
         }
     }
-    my $lowest_load = 30000;
-    if (ref($offloadto) eq 'HASH') {
-        if (ref($offloadto->{'primary'}) eq 'ARRAY') {
-            foreach my $try_server (@{$offloadto->{'primary'}}) {
-                ($otherserver,$lowest_load) =
-                    &compare_server_load($try_server,$otherserver,$lowest_load);
+    if ($is_balancer) {
+        my $lowest_load = 30000;
+        if (ref($offloadto) eq 'HASH') {
+            if (ref($offloadto->{'primary'}) eq 'ARRAY') {
+                foreach my $try_server (@{$offloadto->{'primary'}}) {
+                    ($otherserver,$lowest_load) =
+                        &compare_server_load($try_server,$otherserver,$lowest_load);
+                }
             }
-        }
-        my $found_server = ($otherserver ne '' && $lowest_load < 100);
+            my $found_server = ($otherserver ne '' && $lowest_load < 100);
 
-        if (!$found_server) {
-            if (ref($offloadto->{'default'}) eq 'ARRAY') {
-                foreach my $try_server (@{$offloadto->{'default'}}) {
+            if (!$found_server) {
+                if (ref($offloadto->{'default'}) eq 'ARRAY') {
+                    foreach my $try_server (@{$offloadto->{'default'}}) {
+                        ($otherserver,$lowest_load) =
+                            &compare_server_load($try_server,$otherserver,$lowest_load);
+                    }
+                }
+            }
+        } elsif (ref($offloadto) eq 'ARRAY') {
+            if (@{$offloadto} == 1) {
+                $otherserver = $offloadto->[0];
+            } elsif (@{$offloadto} > 1) {
+                foreach my $try_server (@{$offloadto}) {
                     ($otherserver,$lowest_load) =
                         &compare_server_load($try_server,$otherserver,$lowest_load);
                 }
             }
         }
-    } elsif (ref($offloadto) eq 'ARRAY') {
-        if (@{$offloadto} == 1) {
-            $otherserver = $offloadto->[0];
-        } elsif (@{$offloadto} > 1) {
-            foreach my $try_server (@{$offloadto}) {
-                ($otherserver,$lowest_load) =
-                    &compare_server_load($try_server,$otherserver,$lowest_load);
+        if (($otherserver ne '') && (grep(/^\Q$otherserver\E$/,@hosts))) {
+            $is_balancer = 0;
+            if ($uname ne '' && $udom ne '') {
+                if (($env{'user.name'} eq $uname) && ($env{'user.domain'} eq $udom)) {
+
+                    &appenv({'user.loadbalexempt'     => $lonhost,
+                             'user.loadbalcheck.time' => time});
+                }
             }
         }
     }
@@ -1373,7 +1398,9 @@ sub check_loadbalancing {
 sub get_loadbalancer_targets {
     my ($rule_in_effect,$currtargets,$uname,$udom) = @_;
     my $offloadto;
-    if ($rule_in_effect eq '') {
+    if ($rule_in_effect eq 'none') {
+        return [$perlvar{'lonHostID'}];
+    } elsif ($rule_in_effect eq '') {
         $offloadto = $currtargets;
     } else {
         if ($rule_in_effect eq 'homeserver') {
@@ -1391,7 +1418,7 @@ sub get_loadbalancer_targets {
                     }
                 }
             } else {
-                my %servers = &dom_servers($udom);
+                my %servers = &internet_dom_servers($udom);
                 my ($remotebalancer,$remotetargets) = &get_lonbalancer_config(\%servers);
                 if (&hostname($remotebalancer) ne '') {
                     $offloadto = [$remotebalancer];
@@ -1524,16 +1551,13 @@ sub idput {
 
 # ------------------------------dump from db file owned by domainconfig user
 sub dump_dom {
-    my ($namespace,$udom,$regexp,$range)=@_;
-    if (!$udom) {
-        $udom=$env{'user.domain'};
-    }
-    my %returnhash;
-    if ($udom) {
-        my $uname = &get_domainconfiguser($udom);
-        %returnhash = &dump($namespace,$udom,$uname,$regexp,$range);
-    }
-    return %returnhash;
+    my ($namespace, $udom, $regexp) = @_;
+
+    $udom ||= $env{'user.domain'};
+
+    return () unless $udom;
+
+    return &dump($namespace, $udom, &get_domainconfiguser($udom), $regexp);
 }
 
 # ------------------------------------------ get items from domain db files   
@@ -1913,13 +1937,15 @@ sub get_domain_defaults {
     my %domconfig =
          &Apache::lonnet::get_dom('configuration',['defaults','quotas',
                                   'requestcourses','inststatus',
-                                  'coursedefaults','usersessions'],$domain);
+                                  'coursedefaults','usersessions',
+                                  'requestauthor'],$domain);
     if (ref($domconfig{'defaults'}) eq 'HASH') {
         $domdefaults{'lang_def'} = $domconfig{'defaults'}{'lang_def'}; 
         $domdefaults{'auth_def'} = $domconfig{'defaults'}{'auth_def'};
         $domdefaults{'auth_arg_def'} = $domconfig{'defaults'}{'auth_arg_def'};
         $domdefaults{'timezone_def'} = $domconfig{'defaults'}{'timezone_def'};
         $domdefaults{'datelocale_def'} = $domconfig{'defaults'}{'datelocale_def'};
+        $domdefaults{'portal_def'} = $domconfig{'defaults'}{'portal_def'};
     } else {
         $domdefaults{'lang_def'} = &domain($domain,'lang_def');
         $domdefaults{'auth_def'} = &domain($domain,'auth_def');
@@ -1931,7 +1957,7 @@ sub get_domain_defaults {
         } else {
             $domdefaults{'defaultquota'} = $domconfig{'quotas'};
         } 
-        my @usertools = ('aboutme','blog','portfolio');
+        my @usertools = ('aboutme','blog','webdav','portfolio');
         foreach my $item (@usertools) {
             if (ref($domconfig{'quotas'}{$item}) eq 'HASH') {
                 $domdefaults{$item} = $domconfig{'quotas'}{$item};
@@ -1943,6 +1969,9 @@ sub get_domain_defaults {
             $domdefaults{$item} = $domconfig{'requestcourses'}{$item};
         }
     }
+    if (ref($domconfig{'requestauthor'}) eq 'HASH') {
+        $domdefaults{'requestauthor'} = $domconfig{'requestauthor'};
+    }
     if (ref($domconfig{'inststatus'}) eq 'HASH') {
         foreach my $item ('inststatustypes','inststatusorder') {
             $domdefaults{$item} = $domconfig{'inststatus'}{$item};
@@ -2146,8 +2175,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;
@@ -2429,10 +2457,11 @@ sub subscribe {
 sub repcopy {
     my $filename=shift;
     $filename=~s/\/+/\//g;
-    if ($filename=~m|^/home/httpd/html/adm/|) { return 'ok'; }
-    if ($filename=~m|^/home/httpd/html/lonUsers/|) { return 'ok'; }
-    if ($filename=~m|^/home/httpd/html/userfiles/| or
-	$filename=~m -^/*(uploaded|editupload)/-) { 
+    my $londocroot = $perlvar{'lonDocRoot'};
+    if ($filename=~m{^\Q$londocroot/adm/\E}) { return 'ok'; }
+    if ($filename=~m{^\Q/home/httpd/lonUsers/\E}) { return 'ok'; }
+    if ($filename=~m{^\Q$londocroot/userfiles/\E} or
+	$filename=~m{^/*(uploaded|editupload)/}) {
 	return &repcopy_userfile($filename);
     }
     $filename=~s/[\n\r]//g;
@@ -2459,7 +2488,7 @@ sub repcopy {
         unless ($home eq $perlvar{'lonHostID'}) {
            my @parts=split(/\//,$filename);
            my $path="/$parts[1]/$parts[2]/$parts[3]/$parts[4]";
-           if ($path ne "$perlvar{'lonDocRoot'}/res") {
+           if ($path ne "$londocroot/res") {
                &logthis("Malconfiguration for replication: $filename");
 	       return 'bad_request';
            }
@@ -2558,8 +2587,7 @@ sub ssi {
     }
 
     $request->header(Cookie => $ENV{'HTTP_COOKIE'});
-    my $response=$ua->request($request);
-
+    my $response= $ua->request($request);
     if (wantarray) {
 	return ($response->content, $response);
     } else {
@@ -2797,7 +2825,7 @@ sub resizeImage {
 #        $resizewidth - width (pixels) to which to resize uploaded image
 #        $resizeheight - height (pixels) to which to resize uploaded image
 #        $mimetype - reference to scalar to accommodate mime type determined
-#                    from File::MMagic if $parser = parse.
+#                    from File::MMagic.
 # 
 # output: url of file in userspace, or error: <message> 
 #             or /adm/notfound.html if failure to upload occurse
@@ -2966,10 +2994,17 @@ sub finishuserfileupload {
             }  
 	}
     }
+    if (($context eq 'coursedoc') || ($parser eq 'parse')) {
+        if (ref($mimetype)) {
+            if ($$mimetype eq '') {
+                my $mm = new File::MMagic;
+                my $type = $mm->checktype_filename($filepath.'/'.$file);
+                $$mimetype = $type;
+            }
+        }
+    }
     if ($parser eq 'parse') {
-        my $mm = new File::MMagic;
-        my $type = $mm->checktype_filename($filepath.'/'.$file);
-        if ($type eq 'text/html') {
+        if ((ref($mimetype)) && ($$mimetype eq 'text/html')) {
             my $parse_result = &extract_embedded_items($filepath.'/'.$file,
                                                        $allfiles,$codebase);
             unless ($parse_result eq 'ok') {
@@ -2977,9 +3012,6 @@ sub finishuserfileupload {
 	   	         ' for embedded media: '.$parse_result); 
             }
         }
-        if (ref($mimetype)) {
-            $$mimetype = $type;
-        }
     }
     if (($thumbwidth =~ /^\d+$/) && ($thumbheight =~ /^\d+$/)) {
         my $input = $filepath.'/'.$file;
@@ -3016,6 +3048,7 @@ sub finishuserfileupload {
 sub extract_embedded_items {
     my ($fullpath,$allfiles,$codebase,$content) = @_;
     my @state = ();
+    my (%lastids,%related,%shockwave,%flashvars);
     my %javafiles = (
                       codebase => '',
                       code => '',
@@ -3045,10 +3078,30 @@ sub extract_embedded_items {
 		&add_filetype($allfiles,$attr->{'href'},'href');
 	    }
             if (lc($tagname) eq 'script') {
+                my $src;
                 if ($attr->{'archive'} =~ /\.jar$/i) {
                     &add_filetype($allfiles,$attr->{'archive'},'archive');
                 } else {
-                    &add_filetype($allfiles,$attr->{'src'},'src');
+                    if ($attr->{'src'} ne '') {
+                        $src = $attr->{'src'};
+                        &add_filetype($allfiles,$src,'src');
+                    }
+                }
+                my $text = $p->get_trimmed_text();
+                if ($text =~ /\Qswfobject.registerObject(\E([^\)]+)\)/) {
+                    my @swfargs = split(/,/,$1);
+                    foreach my $item (@swfargs) {
+                        $item =~ s/["']//g;
+                        $item =~ s/^\s+//;
+                        $item =~ s/\s+$//;
+                    }
+                    if (($swfargs[0] ne'') && ($swfargs[2] ne '')) {
+                        if (ref($related{$swfargs[0]}) eq 'ARRAY') {
+                            push(@{$related{$swfargs[0]}},$swfargs[2]);
+                        } else {
+                            $related{$swfargs[0]} = [$swfargs[2]];
+                        }
+                    }
                 }
             }
             if (lc($tagname) eq 'link') {
@@ -3061,6 +3114,9 @@ sub extract_embedded_items {
 		foreach my $item (keys(%javafiles)) {
 		    $javafiles{$item} = '';
 		}
+                if ((lc($tagname) eq 'object') && (lc($state[-2]) ne 'object')) {
+                    $lastids{lc($tagname)} = $attr->{'id'};
+                }
 	    }
 	    if (lc($state[-2]) eq 'object' && lc($tagname) eq 'param') {
 		my $name = lc($attr->{'name'});
@@ -3070,12 +3126,22 @@ sub extract_embedded_items {
 			last;
 		    }
 		}
+                my $pathfrom;
 		foreach my $item (keys(%mediafiles)) {
 		    if ($name eq $item) {
-			&add_filetype($allfiles, $attr->{'value'}, 'value');
+                        $pathfrom = $attr->{'value'};
+                        $shockwave{$lastids{lc($state[-2])}} = $pathfrom;
+			&add_filetype($allfiles,$pathfrom,$name);
 			last;
 		    }
 		}
+                if ($name eq 'flashvars') {
+                    $flashvars{$lastids{lc($state[-2])}} = $attr->{'value'};
+                }
+                if ($pathfrom ne '') {
+                    &embedded_dependency($allfiles,\%related,$lastids{lc($state[-2])},
+                                         $pathfrom);
+                }
 	    }
 	    if (lc($tagname) eq 'embed' || lc($tagname) eq 'applet') {
 		foreach my $item (keys(%javafiles)) {
@@ -3090,7 +3156,16 @@ sub extract_embedded_items {
 			last;
 		    }
 		}
+                if (lc($tagname) eq 'embed') {
+                    if (($attr->{'name'} ne '') && ($attr->{'src'} ne '')) {
+                        &embedded_dependency($allfiles,\%related,$attr->{'name'},
+                                             $attr->{'src'});
+                    }
+                }
 	    }
+            if ($t->[4] =~ m{/>$}) {
+                pop(@state);  
+            }
 	} elsif ($t->[0] eq 'E') {
 	    my ($tagname) = ($t->[1]);
 	    if ($javafiles{'codebase'} ne '') {
@@ -3110,6 +3185,23 @@ sub extract_embedded_items {
 	    pop @state;
 	}
     }
+    foreach my $id (sort(keys(%flashvars))) {
+        if ($shockwave{$id} ne '') {
+            my @pairs = split(/\&/,$flashvars{$id});
+            foreach my $pair (@pairs) {
+                my ($key,$value) = split(/\=/,$pair);
+                if ($key eq 'thumb') {
+                    &add_filetype($allfiles,$value,$key);
+                } elsif ($key eq 'content') {
+                    my ($path) = ($shockwave{$id} =~ m{^(.+/)[^/]+$});
+                    my ($ext) = ($value =~ /\.([^.]+)$/);
+                    if ($ext ne '') {
+                        &add_filetype($allfiles,$path.$value,$ext);
+                    }
+                }
+            }
+        }
+    }
     return 'ok';
 }
 
@@ -3124,6 +3216,21 @@ sub add_filetype {
     }
 }
 
+sub embedded_dependency {
+    my ($allfiles,$related,$identifier,$pathfrom) = @_;
+    if ((ref($allfiles) eq 'HASH') && (ref($related) eq 'HASH')) {
+        if (($identifier ne '') &&
+            (ref($related->{$identifier}) eq 'ARRAY') &&
+            ($pathfrom ne '')) {
+            my ($path) = ($pathfrom =~ m{^(.+/)[^/]+$});
+            foreach my $dep (@{$related->{$identifier}}) {
+                &add_filetype($allfiles,$path.$dep,'object');
+            }
+        }
+    }
+    return;
+}
+
 sub removeuploadedurl {
     my ($url)=@_;	
     my (undef,undef,$udom,$uname,$fname)=split('/',$url,5);    
@@ -3250,15 +3357,10 @@ sub flushcourselogs {
             my $result = &inc('nohist_accesscount',\%temphash,$dom,$name);
             if ($result eq 'ok') {
                 delete $accesshash{$entry};
-            } elsif ($result eq 'unknown_cmd') {
-                # Target server has old code running on it.
-                my %temphash=($entry => $value);
-                if (&put('nohist_resevaldata',\%temphash,$dom,$name) eq 'ok') {
-                    delete $accesshash{$entry};
-                }
             }
         } else {
             my ($dom,$name) = ($entry=~m{___($match_domain)/($match_name)/(.*)___(\w+)$});
+            if (($dom eq 'uploaded') || ($dom eq 'adm')) { next; }
             my %temphash=($entry => $accesshash{$entry});
             if (&put('nohist_resevaldata',\%temphash,$dom,$name) eq 'ok') {
                 delete $accesshash{$entry};
@@ -3337,7 +3439,7 @@ sub courseacclog {
     my $fnsymb=shift;
     unless ($env{'request.course.id'}) { return ''; }
     my $what=$fnsymb.':'.$env{'user.name'}.':'.$env{'user.domain'};
-    if ($fnsymb=~/(problem|exam|quiz|assess|survey|form|task|page)$/) {
+    if ($fnsymb=~/$LONCAPA::assess_re/) {
         $what.=':POST';
         # FIXME: Probably ought to escape things....
 	foreach my $key (keys(%env)) {
@@ -3369,7 +3471,13 @@ sub countacc {
     my $url=&declutter(shift);
     return if (! defined($url) || $url eq '');
     unless ($env{'request.course.id'}) { return ''; }
+#
+# Mark that this url was used in this course
+#
     $accesshash{$env{'request.course.id'}.'___'.$url.'___course'}=1;
+#
+# Increase the access count for this resource in this child process
+#
     my $key=$$.$processmarker.'_'.$dumpcount.'___'.$url.'___count';
     $accesshash{$key}++;
 }
@@ -3381,31 +3489,37 @@ sub linklog {
     $accesshash{$from.'___'.$to.'___comefrom'}=1;
     $accesshash{$to.'___'.$from.'___goto'}=1;
 }
+
+sub statslog {
+    my ($symb,$part,$users,$av_attempts,$degdiff)=@_;
+    if ($users<2) { return; }
+    my %dynstore=&LONCAPA::lonmetadata::dynamic_metadata_storage({
+            'course'       => $env{'request.course.id'},
+            'sections'     => '"all"',
+            'num_students' => $users,
+            'part'         => $part,
+            'symb'         => $symb,
+            'mean_tries'   => $av_attempts,
+            'deg_of_diff'  => $degdiff});
+    foreach my $key (keys(%dynstore)) {
+        $accesshash{$key}=$dynstore{$key};
+    }
+}
   
 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}
@@ -3415,38 +3529,70 @@ sub userrolelog {
 
 sub courserolelog {
     my ($trole,$username,$domain,$area,$tstart,$tend,$delflag,$selfenroll,$context)=@_;
-    if (($trole eq 'cc') || ($trole eq 'in') ||
-        ($trole eq 'ep') || ($trole eq 'ad') ||
-        ($trole eq 'ta') || ($trole eq 'st') ||
-        ($trole=~/^cr/) || ($trole eq 'gr') ||
-        ($trole eq 'co')) {
-        if ($area =~ m-^/($match_domain)/($match_courseid)/?([^/]*)-) {
-            my $cdom = $1;
-            my $cnum = $2;
-            my $sec = $3;
-            my $namespace = 'rolelog';
-            my %storehash = (
-                               role    => $trole,
-                               start   => $tstart,
-                               end     => $tend,
-                               selfenroll => $selfenroll,
-                               context    => $context,
-                            );
-            if ($trole eq 'gr') {
-                $namespace = 'groupslog';
-                $storehash{'group'} = $sec;
-            } else {
-                $storehash{'section'} = $sec;
-            }
-            &instructor_log($namespace,\%storehash,$delflag,$username,$domain,$cnum,$cdom);
-            if (($trole ne 'st') || ($sec ne '')) {
-                &devalidate_cache_new('getcourseroles',$cdom.'_'.$cnum);
-            }
+    if ($area =~ m-^/($match_domain)/($match_courseid)/?([^/]*)-) {
+        my $cdom = $1;
+        my $cnum = $2;
+        my $sec = $3;
+        my $namespace = 'rolelog';
+        my %storehash = (
+                           role    => $trole,
+                           start   => $tstart,
+                           end     => $tend,
+                           selfenroll => $selfenroll,
+                           context    => $context,
+                        );
+        if ($trole eq 'gr') {
+            $namespace = 'groupslog';
+            $storehash{'group'} = $sec;
+        } else {
+            $storehash{'section'} = $sec;
+        }
+        &write_log('course',$namespace,\%storehash,$delflag,$username,
+                   $domain,$cnum,$cdom);
+        if (($trole ne 'st') || ($sec ne '')) {
+            &devalidate_cache_new('getcourseroles',$cdom.'_'.$cnum);
         }
     }
     return;
 }
 
+sub domainrolelog {
+    my ($trole,$username,$domain,$area,$tstart,$tend,$delflag,$context)=@_;
+    if ($area =~ m{^/($match_domain)/$}) {
+        my $cdom = $1;
+        my $domconfiguser = &Apache::lonnet::get_domainconfiguser($cdom);
+        my $namespace = 'rolelog';
+        my %storehash = (
+                           role    => $trole,
+                           start   => $tstart,
+                           end     => $tend,
+                           context => $context,
+                        );
+        &write_log('domain',$namespace,\%storehash,$delflag,$username,
+                   $domain,$domconfiguser,$cdom);
+    }
+    return;
+
+}
+
+sub coauthorrolelog {
+    my ($trole,$username,$domain,$area,$tstart,$tend,$delflag,$context)=@_;
+    if ($area =~ m{^/($match_domain)/($match_username)$}) {
+        my $audom = $1;
+        my $auname = $2;
+        my $namespace = 'rolelog';
+        my %storehash = (
+                           role    => $trole,
+                           start   => $tstart,
+                           end     => $tend,
+                           context => $context,
+                        );
+        &write_log('author',$namespace,\%storehash,$delflag,$username,
+                   $domain,$auname,$audom);
+    }
+    return;
+}
+
 sub get_course_adv_roles {
     my ($cid,$codes) = @_;
     $cid=$env{'request.course.id'} unless (defined($cid));
@@ -3514,8 +3660,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);
@@ -3536,6 +3681,7 @@ sub get_my_roles {
     foreach my $entry (keys(%dumphash)) {
         my ($role,$tend,$tstart);
         if ($context eq 'userroles') {
+            next if ($entry =~ /^rolesdef/);
 	    ($role,$tend,$tstart)=split(/_/,$dumphash{$entry});
         } else {
             ($tend,$tstart)=split(/\:/,$dumphash{$entry});
@@ -3559,7 +3705,7 @@ sub get_my_roles {
         }
         my ($rolecode,$username,$domain,$section,$area);
         if ($context eq 'userroles') {
-            ($area,$rolecode) = split(/_/,$entry);
+            ($area,$rolecode) = ($entry =~ /^(.+)_([^_]+)$/);
             (undef,$domain,$username,$section) = split(/\//,$area);
         } else {
             ($role,$username,$domain,$section) = split(/\:/,$entry);
@@ -3849,11 +3995,34 @@ sub get_domain_roles {
 
 # ----------------------------------------------------------- Interval timing 
 
+{
+# Caches needed for speedup of navmaps
+# We don't want to cache this for very long at all (5 seconds at most)
+# 
+# The user for whom we cache
+my $cachedkey='';
+# The cached times for this user
+my %cachedtimes=();
+# When this was last done
+my $cachedtime=();
+
+sub load_all_first_access {
+    my ($uname,$udom)=@_;
+    if (($cachedkey eq $uname.':'.$udom) &&
+        (abs($cachedtime-time)<5) && (!$env{'form.markaccess'})) {
+        return;
+    }
+    $cachedtime=time;
+    $cachedkey=$uname.':'.$udom;
+    %cachedtimes=&dump('firstaccesstimes',$udom,$uname);
+}
+
 sub get_first_access {
-    my ($type,$argsymb)=@_;
+    my ($type,$argsymb,$argmap)=@_;
     my ($symb,$courseid,$udom,$uname)=&whichuser();
     if ($argsymb) { $symb=$argsymb; }
     my ($map,$id,$res)=&decode_symb($symb);
+    if ($argmap) { $map = $argmap; }
     if ($type eq 'course') {
 	$res='course';
     } elsif ($type eq 'map') {
@@ -3861,12 +4030,12 @@ sub get_first_access {
     } else {
 	$res=$symb;
     }
-    my %times=&get('firstaccesstimes',["$courseid\0$res"],$udom,$uname);
-    return $times{"$courseid\0$res"};
+    &load_all_first_access($uname,$udom);
+    return $cachedtimes{"$courseid\0$res"};
 }
 
 sub set_first_access {
-    my ($type)=@_;
+    my ($type,$interval)=@_;
     my ($symb,$courseid,$udom,$uname)=&whichuser();
     my ($map,$id,$res)=&decode_symb($symb);
     if ($type eq 'course') {
@@ -3876,13 +4045,27 @@ sub set_first_access {
     } else {
 	$res=$symb;
     }
-    my $firstaccess=&get_first_access($type,$symb);
+    $cachedkey='';
+    my $firstaccess=&get_first_access($type,$symb,$map);
     if (!$firstaccess) {
-	return &put('firstaccesstimes',{"$courseid\0$res"=>time},$udom,$uname);
+        my $start = time;
+	my $putres = &put('firstaccesstimes',{"$courseid\0$res"=>$start},
+                          $udom,$uname);
+        if ($putres eq 'ok') {
+            &put('timerinterval',{"$courseid\0$res"=>$interval},
+                 $udom,$uname); 
+            &appenv(
+                     {
+                        'course.'.$courseid.'.firstaccess.'.$res   => $start,
+                        'course.'.$courseid.'.timerinterval.'.$res => $interval,
+                     }
+                  );
+        }
+        return $putres;
     }
     return 'already_set';
 }
-
+}
 # --------------------------------------------- Set Expire Date for Spreadsheet
 
 sub expirespread {
@@ -4470,95 +4653,127 @@ 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 ($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);
+        $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=();   
+    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);
-		}
+    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;
     }
-    return \%userroles;  
+
+    @userroles{'user.author', 'user.adv'} = &set_userprivs(\%userroles,
+        \%allroles, \%allgroups);
+    $env{'user.adv'} = $userroles{'user.adv'};
+
+    return (\%userroles,\%firstaccenv,\%timerintenv);
 }
 
 sub set_arearole {
@@ -4812,15 +5027,19 @@ sub delete_env_groupprivs {
 sub check_adhoc_privs {
     my ($cdom,$cnum,$update,$refresh,$now,$checkrole,$caller) = @_;
     my $cckey = 'user.role.'.$checkrole.'./'.$cdom.'/'.$cnum;
+    my $setprivs;
     if ($env{$cckey}) {
         my ($role,$where,$trolecode,$tstart,$tend,$tremark,$tstatus,$tpstart,$tpend);
         &role_status($cckey,$update,$refresh,$now,\$role,\$where,\$trolecode,\$tstatus,\$tstart,\$tend);
         unless (($tstatus eq 'is') || ($tstatus eq 'will_not')) {
             &set_adhoc_privileges($cdom,$cnum,$checkrole,$caller);
+            $setprivs = 1;
         }
     } else {
         &set_adhoc_privileges($cdom,$cnum,$checkrole,$caller);
+        $setprivs = 1;
     }
+    return $setprivs;
 }
 
 sub set_adhoc_privileges {
@@ -4893,16 +5112,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/ )) {
@@ -5461,10 +5681,15 @@ sub usertools_access {
                       unofficial => 1,
                       community  => 1,
                  );
+    } elsif ($context eq 'requestauthor') {
+        %tools = (
+                      requestauthor => 1,
+                 );
     } else {
         %tools = (
                       aboutme   => 1,
                       blog      => 1,
+                      webdav    => 1,
                       portfolio => 1,
                  );
     }
@@ -5479,25 +5704,32 @@ sub usertools_access {
         if ($action ne 'reload') {
             if ($context eq 'requestcourses') {
                 return $env{'environment.canrequest.'.$tool};
+            } elsif ($context eq 'requestauthor') {
+                return $env{'environment.canrequest.author'};
             } else {
                 return $env{'environment.availabletools.'.$tool};
             }
         }
     }
 
-    my ($toolstatus,$inststatus);
+    my ($toolstatus,$inststatus,$envkey);
+    if ($context eq 'requestauthor') {
+        $envkey = $context;
+    } else {
+        $envkey = $context.'.'.$tool;
+    }
 
     if (($udom eq $env{'user.domain'}) && ($uname eq $env{'user.name'}) &&
          ($action ne 'reload')) {
-        $toolstatus = $env{'environment.'.$context.'.'.$tool};
+        $toolstatus = $env{'environment.'.$envkey};
         $inststatus = $env{'environment.inststatus'};
     } else {
         if (ref($userenvref) eq 'HASH') {
-            $toolstatus = $userenvref->{$context.'.'.$tool};
+            $toolstatus = $userenvref->{$envkey};
             $inststatus = $userenvref->{'inststatus'};
         } else {
-            my %userenv = &userenvironment($udom,$uname,$context.'.'.$tool,'inststatus');
-            $toolstatus = $userenv{$context.'.'.$tool};
+            my %userenv = &userenvironment($udom,$uname,$envkey,'inststatus');
+            $toolstatus = $userenv{$envkey};
             $inststatus = $userenv{'inststatus'};
         }
     }
@@ -5563,7 +5795,7 @@ sub usertools_access {
             }
         }
     } else {
-        if ($context eq 'tools') {
+        if (($context eq 'tools') && ($tool ne 'webdav')) {
             $access = 1;
         } else {
             $access = 0;
@@ -5939,7 +6171,12 @@ sub allowed {
         if ($match) {
             if ($env{'user.priv.'.$env{'request.role'}.'./'}
                   =~/\Q$priv\E\&([^\:]*)/) {
-                $thisallowed.=$1;
+                my @blockers = &has_comm_blocking($priv,$symb,$uri);
+                if (@blockers > 0) {
+                    $thisallowed = 'B';
+                } else {
+                    $thisallowed.=$1;
+                }
             }
         } else {
             my $refuri = $env{'httpref.'.$orguri} || $env{'httpref.'.$ver_orguri};
@@ -5950,7 +6187,12 @@ sub allowed {
                     $refuri=&declutter($refuri);
                     my ($match) = &is_on_map($refuri);
                     if ($match) {
-                        $thisallowed='F';
+                        my @blockers = &has_comm_blocking($priv,$symb,$refuri);
+                        if (@blockers > 0) {
+                            $thisallowed = 'B';
+                        } else {
+                            $thisallowed='F';
+                        }
                     }
                 }
             }
@@ -6002,7 +6244,17 @@ sub allowed {
            $statecond=$cond;
            if ($env{'user.priv.'.$env{'request.role'}.'./'.$courseprivid}
                =~/\Q$priv\E\&([^\:]*)/) {
-               $thisallowed.=$1;
+               my $value = $1;
+               if ($priv eq 'bre') {
+                   my @blockers = &has_comm_blocking($priv,$symb,$uri);
+                   if (@blockers > 0) {
+                       $thisallowed = 'B';
+                   } else {
+                       $thisallowed.=$value;
+                   }
+               } else {
+                   $thisallowed.=$value;
+               }
                $checkreferer=0;
            }
        }
@@ -6030,7 +6282,17 @@ sub allowed {
               my $refstatecond=$cond;
               if ($env{'user.priv.'.$env{'request.role'}.'./'.$courseprivid}
                   =~/\Q$priv\E\&([^\:]*)/) {
-                  $thisallowed.=$1;
+                  my $value = $1;
+                  if ($priv eq 'bre') {
+                      my @blockers = &has_comm_blocking($priv,$symb,$refuri);
+                      if (@blockers > 0) {
+                          $thisallowed = 'B';
+                      } else {
+                          $thisallowed.=$value;
+                      }
+                  } else {
+                      $thisallowed.=$value;
+                  }
                   $uri=$refuri;
                   $statecond=$refstatecond;
               }
@@ -6189,6 +6451,164 @@ sub allowed {
     }
    return 'F';
 }
+
+sub get_comm_blocks {
+    my ($cdom,$cnum) = @_;
+    if ($cdom eq '' || $cnum eq '') {
+        return unless ($env{'request.course.id'});
+        $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
+        $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
+    }
+    my %commblocks;
+    my $hashid=$cdom.'_'.$cnum;
+    my ($blocksref,$cached)=&is_cached_new('comm_block',$hashid);
+    if ((defined($cached)) && (ref($blocksref) eq 'HASH')) {
+        %commblocks = %{$blocksref};
+    } else {
+        %commblocks = &Apache::lonnet::dump('comm_block',$cdom,$cnum);
+        my $cachetime = 600;
+        &do_cache_new('comm_block',$hashid,\%commblocks,$cachetime);
+    }
+    return %commblocks;
+}
+
+sub has_comm_blocking {
+    my ($priv,$symb,$uri,$blocks) = @_;
+    return unless ($env{'request.course.id'});
+    return unless ($priv eq 'bre');
+    return if ($env{'user.priv.'.$env{'request.role'}} =~/evb\&([^\:]*)/);
+    my %commblocks;
+    if (ref($blocks) eq 'HASH') {
+        %commblocks = %{$blocks};
+    } else {
+        %commblocks = &get_comm_blocks();
+    }
+    return unless (keys(%commblocks) > 0);
+    if (!$symb) { $symb=&symbread($uri,1); }
+    my ($map,$resid,undef)=&decode_symb($symb);
+    my %tocheck = (
+                    maps      => $map,
+                    resources => $symb,
+                  );
+    my @blockers;
+    my $now = time;
+    my $navmap = Apache::lonnavmaps::navmap->new();
+    foreach my $block (keys(%commblocks)) {
+        if ($block =~ /^(\d+)____(\d+)$/) {
+            my ($start,$end) = ($1,$2);
+            if ($start <= $now && $end >= $now) {
+                if (ref($commblocks{$block}{'blocks'}) eq 'HASH') {
+                    if (ref($commblocks{$block}{'blocks'}{'docs'}) eq 'HASH') {
+                        if (ref($commblocks{$block}{'blocks'}{'docs'}{'maps'}) eq 'HASH') {
+                            if ($commblocks{$block}{'blocks'}{'docs'}{'maps'}{$map}) {
+                                unless (grep(/^\Q$block\E$/,@blockers)) {
+                                    push(@blockers,$block);
+                                }
+                            }
+                        }
+                        if (ref($commblocks{$block}{'blocks'}{'docs'}{'resources'}) eq 'HASH') {
+                            if ($commblocks{$block}{'blocks'}{'docs'}{'resources'}{$symb}) {
+                                unless (grep(/^\Q$block\E$/,@blockers)) {  
+                                    push(@blockers,$block);
+                                }
+                            }
+                        }
+                    }
+                }
+            }
+        } elsif ($block =~ /^firstaccess____(.+)$/) {
+            my $item = $1;
+            my @to_test;
+            if (ref($commblocks{$block}{'blocks'}) eq 'HASH') {
+                if (ref($commblocks{$block}{'blocks'}{'docs'}) eq 'HASH') {
+                    my $check_interval;
+                    if (&check_docs_block($commblocks{$block}{'blocks'}{'docs'},\%tocheck)) {
+                        my @interval;
+                        my $type = 'map';
+                        if ($item eq 'course') {
+                            $type = 'course';
+                            @interval=&EXT("resource.0.interval");
+                        } else {
+                            if ($item =~ /___\d+___/) {
+                                $type = 'resource';
+                                @interval=&EXT("resource.0.interval",$item);
+                                if (ref($navmap)) {                        
+                                    my $res = $navmap->getBySymb($item); 
+                                    push(@to_test,$res);
+                                }
+                            } else {
+                                my $mapsymb = &symbread($item,1);
+                                if ($mapsymb) {
+                                    if (ref($navmap)) {
+                                        my $mapres = $navmap->getBySymb($mapsymb);
+                                        @to_test = $mapres->retrieveResources($mapres,undef,0,1);
+                                        foreach my $res (@to_test) {
+                                            my $symb = $res->symb();
+                                            next if ($symb eq $mapsymb);
+                                            if ($symb ne '') {
+                                                @interval=&EXT("resource.0.interval",$symb);
+                                                last;
+                                            }
+                                        }
+                                    }
+                                }
+                            }
+                        }
+                        if ($interval[0] =~ /\d+/) {
+                            my $first_access;
+                            if ($type eq 'resource') {
+                                $first_access=&get_first_access($interval[1],$item);
+                            } elsif ($type eq 'map') {
+                                $first_access=&get_first_access($interval[1],undef,$item);
+                            } else {
+                                $first_access=&get_first_access($interval[1]);
+                            }
+                            if ($first_access) {
+                                my $timesup = $first_access+$interval[0];
+                                if ($timesup > $now) {
+                                    foreach my $res (@to_test) {
+                                        if ($res->is_problem()) {
+                                            if ($res->completable()) {
+                                                unless (grep(/^\Q$block\E$/,@blockers)) {
+                                                    push(@blockers,$block);
+                                                }
+                                                last;
+                                            }
+                                        }
+                                    }
+                                }
+                            }
+                        }
+                    }
+                }
+            }
+        }
+    }
+    return @blockers;
+}
+
+sub check_docs_block {
+    my ($docsblock,$tocheck) =@_;
+    if ((ref($docsblock) ne 'HASH') || (ref($tocheck) ne 'HASH')) {
+        return;
+    }
+    if (ref($docsblock->{'maps'}) eq 'HASH') {
+        if ($tocheck->{'maps'}) {
+            if ($docsblock->{'maps'}{$tocheck->{'maps'}}) {
+                return 1;
+            }
+        }
+    }
+    if (ref($docsblock->{'resources'}) eq 'HASH') {
+        if ($tocheck->{'resources'}) {
+            if ($docsblock->{'resources'}{$tocheck->{'resources'}}) {
+                return 1;
+            }
+        }
+    }
+    return;
+}
+
 #
 #   Removes the versino from a URI and
 #   splits it in to its filename and path to the filename.
@@ -6924,8 +7344,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;
@@ -7097,6 +7516,41 @@ sub assignrole {
                             }
                         }
                     }
+                } elsif ($context eq 'requestauthor') {
+                    if (($udom eq $env{'user.domain'}) && ($uname eq $env{'user.name'}) &&
+                        ($url eq '/'.$udom.'/') && ($role eq 'au')) {
+                        if ($env{'environment.requestauthor'} eq 'automatic') {
+                            $refused = '';
+                        } else {
+                            my %domdefaults = &get_domain_defaults($udom);
+                            if (ref($domdefaults{'requestauthor'}) eq 'HASH') {
+                                my $checkbystatus;
+                                if ($env{'user.adv'}) {
+                                    my $disposition = $domdefaults{'requestauthor'}{'_LC_adv'};
+                                    if ($disposition eq 'automatic') {
+                                        $refused = '';
+                                    } elsif ($disposition eq '') {
+                                        $checkbystatus = 1;
+                                    }
+                                } else {
+                                    $checkbystatus = 1;
+                                }
+                                if ($checkbystatus) {
+                                    if ($env{'environment.inststatus'}) {
+                                        my @inststatuses = split(/,/,$env{'environment.inststatus'});
+                                        foreach my $type (@inststatuses) {
+                                            if (($type ne '') &&
+                                                ($domdefaults{'requestauthor'}{$type} eq 'automatic')) {
+                                                $refused = '';
+                                            }
+                                        }
+                                    } elsif ($domdefaults{'requestauthor'}{'default'} eq 'automatic') {
+                                        $refused = '';
+                                    }
+                                }
+                            }
+                        }
+                    }
                 }
                 if ($refused) {
                     &logthis('Refused assignrole: '.$udom.' '.$uname.' '.$url.
@@ -7147,11 +7601,25 @@ sub assignrole {
     if ($answer eq 'ok') {
 	&userrolelog($role,$uname,$udom,$url,$start,$end);
 # for course roles, perform group memberships changes triggered by role change.
-        &courserolelog($role,$uname,$udom,$url,$origstart,$origend,$delflag,$selfenroll,$context);
         unless ($role =~ /^gr/) {
             &Apache::longroup::group_changes($udom,$uname,$url,$role,$origend,
                                              $origstart,$selfenroll,$context);
         }
+        if (($role eq 'cc') || ($role eq 'in') ||
+            ($role eq 'ep') || ($role eq 'ad') ||
+            ($role eq 'ta') || ($role eq 'st') ||
+            ($role=~/^cr/) || ($role eq 'gr') ||
+            ($role eq 'co')) {
+            &courserolelog($role,$uname,$udom,$url,$origstart,$origend,$delflag,
+                           $selfenroll,$context);
+        } elsif (($role eq 'li') || ($role eq 'dg') || ($role eq 'sc') ||
+                 ($role eq 'au') || ($role eq 'dc')) {
+            &domainrolelog($role,$uname,$udom,$url,$origstart,$origend,$delflag,
+                           $context);
+        } elsif (($role eq 'ca') || ($role eq 'aa')) {
+            &coauthorrolelog($role,$uname,$udom,$url,$origstart,$origend,$delflag,
+                             $context);
+        }
         if ($role eq 'cc') {
             &autoupdate_coowners($url,$end,$start,$uname,$udom);
         }
@@ -7513,14 +7981,16 @@ sub modify_student_enrollment {
         $uid    = $tmp{'id'}         if (!defined($uid)    || $uid  eq '');
     }
     my $fullname = &format_name($first,$middle,$last,$gene,'lastname');
+    my $user = "$uname:$udom";
+    my %old_entry = &Apache::lonnet::get('classlist',[$user],$cdom,$cnum);
     my $reply=cput('classlist',
-		   {"$uname:$udom" => 
+		   {$user => 
 			join(':',$end,$start,$uid,$usec,$fullname,$type,$locktype) },
 		   $cdom,$cnum);
-    unless (($reply eq 'ok') || ($reply eq 'delayed')) {
+    if (($reply eq 'ok') || ($reply eq 'delayed')) {
+        &devalidate_getsection_cache($udom,$uname,$cid);
+    } else { 
 	return 'error: '.$reply;
-    } else {
-	&devalidate_getsection_cache($udom,$uname,$cid);
     }
     # Add student role to user
     my $uurl='/'.$cid;
@@ -7528,7 +7998,16 @@ sub modify_student_enrollment {
     if ($usec) {
 	$uurl.='/'.$usec;
     }
-    return &assignrole($udom,$uname,$uurl,'st',$end,$start,undef,$selfenroll,$context);
+    my $result = &assignrole($udom,$uname,$uurl,'st',$end,$start,undef,
+                             $selfenroll,$context);
+    if ($result ne 'ok') {
+        if ($old_entry{$user} ne '') {
+            $reply = &cput('classlist',\%old_entry,$cdom,$cnum);
+        } else {
+            $reply = &del('classlist',[$user],$cdom,$cnum);
+        }
+    }
+    return $result; 
 }
 
 sub format_name {
@@ -7727,13 +8206,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 {
@@ -8708,15 +9190,7 @@ sub EXT {
    } elsif ($realm eq 'request') {
 # ------------------------------------------------------------- request.browser
         if ($space eq 'browser') {
-	    if ($qualifier eq 'textremote') {
-		if (&Apache::lonlocal::mt('textual_remote_display') eq 'on') {
-		    return 1;
-		} else {
-		    return 0;
-		}
-	    } else {
-		return $env{'browser.'.$qualifier};
-	    }
+            return $env{'browser.'.$qualifier};
 # ------------------------------------------------------------ request.filename
         } else {
             return $env{'request.'.$spacequalifierrest};
@@ -9361,6 +9835,10 @@ sub gettitle {
 	}
 	$title=~s/\&colon\;/\:/gs;
 	if ($title) {
+# Remember both $symb and $title for dynamic metadata
+            $accesshash{$symb.'___crstitle'}=$title;
+            $accesshash{&declutter($map).'___'.&declutter($url).'___usage'}=time;
+# Cache this title and then return it
 	    return &do_cache_new('title',$key,$title,600);
 	}
 	$urlsymb=$url;
@@ -9393,6 +9871,84 @@ sub get_slot {
     }
     return $slotinfo{$which};
 }
+
+sub get_reservable_slots {
+    my ($cnum,$cdom,$uname,$udom) = @_;
+    my $now = time;
+    my $reservable_info;
+    my $key=join("\0",'reservableslots',$cdom,$cnum,$uname,$udom);
+    if (exists($remembered{$key})) {
+        $reservable_info = $remembered{$key};
+    } else {
+        my %resv;
+        ($resv{'now_order'},$resv{'now'},$resv{'future_order'},$resv{'future'}) =
+        &Apache::loncommon::get_future_slots($cnum,$cdom,$now);
+        $reservable_info = \%resv;
+        $remembered{$key} = $reservable_info;
+    }
+    return $reservable_info;
+}
+
+sub get_course_slots {
+    my ($cnum,$cdom) = @_;
+    my $hashid=$cnum.':'.$cdom;
+    my ($result,$cached) = &Apache::lonnet::is_cached_new('allslots',$hashid);
+    if (defined($cached)) {
+        if (ref($result) eq 'HASH') {
+            return %{$result};
+        }
+    } else {
+        my %slots=&Apache::lonnet::dump('slots',$cdom,$cnum);
+        my ($tmp) = keys(%slots);
+        if ($tmp !~ /^(con_lost|error|no_such_host)/i) {
+            &Apache::lonnet::do_cache_new('allslots',$hashid,\%slots,600);
+            return %slots;
+        }
+    }
+    return;
+}
+
+sub devalidate_slots_cache {
+    my ($cnum,$cdom)=@_;
+    my $hashid=$cnum.':'.$cdom;
+    &devalidate_cache_new('allslots',$hashid);
+}
+
+sub get_coursechange {
+    my ($cdom,$cnum) = @_;
+    if ($cdom eq '' || $cnum eq '') {
+        return unless ($env{'request.course.id'});
+        $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
+        $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
+    }
+    my $hashid=$cdom.'_'.$cnum;
+    my ($change,$cached)=&is_cached_new('crschange',$hashid);
+    if ((defined($cached)) && ($change ne '')) {
+        return $change;
+    } else {
+        my %crshash;
+        %crshash = &get('environment',['internal.contentchange'],$cdom,$cnum);
+        if ($crshash{'internal.contentchange'} eq '') {
+            $change = $env{'course.'.$cdom.'_'.$cnum.'.internal.created'};
+            if ($change eq '') {
+                %crshash = &get('environment',['internal.created'],$cdom,$cnum);
+                $change = $crshash{'internal.created'};
+            }
+        } else {
+            $change = $crshash{'internal.contentchange'};
+        }
+        my $cachetime = 600;
+        &do_cache_new('crschange',$hashid,$change,$cachetime);
+    }
+    return $change;
+}
+
+sub devalidate_coursechange_cache {
+    my ($cnum,$cdom)=@_;
+    my $hashid=$cnum.':'.$cdom;
+    &devalidate_cache_new('crschange',$hashid);
+}
+
 # ------------------------------------------------- Update symbolic store links
 
 sub symblist {
@@ -9537,7 +10093,11 @@ sub deversion {
 sub symbread {
     my ($thisfn,$donotrecurse)=@_;
     my $cache_str='request.symbread.cached.'.$thisfn;
-    if (defined($env{$cache_str})) { return $env{$cache_str}; }
+    if (defined($env{$cache_str})) {
+        if (($thisfn) || ($env{$cache_str} ne '')) {
+            return $env{$cache_str};
+        }
+    }
 # no filename provided? try from environment
     unless ($thisfn) {
         if ($env{'request.symb'}) {
@@ -9758,9 +10318,11 @@ sub rndseed {
     if (!defined($symb)) {
 	unless ($symb=$wsymb) { return time; }
     }
-    if (!$courseid) { $courseid=$wcourseid; }
-    if (!$domain) { $domain=$wdomain; }
-    if (!$username) { $username=$wusername }
+    if (!defined $courseid) { 
+	$courseid=$wcourseid; 
+    }
+    if (!defined $domain) { $domain=$wdomain; }
+    if (!defined $username) { $username=$wusername }
 
     my $which;
     if (defined($cenv->{'rndseed'})) {
@@ -9768,7 +10330,6 @@ sub rndseed {
     } else {
 	$which =&get_rand_alg($courseid);
     }
-
     if (defined(&getCODE())) {
 
 	if ($which eq '64bit5') {
@@ -10094,8 +10655,9 @@ sub getfile {
 
 sub repcopy_userfile {
     my ($file)=@_;
-    if ($file =~ m -^/*(uploaded|editupload)/-) { $file=&filelocation("",$file); }
-    if ($file =~ m|^/home/httpd/html/lonUsers/|) { return 'ok'; }
+    my $londocroot = $perlvar{'lonDocRoot'};
+    if ($file =~ m{^/*(uploaded|editupload)/}) { $file=&filelocation("",$file); }
+    if ($file =~ m{^\Q/home/httpd/lonUsers/\E}) { return 'ok'; }
     my ($cdom,$cnum,$filename) = 
 	($file=~m|^\Q$perlvar{'lonDocRoot'}\E/+userfiles/+($match_domain)/+($match_name)/+(.*)|);
     my $uri="/uploaded/$cdom/$cnum/$filename";
@@ -10248,7 +10810,7 @@ sub filelocation {
         if ( !( $file =~ m:^/:) ) {
             $location = $dir. '/'.$file;
         } else {
-            $location = '/home/httpd/html/'.$space.$file;
+            $location = $perlvar{'lonDocRoot'}.'/'.$space.$file;
         }
     }
     $location=~s://+:/:g; # remove duplicate /
@@ -10274,8 +10836,8 @@ sub hreflocation {
     if ($file=~m-^\Q$perlvar{'lonDocRoot'}\E-) {
 	$file=~s-^\Q$perlvar{'lonDocRoot'}\E--;
     } elsif ($file=~m-^\Q$perlvar{'lonUsersDir'}\E-) {
-	$file=~s-^/home/httpd/lonUsers/($match_domain)/./././($match_name)/userfiles/
-	    -/uploaded/$1/$2/-x;
+	$file=~s{^/home/httpd/lonUsers/($match_domain)/./././($match_name)/userfiles/}
+	        {/uploaded/$1/$2/}x;
     }
     if ($file=~ m{^/userfiles/}) {
 	$file =~ s{^/userfiles/}{/uploaded/};
@@ -10352,6 +10914,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/\?.+$//;
     }
@@ -11270,7 +11833,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()>
@@ -11563,6 +12132,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