--- loncom/lonnet/perl/lonnet.pm	2013/01/03 19:58:32	1.1209
+++ loncom/lonnet/perl/lonnet.pm	2013/02/14 16:52:11	1.1215
@@ -1,7 +1,7 @@
 # The LearningOnline Network
 # TCP networking package
 #
-# $Id: lonnet.pm,v 1.1209 2013/01/03 19:58:32 raeburn Exp $
+# $Id: lonnet.pm,v 1.1215 2013/02/14 16:52:11 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;
 }
 
@@ -5063,9 +5070,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);
 }
 
@@ -5334,7 +5343,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);
@@ -11556,12 +11565,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;
 	}
     }
@@ -11586,8 +11595,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);
@@ -11595,9 +11606,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;
@@ -12135,6 +12199,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;
+        }
+    }
+
 }
 }