--- loncom/lonnet/perl/lonnet.pm	2012/12/31 14:59:54	1.1172.2.15
+++ loncom/lonnet/perl/lonnet.pm	2013/04/07 17:48:57	1.1172.2.22
@@ -1,7 +1,7 @@
 # The LearningOnline Network
 # TCP networking package
 #
-# $Id: lonnet.pm,v 1.1172.2.15 2012/12/31 14:59:54 raeburn Exp $
+# $Id: lonnet.pm,v 1.1172.2.22 2013/04/07 17:48:57 raeburn Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -75,7 +75,7 @@ use LWP::UserAgent();
 use HTTP::Date;
 use Image::Magick;
 
-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);
 
@@ -97,6 +97,7 @@ use File::MMagic;
 use LONCAPA qw(:DEFAULT :match);
 use LONCAPA::Configuration;
 use LONCAPA::lonmetadata;
+use LONCAPA::Lond;
 
 use File::Copy;
 
@@ -629,6 +630,15 @@ 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;
 }
 
@@ -1995,8 +2005,9 @@ sub get_domain_defaults {
         }
     }
     if (ref($domconfig{'coursedefaults'}) eq 'HASH') {
-        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') {
@@ -3174,7 +3185,9 @@ sub userfileupload {
 					 $codebase,$thumbwidth,$thumbheight,
                                          $resizewidth,$resizeheight,$context,$mimetype);
         } else {
-            $fname=$env{'form.folder'}.'/'.$fname;
+            if ($env{'form.folder'}) {
+                $fname=$env{'form.folder'}.'/'.$fname;
+            }
             return &process_coursefile('uploaddoc',$docuname,$docudom,
 				       $fname,$formname,$parser,
 				       $allfiles,$codebase,$mimetype);
@@ -4120,18 +4133,32 @@ sub courseiddump {
 
 	    if (($domfilter eq '') ||
 		(&host_domain($tryserver) eq $domfilter)) {
-                my $rep = 
-                  &reply('courseiddump:'.&host_domain($tryserver).':'.
-                         $sincefilter.':'.&escape($descfilter).':'.
-                         &escape($instcodefilter).':'.&escape($ownerfilter).
-                         ':'.&escape($coursefilter).':'.&escape($typefilter).
-                         ':'.&escape($regexp_ok).':'.$as_hash.':'.
-                         &escape($selfenrollonly).':'.&escape($catfilter).':'.
-                         $showhidden.':'.$caller.':'.&escape($cloner).':'.
-                         &escape($cc_clone).':'.$cloneonly.':'.
-                         &escape($createdbefore).':'.&escape($createdafter).':'.
-                         &escape($creationcontext).':'.$domcloner,
-                         $tryserver);
+                my $rep;
+                if (grep { $_ eq $tryserver } &current_machine_ids()) {
+                    $rep = &LONCAPA::Lond::dump_course_id_handler(
+                        join(":", (&host_domain($tryserver), $sincefilter,
+                                &escape($descfilter), &escape($instcodefilter),
+                                &escape($ownerfilter), &escape($coursefilter),
+                                &escape($typefilter), &escape($regexp_ok),
+                                $as_hash, &escape($selfenrollonly),
+                                &escape($catfilter), $showhidden, $caller,
+                                &escape($cloner), &escape($cc_clone), $cloneonly,
+                                &escape($createdbefore), &escape($createdafter),
+                                &escape($creationcontext), $domcloner)));
+                } else {
+                    $rep = &reply('courseiddump:'.&host_domain($tryserver).':'.
+                             $sincefilter.':'.&escape($descfilter).':'.
+                             &escape($instcodefilter).':'.&escape($ownerfilter).
+                             ':'.&escape($coursefilter).':'.&escape($typefilter).
+                             ':'.&escape($regexp_ok).':'.$as_hash.':'.
+                             &escape($selfenrollonly).':'.&escape($catfilter).':'.
+                             $showhidden.':'.$caller.':'.&escape($cloner).':'.
+                             &escape($cc_clone).':'.$cloneonly.':'.
+                             &escape($createdbefore).':'.&escape($createdafter).':'.
+                             &escape($creationcontext).':'.$domcloner,
+                             $tryserver);
+                }
+
                 my @pairs=split(/\&/,$rep);
                 foreach my $item (@pairs) {
                     my ($key,$value)=split(/\=/,$item,2);
@@ -5041,9 +5068,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);
 }
 
@@ -5312,7 +5341,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);
@@ -5375,12 +5404,36 @@ sub del {
 
 # -------------------------------------------------------------- dump interface
 
+sub unserialize {
+    my ($rep, $escapedkeys) = @_;
+
+    return {} if $rep =~ /^error/;
+
+    my %returnhash=();
+    foreach my $item (split(/\&/,$rep)) {
+        my ($key, $value) = split(/=/, $item, 2);
+        $key = unescape($key) unless $escapedkeys;
+        next if $key =~ /^error: 2 /;
+        $returnhash{$key} = &thaw_unescape($value);
+    }
+    return \%returnhash;
+}
+
+# see Lond::dump_with_regexp
+# if $escapedkeys hash keys won't get unescaped.
 sub dump {
-    my ($namespace,$udomain,$uname,$regexp,$range)=@_;
+    my ($namespace,$udomain,$uname,$regexp,$range,$escapedkeys)=@_;
     if (!$udomain) { $udomain=$env{'user.domain'}; }
     if (!$uname) { $uname=$env{'user.name'}; }
     my $uhome=&homeserver($uname,$udomain);
 
+    my $reply;
+    if (grep { $_ eq $uhome } &current_machine_ids()) {
+        # user is hosted on this machine
+        $reply = LONCAPA::Lond::dump_with_regexp(join(':', ($udomain,
+                    $uname, $namespace, $regexp, $range)), $loncaparevs{$uhome});
+        return %{&unserialize($reply, $escapedkeys)};
+    }
     if ($regexp) {
 	$regexp=&escape($regexp);
     } else {
@@ -5392,7 +5445,7 @@ sub dump {
     if (!($rep =~ /^error/ )) {
 	foreach my $item (@pairs) {
 	    my ($key,$value)=split(/=/,$item,2);
-	    $key = &unescape($key);
+            $key = &unescape($key) unless ($escapedkeys);
 	    next if ($key =~ /^error: 2 /);
 	    $returnhash{$key}=&thaw_unescape($value);
 	}
@@ -5405,23 +5458,9 @@ sub dump {
 
 sub dumpstore {
    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",$uhome);
-   my @pairs=split(/\&/,$rep);
-   my %returnhash=();
-   foreach my $item (@pairs) {
-       my ($key,$value)=split(/=/,$item,2);
-       next if ($key =~ /^error: 2 /);
-       $returnhash{$key}=&thaw_unescape($value);
-   }
-   return %returnhash;
+   # same as dump but keys must be escaped. They may contain colon separated
+   # lists of values that may themself contain colons (e.g. symbs).
+   return &dump($namespace, $udomain, $uname, $regexp, $range, 1);
 }
 
 # -------------------------------------------------------------- keys interface
@@ -6851,7 +6890,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; }
@@ -7390,8 +7429,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 {
@@ -8331,7 +8370,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';
@@ -8346,12 +8385,13 @@ 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'}) {
@@ -8398,7 +8438,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);
@@ -9883,7 +9923,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;
     }
@@ -11513,12 +11553,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;
 	}
     }
@@ -11543,8 +11583,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);
@@ -11552,9 +11594,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;
@@ -12092,6 +12187,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;
+        }
+    }
+
 }
 }
 
@@ -12527,7 +12633,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
 
@@ -12572,6 +12680,8 @@ Inputs:
 
 =item $context
 
+=item $credits, number of credits student will earn from this class
+
 =back
 
 
@@ -12737,7 +12847,7 @@ returns the data handle
 
 =item *
 
-symbverify($symb,$thisfn,$ecstate) : verifies that $symb actually exists
+symbverify($symb,$thisfn,$encstate) : 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 existence of