--- loncom/lonnet/perl/lonnet.pm	2004/02/10 19:23:11	1.459.2.3
+++ loncom/lonnet/perl/lonnet.pm	2004/02/24 16:26:06	1.473
@@ -1,7 +1,7 @@
 # The LearningOnline Network
 # TCP networking package
 #
-# $Id: lonnet.pm,v 1.459.2.3 2004/02/10 19:23:11 albertel Exp $
+# $Id: lonnet.pm,v 1.473 2004/02/24 16:26:06 matthew Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -377,7 +377,12 @@ sub delenv {
 	    return 'error: '.$!;
 	}
 	foreach (@oldenv) {
-	    unless ($_=~/^$delthis/) { print $fh $_; }
+	    if ($_=~/^$delthis/) { 
+                my ($key,undef) = split('=',$_);
+                delete($ENV{$key});
+            } else {
+                print $fh $_; 
+            }
 	}
 	close($fh);
     }
@@ -524,38 +529,21 @@ sub authenticate {
     my ($uname,$upass,$udom)=@_;
     $upass=escape($upass);
     $uname=~s/\W//g;
-    if (($perlvar{'lonRole'} eq 'library') && 
-        ($udom eq $perlvar{'lonDefDomain'})) {
-    my $answer=reply("encrypt:auth:$udom:$uname:$upass",$perlvar{'lonHostID'});
-        if ($answer =~ /authorized/) {
-              if ($answer eq 'authorized') {
-                 &logthis("User $uname at $udom authorized by local server"); 
-                 return $perlvar{'lonHostID'}; 
-              }
-              if ($answer eq 'non_authorized') {
-                 &logthis("User $uname at $udom rejected by local server"); 
-                 return 'no_host'; 
-              }
-	}
+    my $uhome=&homeserver($uname,$udom);
+    if (!$uhome) {
+	&logthis("User $uname at $udom is unknown in authenticate");
+	return 'no_host';
     }
-
-    my $tryserver;
-    foreach $tryserver (keys %libserv) {
-	if ($hostdom{$tryserver} eq $udom) {
-           my $answer=reply("encrypt:auth:$udom:$uname:$upass",$tryserver);
-           if ($answer =~ /authorized/) {
-              if ($answer eq 'authorized') {
-                 &logthis("User $uname at $udom authorized by $tryserver"); 
-                 return $tryserver; 
-              }
-              if ($answer eq 'non_authorized') {
-                 &logthis("User $uname at $udom rejected by $tryserver");
-                 return 'no_host';
-              } 
-	   }
-       }
+    my $answer=reply("encrypt:auth:$udom:$uname:$upass",$uhome);
+    if ($answer eq 'authorized') {
+	&logthis("User $uname at $udom authorized by $uhome"); 
+	return $uhome; 
+    }
+    if ($answer eq 'non_authorized') {
+	&logthis("User $uname at $udom rejected by $uhome");
+	return 'no_host'; 
     }
-    &logthis("User $uname at $udom could not be authenticated");    
+    &logthis("User $uname at $udom threw error $answer when checking authentication mechanism");
     return 'no_host';
 }
 
@@ -1249,8 +1237,8 @@ sub finishuserfileupload {
 # Notify homeserver to grep it
 #
     
-    my $fetchresult= 
- &reply('fetchuserfile:'.$docudom.'/'.$docuname.'/'.$fname,$docuhome);
+    my $fetchresult= &reply('fetchuserfile:'.$docudom.'/'.$docuname.'/'.$fname,
+			    $docuhome);
     if ($fetchresult eq 'ok') {
 #
 # Return the URL to it
@@ -1424,7 +1412,7 @@ sub userrolelog {
     my ($trole,$username,$domain,$area,$tstart,$tend)=@_;
     if (($trole=~/^ca/) || ($trole=~/^in/) || 
         ($trole=~/^cc/) || ($trole=~/^ep/) ||
-        ($trole=~/^cr/)) {
+        ($trole=~/^cr/) || ($trole=~/^ta/)) {
        my (undef,$rudom,$runame,$rsec)=split(/\//,$area);
        $userrolehash
          {$trole.':'.$username.':'.$domain.':'.$runame.':'.$rudom.':'.$rsec}
@@ -1436,6 +1424,10 @@ sub get_course_adv_roles {
     my $cid=shift;
     $cid=$ENV{'request.course.id'} unless (defined($cid));
     my %coursehash=&coursedescription($cid);
+    my %nothide=();
+    foreach (split(/\s*\,\s*/,$coursehash{'nothideprivileged'})) {
+	$nothide{join(':',split(/[\@\:]/,$_))}=1;
+    }
     my %returnhash=();
     my %dumphash=
             &dump('nohist_userroles',$coursehash{'domain'},$coursehash{'num'});
@@ -1446,6 +1438,8 @@ sub get_course_adv_roles {
         if (($tend) && ($tend<$now)) { next; }
         if (($tstart) && ($now<$tstart)) { next; }
         my ($role,$username,$domain,$section)=split(/\:/,$_);
+	if ((&privileged($username,$domain)) && 
+	    (!$nothide{$username.':'.$domain})) { next; }
         my $key=&plaintext($role);
         if ($section) { $key.=' (Sec/Grp '.$section.')'; }
         if ($returnhash{$key}) {
@@ -2127,6 +2121,36 @@ sub coursedescription {
     return %returnhash;
 }
 
+# -------------------------------------------------See if a user is privileged
+
+sub privileged {
+    my ($username,$domain)=@_;
+    my $rolesdump=&reply("dump:$domain:$username:roles",
+			&homeserver($username,$domain));
+    if (($rolesdump eq 'con_lost') || ($rolesdump eq '')) { return 0; }
+    my $now=time;
+    if ($rolesdump ne '') {
+        foreach (split(/&/,$rolesdump)) {
+	    if ($_!~/^rolesdef\&/) {
+		my ($area,$role)=split(/=/,$_);
+		$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; }
+		}
+	    }
+	}
+    }
+    return 0;
+}
+
 # -------------------------------------------------------- Get user privileges
 
 sub rolesinit {
@@ -3791,10 +3815,11 @@ sub packages_tab_default {
     my $packages=&metadata($uri,'packages');
     foreach my $package (split(/,/,$packages)) {
 	my ($pack_type,$pack_part)=split(/_/,$package,2);
-	if ($pack_part eq $part) {
-	    if (defined($packagetab{"$pack_type&$name&default"})) {
-		return $packagetab{"$pack_type&$name&default"};
-	    }
+	if (defined($packagetab{"$pack_type&$name&default"})) {
+	    return $packagetab{"$pack_type&$name&default"};
+	}
+	if (defined($packagetab{$pack_type."_".$pack_part."&$name&default"})) {
+	    return $packagetab{$pack_type."_".$pack_part."&$name&default"};
 	}
     }
     return undef;
@@ -3824,8 +3849,8 @@ sub metadata {
     # if it is a non metadata possible uri return quickly
     if (($uri eq '') || (($uri =~ m|^/*adm/|) && ($uri !~ m|^adm/includes|)) ||
         ($uri =~ m|/$|) || ($uri =~ m|/.meta$|) || ($uri =~ /^~/) ||
-	($uri =~ m|home/[^/]+/public_html/|)) {
-	return '';
+	($uri =~ m|home/[^/]+/public_html/|) || ($uri =~ m|^uploaded/|)) {
+	return undef;
     }
     my $filename=$uri;
     $uri=~s/\.meta$//;
@@ -4395,27 +4420,39 @@ sub receipt {
 }
 
 # ------------------------------------------------------------ Serves up a file
-# returns either the contents of the file or a -1
+# returns either the contents of the file or 
+# -1 if the file doesn't exist
+# -2 if an error occured when trying to aqcuire the file
+
 sub getfile {
- my $file=shift;
- if ($file=~/^\/*uploaded\//) { # user file
-    my $ua=new LWP::UserAgent;
-    my $request=new HTTP::Request('GET',&tokenwrapper($file));
-    my $response=$ua->request($request);
-    if ($response->is_success()) {
-       return $response->content;
-    } else { 
-       return -1; 
-    }
- } else { # normal file from res space
-  &repcopy($file);
-  if (! -e $file ) { return -1; };
-  my $fh;
-  open($fh,"<$file");
-  my $a='';
-  while (<$fh>) { $a .=$_; }
-  return $a;
- }
+    my $file=shift;
+    if ($file=~/^\/*uploaded\//) { # user file
+	my $ua=new LWP::UserAgent;
+	my $request=new HTTP::Request('GET',&tokenwrapper($file));
+	my $response=$ua->request($request);
+	if ($response->is_success()) {
+	    return $response->content;
+	} else { 
+	    #&logthis("Return Code is ".$response->code." for $file ".
+	    #         &tokenwrapper($file));
+	    # 500 for ISE when tokenwrapper can't figure out what server to
+            #  contact
+            # 503 when lonuploadacc can't contact the requested server
+	    if ($response->code eq 503 || $response->code eq 500) {
+		return -2;
+	    } else {
+		return -1;
+	    }
+	}
+    } else { # normal file from res space
+	&repcopy($file);
+	if (! -e $file ) { return -1; };
+	my $fh;
+	open($fh,"<$file");
+	my $a='';
+	while (<$fh>) { $a .=$_; }
+	return $a;
+    }
 }
 
 sub filelocation {
@@ -4443,22 +4480,24 @@ sub filelocation {
 
 sub hreflocation {
     my ($dir,$file)=@_;
-    unless (($file=~/^http:\/\//i) || ($file=~/^\//)) {
-       my $finalpath=filelocation($dir,$file);
-       $finalpath=~s/^\/home\/httpd\/html//;
-       $finalpath=~s-/home/(\w+)/public_html/-/~$1/-;
-       return $finalpath;
-    } else {
-       return $file;
+    unless (($file=~m-^http://-i) || ($file=~m-^/-)) {
+	my $finalpath=filelocation($dir,$file);
+	$finalpath=~s-^/home/httpd/html--;
+	$finalpath=~s-^/home/(\w+)/public_html/-/~$1/-;
+	return $finalpath;
+    } elsif ($file=~m-^/home-) {
+	$file=~s-^/home/httpd/html--;
+	$file=~s-^/home/(\w+)/public_html/-/~$1/-;
+	return $file;
     }
+    return $file;
 }
 
-
 sub current_machine_domains {
     my $hostname=$hostname{$perlvar{'lonHostID'}};
     my @domains;
     while( my($id, $name) = each(%hostname)) {
-	&logthis("-$id-$name-$hostname-");
+#	&logthis("-$id-$name-$hostname-");
 	if ($hostname eq $name) {
 	    push(@domains,$hostdom{$id});
 	}
@@ -4470,14 +4509,14 @@ sub current_machine_ids {
     my $hostname=$hostname{$perlvar{'lonHostID'}};
     my @ids;
     while( my($id, $name) = each(%hostname)) {
-	&logthis("-$id-$name-$hostname-");
+#	&logthis("-$id-$name-$hostname-");
 	if ($hostname eq $name) {
 	    push(@ids,$id);
 	}
     }
     return @ids;
 }
-  
+
 # ------------------------------------------------------------- Declutters URLs
 
 sub declutter {