--- loncom/lonnet/perl/lonnet.pm	2012/06/24 18:03:29	1.1172.2.7
+++ loncom/lonnet/perl/lonnet.pm	2012/09/25 23:15:25	1.1172.2.12
@@ -1,7 +1,7 @@
 # The LearningOnline Network
 # TCP networking package
 #
-# $Id: lonnet.pm,v 1.1172.2.7 2012/06/24 18:03:29 raeburn Exp $
+# $Id: lonnet.pm,v 1.1172.2.12 2012/09/25 23:15:25 raeburn Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -108,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);
     }
 }
 
@@ -1233,8 +1235,8 @@ sub get_lonbalancer_config {
 
 sub check_loadbalancing {
     my ($uname,$udom) = @_;
-    my ($is_balancer,$dom_in_use,$homeintdom,$rule_in_effect,
-        $offloadto,$otherserver);
+    my ($is_balancer,$currtargets,$currrules,$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');
@@ -1259,14 +1261,8 @@ sub check_loadbalancing {
         }
     }
     if (ref($result) eq 'HASH') {
-        my $currbalancer = $result->{'lonhost'};
-        my $currtargets = $result->{'targets'};
-        my $currrules = $result->{'rules'};
-        if ($currbalancer ne '') {
-            if (grep(/^\Q$currbalancer\E$/,@hosts)) {
-                $is_balancer = 1;
-            }
-        }
+        ($is_balancer,$currtargets,$currrules) =
+            &check_balancer_result($result,@hosts);
         if ($is_balancer) {
             if (ref($currrules) eq 'HASH') {
                 if ($homeintdom) {
@@ -1324,12 +1320,9 @@ sub check_loadbalancing {
             }
         }
         if (ref($result) eq 'HASH') {
-            my $currbalancer = $result->{'lonhost'};
-            my $currtargets = $result->{'targets'};
-            my $currrules = $result->{'rules'};
-
-            if ($currbalancer eq $lonhost) {
-                $is_balancer = 1;
+            ($is_balancer,$currtargets,$currrules) =
+                &check_balancer_result($result,@hosts);
+            if ($is_balancer) {
                 if (ref($currrules) eq 'HASH') {
                     if ($currrules->{'_LC_internetdom'} ne '') {
                         $rule_in_effect = $currrules->{'_LC_internetdom'};
@@ -1393,6 +1386,32 @@ sub check_loadbalancing {
     return ($is_balancer,$otherserver);
 }
 
+sub check_balancer_result {
+    my ($result,@hosts) = @_;
+    my ($is_balancer,$currtargets,$currrules);
+    if (ref($result) eq 'HASH') {
+        if ($result->{'lonhost'} ne '') {
+            my $currbalancer = $result->{'lonhost'};
+            if (grep(/^\Q$currbalancer\E$/,@hosts)) {
+                $is_balancer = 1;
+                $currtargets = $result->{'targets'};
+                $currrules = $result->{'rules'};
+            }
+        } else {
+            foreach my $key (keys(%{$result})) {
+                if (($key ne '') && (grep(/^\Q$key\E$/,@hosts)) &&
+                    (ref($result->{$key}) eq 'HASH')) {
+                    $is_balancer = 1;
+                    $currrules = $result->{$key}{'rules'};
+                    $currtargets = $result->{$key}{'targets'};
+                    last;
+                }
+            }
+        }
+    }
+    return ($is_balancer,$currtargets,$currrules);
+}
+
 sub get_loadbalancer_targets {
     my ($rule_in_effect,$currtargets,$uname,$udom) = @_;
     my $offloadto;
@@ -1935,7 +1954,8 @@ 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'};
@@ -1966,6 +1986,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};
@@ -2395,7 +2418,7 @@ sub chatsend {
 
 sub getversion {
     my $fname=&clutter(shift);
-    unless ($fname=~/^\/res\//) { return -1; }
+    unless ($fname=~m{^(/adm/wrapper|)/res/}) { return -1; }
     return &currentversion(&filelocation('',$fname));
 }
 
@@ -3523,38 +3546,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));
@@ -3667,7 +3722,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);
@@ -4989,15 +5044,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 {
@@ -5639,6 +5698,10 @@ sub usertools_access {
                       unofficial => 1,
                       community  => 1,
                  );
+    } elsif ($context eq 'requestauthor') {
+        %tools = (
+                      requestauthor => 1,
+                 );
     } else {
         %tools = (
                       aboutme   => 1,
@@ -5658,25 +5721,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'};
         }
     }
@@ -7463,6 +7533,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.
@@ -7513,11 +7618,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);
         }
@@ -9812,6 +9931,41 @@ sub devalidate_slots_cache {
     &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 {
@@ -9839,7 +9993,7 @@ sub symblist {
 # --------------------------------------------------------------- Verify a symb
 
 sub symbverify {
-    my ($symb,$thisurl)=@_;
+    my ($symb,$thisurl,$encstate)=@_;
     my $thisfn=$thisurl;
     $thisfn=&declutter($thisfn);
 # direct jump to resource in page or to a sequence - will construct own symbs
@@ -9876,6 +10030,9 @@ sub symbverify {
                if (
   &symbclean(&declutter($bighash{'map_id_'.$mapid}).'___'.$resid.'___'.$thisfn)
    eq $symb) { 
+                   if (ref($encstate)) {
+                       $$encstate = $bighash{'encrypted_'.$id};
+                   }
 		   if (($env{'request.role.adv'}) ||
 		       ($bighash{'encrypted_'.$id} eq $env{'request.enc'}) ||
                        ($thisurl eq '/adm/navmaps')) {
@@ -9956,7 +10113,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'}) {
@@ -12072,11 +12233,14 @@ returns the data handle
 
 =item *
 
-symbverify($symb,$thisfn) : verifies that $symb actually exists and is
-a possible symb for the URL in $thisfn, and if is an encryypted
+symbverify($symb,$thisfn,$ecstate) : verifies that $symb actually exists
+and is a possible symb for the URL in $thisfn, and if is an encrypted
 resource that the user accessed using /enc/ returns a 1 on success, 0
-on failure, user must be in a course, as it assumes the existance of
-the course initial hash, and uses $env('request.course.id'}
+on failure, user must be in a course, as it assumes the existence of
+the course initial hash, and uses $env('request.course.id'}.  The third
+arg is an optional reference to a scalar.  If this arg is passed in the
+call to symbverify, it will be set to 1 if the symb has been set to be 
+encrypted; otherwise it will be null.
 
 
 =item *