--- loncom/lonnet/perl/lonnet.pm	2012/11/11 17:33:26	1.1198
+++ loncom/lonnet/perl/lonnet.pm	2013/03/04 01:46:31	1.1217
@@ -1,7 +1,7 @@
 # The LearningOnline Network
 # TCP networking package
 #
-# $Id: lonnet.pm,v 1.1198 2012/11/11 17:33:26 raeburn Exp $
+# $Id: lonnet.pm,v 1.1217 2013/03/04 01:46:31 raeburn Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -78,7 +78,7 @@ use Image::Magick;
 
 use Encode;
 
-use vars qw(%perlvar %spareid %pr %prp $memcache %packagetab $tmpdir
+use vars qw(%perlvar %spareid %pr %prp $memcache %packagetab $tmpdir $apache
             $_64bit %env %protocol %loncaparevs %serverhomeIDs %needsrelease
             %managerstab);
 
@@ -634,6 +634,13 @@ sub check_for_valid_session {
 	|| !defined($disk_env{'user.domain'})) {
 	return undef;
     }
+    if (($r->user() eq '') && ($apache >= 2.4)) {
+        if ($disk_env{'user.domain'} eq $r->dir_config('lonDefDomain')) {
+            $r->user($disk_env{'user.name'});
+        } else {
+            $r->user($disk_env{'user.name'}.':'.$disk_env{'user.domain'});
+        }
+    }
     return $handle;
 }
 
@@ -2003,6 +2010,10 @@ sub get_domain_defaults {
         foreach my $item ('canuse_pdfforms') {
             $domdefaults{$item} = $domconfig{'coursedefaults'}{$item};
         }
+        if (ref($domconfig{'coursedefaults'}{'coursecredits'}) eq 'HASH') {
+            $domdefaults{'officialcredits'} = $domconfig{'coursedefaults'}{'coursecredits'}{'official'};
+            $domdefaults{'unofficialcredits'} = $domconfig{'coursedefaults'}{'coursecredits'}{'unofficial'};
+        }
     }
     if (ref($domconfig{'usersessions'}) eq 'HASH') {
         if (ref($domconfig{'usersessions'}{'remote'}) eq 'HASH') {
@@ -2671,7 +2682,7 @@ sub can_edit_resource {
 #
 # For aboutme pages user can only edit his/her own.
 #
-    if ($resurl =~ m{^/adm/($match_domain)/($match_username)/aboutme$}) {
+    if ($resurl =~ m{^/?adm/($match_domain)/($match_username)/aboutme$}) {
         my ($sdom,$sname) = ($1,$2);
         if (($sdom eq $env{'user.domain'}) && ($sname eq $env{'user.name'})) {
             $home = $env{'user.home'};
@@ -2716,10 +2727,14 @@ sub can_edit_resource {
                 return;
             }
         } else {
+            if ($resurl =~ m{^/?adm/viewclasslist$}) {
+                unless (&Apache::lonnet::allowed('opa',$env{'request.course.id'})) {
+                    return;
+                }
+            } elsif (!$crsedit) {
 #
 # No edit allowed where CC has switched to student role.
 #
-            unless ($crsedit) {
                 return;
             }
         }
@@ -2732,7 +2747,11 @@ sub can_edit_resource {
                 $incourse = 1;
                 if ($file =~/\.(htm|html|css|js|txt)$/) {
                     $cfile = &hreflocation('',$file);
-                    $forceedit = 1;
+                    if ($env{'form.forceedit'}) {
+                        $forceview = 1;
+                    } else {
+                        $forceedit = 1;
+                    }
                 }
             } elsif ($resurl =~ m{^/public/$cdom/$cnum/syllabus}) {
                 $incourse = 1;
@@ -2751,12 +2770,25 @@ sub can_edit_resource {
                         $forceedit = 1;
                     }
                     $cfile = $resurl;
-                } elsif (($resurl eq '/res/lib/templates/simpleproblem.problem')) {
+                } elsif ($resurl eq '/res/lib/templates/simpleproblem.problem') {
                     $incourse = 1;
                     $cfile = $resurl.'/smpedit';
-                } elsif ($resurl =~ /ext/) {
+                } elsif ($resurl =~ m{^/adm/wrapper/ext/}) {
+                    $incourse = 1;
+                    if ($env{'form.forceedit'}) {
+                        $forceview = 1;
+                    } else {
+                        $forceedit = 1;
+                    }
+                    $cfile = $resurl;
+                } elsif ($resurl =~ m{^/?adm/viewclasslist$}) {
                     $incourse = 1;
-                    # is external
+                    if ($env{'form.forceedit'}) {
+                        $forceview = 1;
+                    } else {
+                        $forceedit = 1;
+                    }
+                    $cfile = ($resurl =~ m{^/} ? $resurl : "/$resurl");
                 }
             } elsif ($resurl eq '/res/lib/templates/simpleproblem.problem/smpedit') {
                 my $template = '/res/lib/templates/simpleproblem.problem';
@@ -2765,11 +2797,31 @@ sub can_edit_resource {
                     $forceview = 1;
                     $cfile = $template;
                 }
+            } elsif (($resurl =~ m{^/adm/wrapper/ext/}) && ($env{'form.folderpath'} =~ /^supplemental/)) {
+                    $incourse = 1;
+                    if ($env{'form.forceedit'}) {
+                        $forceview = 1;
+                    } else {
+                        $forceedit = 1;
+                    }
+                    $cfile = $resurl;
+            } elsif (($resurl eq '/adm/extresedit') && ($symb || $env{'form.folderpath'})) {
+                $incourse = 1;
+                $forceview = 1;
+                if ($symb) {
+                    my ($map,$id,$res)=&decode_symb($symb);
+                    $env{'request.symb'} = $symb;
+                    $cfile = &clutter($res);
+                } else {
+                    $cfile = $env{'form.suppurl'};
+                    $cfile =~ s{^http://}{};
+                    $cfile = '/adm/wrapper/ext/'.$cfile;
+                }
             }
         }
         if ($uploaded || $incourse) {
             $home=&homeserver($cnum,$cdom);
-        } else {
+        } elsif ($file !~ m{/$}) {
             $file=~s{^(priv/$match_domain/$match_username)}{/$1};
             $file=~s{^($match_domain/$match_username)}{/priv/$1};
             # Check that the user has permission to edit this resource
@@ -2795,8 +2847,8 @@ sub is_course_upload {
     my ($file,$cnum,$cdom) = @_;
     my $uploadpath = &LONCAPA::propath($cdom,$cnum);
     $uploadpath =~ s{^\/}{};
-    if (($file =~ m{^\Q$uploadpath\E/userfiles/docs/}) ||
-        ($file =~ m{^userfiles/\Q$cdom\E/\Q$cnum\E/docs/})) {
+    if (($file =~ m{^\Q$uploadpath\E/userfiles/(docs|supplemental)/}) ||
+        ($file =~ m{^userfiles/\Q$cdom\E/\Q$cnum\E/(docs|supplemental)/})) {
         return 1;
     }
     return;
@@ -5022,9 +5074,11 @@ sub rolesinit {
 }
 
 sub set_arearole {
-    my ($trole,$area,$tstart,$tend,$domain,$username) = @_;
+    my ($trole,$area,$tstart,$tend,$domain,$username,$nolog) = @_;
+    unless ($nolog) {
 # log the associated role with the area
-    &userrolelog($trole,$username,$domain,$area,$tstart,$tend);
+        &userrolelog($trole,$username,$domain,$area,$tstart,$tend);
+    }
     return ('user.role.'.$trole.'.'.$area => $tstart.'.'.$tend);
 }
 
@@ -5293,7 +5347,7 @@ sub set_adhoc_privileges {
     my $area = '/'.$dcdom.'/'.$pickedcourse;
     my $spec = $role.'.'.$area;
     my %userroles = &set_arearole($role,$area,'','',$env{'user.domain'},
-                                  $env{'user.name'});
+                                  $env{'user.name'},1);
     my %ccrole = ();
     &standard_roleprivs(\%ccrole,$role,$dcdom,$spec,$pickedcourse,$area);
     my ($author,$adv)= &set_userprivs(\%userroles,\%ccrole);
@@ -6852,7 +6906,7 @@ sub constructaccess {
     if (($allowed eq 'F') || ($allowed eq 'U')) {
 # Grant temporary access
         my $then=$env{'user.login.time'};
-        my $update==$env{'user.update.time'};
+        my $update=$env{'user.update.time'};
         if (!$update) { $update = $then; }
         my $refresh=$env{'user.refresh.time'};
         if (!$refresh) { $refresh = $update; }
@@ -7391,8 +7445,8 @@ sub auto_validate_instcode {
     }
     $response=&unescape(&reply('autovalidateinstcode:'.$cdom.':'.
                         &escape($instcode).':'.&escape($owner),$homeserver));
-    my ($outcome,$description) = map { &unescape($_); } split('&',$response,2);
-    return ($outcome,$description);
+    my ($outcome,$description,$defaultcredits) = map { &unescape($_); } split('&',$response,3);
+    return ($outcome,$description,$defaultcredits);
 }
 
 sub auto_create_password {
@@ -8014,16 +8068,16 @@ sub assignrole {
 # log new user role if status is ok
     if ($answer eq 'ok') {
 	&userrolelog($role,$uname,$udom,$url,$start,$end);
-# for course roles, perform group memberships changes triggered by role change.
-        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')) {
+# for course roles, perform group memberships changes triggered by role change.
+            unless ($role =~ /^gr/) {
+                &Apache::longroup::group_changes($udom,$uname,$url,$role,$origend,
+                                                 $origstart,$selfenroll,$context);
+            }
             &courserolelog($role,$uname,$udom,$url,$origstart,$origend,$delflag,
                            $selfenroll,$context);
         } elsif (($role eq 'li') || ($role eq 'dg') || ($role eq 'sc') ||
@@ -8332,7 +8386,7 @@ sub modifyuser {
 sub modifystudent {
     my ($udom,$uname,$uid,$umode,$upass,$first,$middle,$last,$gene,$usec,
         $end,$start,$forceid,$desiredhome,$email,$type,$locktype,$cid,
-        $selfenroll,$context,$inststatus)=@_;
+        $selfenroll,$context,$inststatus,$credits)=@_;
     if (!$cid) {
 	unless ($cid=$env{'request.course.id'}) {
 	    return 'not_in_class';
@@ -8347,12 +8401,14 @@ sub modifystudent {
     # students environment
     $uid = undef if (!$forceid);
     $reply = &modify_student_enrollment($udom,$uname,$uid,$first,$middle,$last,
-					$gene,$usec,$end,$start,$type,$locktype,$cid,$selfenroll,$context);
+                                        $gene,$usec,$end,$start,$type,$locktype,
+                                        $cid,$selfenroll,$context,$credits);
     return $reply;
 }
 
 sub modify_student_enrollment {
-    my ($udom,$uname,$uid,$first,$middle,$last,$gene,$usec,$end,$start,$type,$locktype,$cid,$selfenroll,$context) = @_;
+    my ($udom,$uname,$uid,$first,$middle,$last,$gene,$usec,$end,$start,$type,
+        $locktype,$cid,$selfenroll,$context,$credits) = @_;
     my ($cdom,$cnum,$chome);
     if (!$cid) {
 	unless ($cid=$env{'request.course.id'}) {
@@ -8399,7 +8455,7 @@ sub modify_student_enrollment {
     my %old_entry = &Apache::lonnet::get('classlist',[$user],$cdom,$cnum);
     my $reply=cput('classlist',
 		   {$user => 
-			join(':',$end,$start,$uid,$usec,$fullname,$type,$locktype) },
+			join(':',$end,$start,$uid,$usec,$fullname,$type,$locktype,$credits) },
 		   $cdom,$cnum);
     if (($reply eq 'ok') || ($reply eq 'delayed')) {
         &devalidate_getsection_cache($udom,$uname,$cid);
@@ -9884,7 +9940,7 @@ sub metadata {
     # if it is a non metadata possible uri return quickly
     if (($uri eq '') || 
 	(($uri =~ m|^/*adm/|) && 
-	     ($uri !~ m|^adm/includes|) && ($uri !~ m|/bulletinboard$|)) ||
+	     ($uri !~ m|^adm/includes|) && ($uri !~ m{/(smppg|bulletinboard)$})) ||
         ($uri =~ m|/$|) || ($uri =~ m|/.meta$|) || ($uri =~ m{^/*uploaded/.+\.sequence$})) {
 	return undef;
     }
@@ -10262,6 +10318,78 @@ sub gettitle {
     return $title;
 }
 
+sub getdocspath {
+    my ($symb) = @_;
+    my $path;
+    if ($symb) {
+        my ($mapurl,$id,$resurl) = &decode_symb($symb);
+        if ($resurl=~/\.(sequence|page)$/) {
+            $mapurl=$resurl;
+        } elsif ($resurl eq 'adm/navmaps') {
+            $mapurl=$env{'course.'.$env{'request.course.id'}.'.url'};
+        }
+        my $mapresobj;
+        my $navmap = Apache::lonnavmaps::navmap->new();
+        if (ref($navmap)) {
+            $mapresobj = $navmap->getResourceByUrl($mapurl);
+        }
+        $mapurl=~s{^.*/([^/]+)\.(\w+)$}{$1};
+        my $type=$2;
+        if (ref($mapresobj)) {
+            my $pcslist = $mapresobj->map_hierarchy();
+            if ($pcslist ne '') {
+                foreach my $pc (split(/,/,$pcslist)) {
+                    next if ($pc <= 1);
+                    my $res = $navmap->getByMapPc($pc);
+                    if (ref($res)) {
+                        my $thisurl = $res->src();
+                        $thisurl=~s{^.*/([^/]+)\.\w+$}{$1};
+                        my $thistitle = $res->title();
+                        $path .= '&'.
+                                 &Apache::lonhtmlcommon::entity_encode($thisurl).'&'.
+                                 &Apache::lonhtmlcommon::entity_encode($thistitle).
+                                 ':'.$res->randompick().
+                                 ':'.$res->randomout().
+                                 ':'.$res->encrypted().
+                                 ':'.$res->randomorder().
+                                 ':'.$res->is_page();
+                    }
+                }
+            }
+            $path =~ s/^\&//;
+            my $maptitle = $mapresobj->title();
+            if ($mapurl eq 'default') {
+                $maptitle = 'Main Course Documents';
+            }
+            $path .= ($path ne '')? '&' : ''.
+                    &Apache::lonhtmlcommon::entity_encode($mapurl).'&'.
+                    &Apache::lonhtmlcommon::entity_encode($maptitle).
+                    ':'.$mapresobj->randompick().
+                    ':'.$mapresobj->randomout().
+                    ':'.$mapresobj->encrypted().
+                    ':'.$mapresobj->randomorder().
+                    ':'.$mapresobj->is_page();
+        } else {
+            my $maptitle = &gettitle($mapurl);
+            my $ispage;
+            if ($mapurl =~ /\.page$/) {
+                $ispage = 1;
+            }
+            if ($mapurl eq 'default') {
+                $maptitle = 'Main Course Documents';
+            }
+            $path = &Apache::lonhtmlcommon::entity_encode($mapurl).'&'.
+                    &Apache::lonhtmlcommon::entity_encode($maptitle).':::::'.$ispage;
+        }
+        unless ($mapurl eq 'default') {
+            $path = 'default&'.
+                    &Apache::lonhtmlcommon::entity_encode('Main Course Documents').
+                    ':::::&'.$path;
+        }
+    }
+    return $path;
+}
+
 sub get_slot {
     my ($which,$cnum,$cdom)=@_;
     if (!$cnum || !$cdom) {
@@ -10409,21 +10537,32 @@ sub symbverify {
 
     if (tie(%bighash,'GDBM_File',$env{'request.course.fn'}.'.db',
                             &GDBM_READER(),0640)) {
+        my $noclutter;
         if (($thisurl =~ m{^/adm/wrapper/ext/}) || ($thisurl =~ m{^ext/})) {
             $thisurl =~ s/\?.+$//;
+            if ($map =~ m{^uploaded/.+\.page$}) {
+                $thisurl =~ s{^(/adm/wrapper|)/ext/}{http://};
+                $thisurl =~ s{^\Qhttp://https://\E}{https://};
+                $noclutter = 1;
+            }
+        }
+        my $ids;
+        if ($noclutter) {
+            $ids=$bighash{'ids_'.$thisurl};
+        } else {
+            $ids=$bighash{'ids_'.&clutter($thisurl)};
         }
-        my $ids=$bighash{'ids_'.&clutter($thisurl)};
         unless ($ids) {
             my $idkey = 'ids_'.($thisurl =~ m{^/}? '' : '/').$thisurl;  
             $ids=$bighash{$idkey};
         }
         if ($ids) {
 # ------------------------------------------------------------------- Has ID(s)
+            if ($thisfn =~ m{^/adm/wrapper/ext/}) {
+                $symb =~ s/\?.+$//;
+            }
 	    foreach my $id (split(/\,/,$ids)) {
 	       my ($mapid,$resid)=split(/\./,$id);
-               if ($thisfn =~ m{^/adm/wrapper/ext/}) {
-                   $symb =~ s/\?.+$//;
-               }
                if (
   &symbclean(&declutter($bighash{'map_id_'.$mapid}).'___'.$resid.'___'.$thisfn)
    eq $symb) {
@@ -10434,6 +10573,7 @@ sub symbverify {
 		       ($bighash{'encrypted_'.$id} eq $env{'request.enc'}) ||
                        ($thisurl eq '/adm/navmaps')) {
 		       $okay=1;
+                       last;
 		   }
 	       }
 	   }
@@ -10509,14 +10649,14 @@ sub deversion {
 
 sub symbread {
     my ($thisfn,$donotrecurse)=@_;
-    my $cache_str='request.symbread.cached.'.$thisfn;
-    if (defined($env{$cache_str})) {
-        if (($thisfn) || ($env{$cache_str} ne '')) {
+    my $cache_str;
+    if ($thisfn ne '') {
+        $cache_str='request.symbread.cached.'.$thisfn;
+        if ($env{$cache_str} ne '') {
             return $env{$cache_str};
         }
-    }
+    } else {
 # no filename provided? try from environment
-    unless ($thisfn) {
         if ($env{'request.symb'}) {
 	    return $env{$cache_str}=&symbclean($env{'request.symb'});
 	}
@@ -11431,12 +11571,12 @@ sub goodbye {
 }
 
 sub get_dns {
-    my ($url,$func,$ignore_cache) = @_;
+    my ($url,$func,$ignore_cache,$nocache,$hashref) = @_;
     if (!$ignore_cache) {
 	my ($content,$cached)=
 	    &Apache::lonnet::is_cached_new('dns',$url);
 	if ($cached) {
-	    &$func($content);
+	    &$func($content,$hashref);
 	    return;
 	}
     }
@@ -11461,8 +11601,10 @@ sub get_dns {
         delete($alldns{$dns});
 	next if ($response->is_error());
 	my @content = split("\n",$response->content);
-	&Apache::lonnet::do_cache_new('dns',$url,\@content,30*24*60*60);
-	&$func(\@content);
+	unless ($nocache) {
+	    &Apache::lonnet::do_cache_new('dns',$url,\@content,30*24*60*60);
+	}
+	&$func(\@content,$hashref);
 	return;
     }
     close($config);
@@ -11470,9 +11612,62 @@ sub get_dns {
     &logthis("unable to contact DNS defaulting to on disk file dns_$which.tab\n");
     open($config,"<$perlvar{'lonTabDir'}/dns_$which.tab");
     my @content = <$config>;
-    &$func(\@content);
+    &$func(\@content,$hashref);
     return;
 }
+
+# ------------------------------------------------------Get DNS checksums file
+sub parse_dns_checksums_tab {
+    my ($lines,$hashref) = @_;
+    my $machine_dom = &Apache::lonnet::host_domain($perlvar{'lonHostID'});
+    my $loncaparev = &get_server_loncaparev($machine_dom);
+    my ($release,$timestamp) = split(/\-/,$loncaparev);
+    my (%chksum,%revnum);
+    if (ref($lines) eq 'ARRAY') {
+        chomp(@{$lines});
+        my $versions = shift(@{$lines});
+        my %supported;
+        if ($versions =~ /^VERSIONS\:([\w\.\,]+)$/) {
+            my $releaseslist = $1;
+            if ($releaseslist =~ /,/) {
+                map { $supported{$_} = 1; } split(/,/,$releaseslist);
+            } elsif ($releaseslist) {
+                $supported{$releaseslist} = 1;
+            }
+        }
+        if ($supported{$release}) {  
+            my $matchthis = 0;
+            foreach my $line (@{$lines}) {
+                if ($line =~ /^(\d[\w\.]+)$/) {
+                    if ($matchthis) {
+                        last;
+                    } elsif ($1 eq $release) {
+                        $matchthis = 1;
+                    }
+                } elsif ($matchthis) {
+                    my ($file,$version,$shasum) = split(/,/,$line);
+                    $chksum{$file} = $shasum;
+                    $revnum{$file} = $version;
+                }
+            }
+            if (ref($hashref) eq 'HASH') {
+                %{$hashref} = (
+                                sums     => \%chksum,
+                                versions => \%revnum,
+                              );
+            }
+        }
+    }
+    return;
+}
+
+sub fetch_dns_checksums {
+    my %checksums; 
+    &get_dns('/adm/dns/checksums',\&parse_dns_checksums_tab,1,1,
+             \%checksums);
+    return \%checksums;
+}
+
 # ------------------------------------------------------------ Read domain file
 {
     my $loaded;
@@ -12010,6 +12205,17 @@ $readit=1;
 	if ($test != 0) { $_64bit=1; } else { $_64bit=0; }
 	&logthis(" Detected 64bit platform ($_64bit)");
     }
+
+    {
+        eval {
+            ($apache) =
+                (Apache2::ServerUtil::get_server_version() =~ m{Apache/(\d+\.\d+)});
+        };
+        if ($@) {
+           $apache = 1.3;
+        }
+    }
+
 }
 }
 
@@ -12445,7 +12651,9 @@ Inputs:
 
 =item B<$context> role change context (shown in User Management Logs display in a course)
 
-=item B<$inststatus> institutional status of user - : separated string of escaped status types  
+=item B<$inststatus> institutional status of user - : separated string of escaped status types
+
+=item B<$credits> Number of credits student will earn from this class - only needs to be supplied if value needs to be different from default credits for class.
 
 =back
 
@@ -12490,6 +12698,8 @@ Inputs:
 
 =item $context
 
+=item $credits, number of credits student will earn from this class
+
 =back