--- loncom/lonnet/perl/lonnet.pm	2003/12/04 21:00:23	1.453
+++ loncom/lonnet/perl/lonnet.pm	2004/01/13 16:29:41	1.461
@@ -1,7 +1,7 @@
 # The LearningOnline Network
 # TCP networking package
 #
-# $Id: lonnet.pm,v 1.453 2003/12/04 21:00:23 albertel Exp $
+# $Id: lonnet.pm,v 1.461 2004/01/13 16:29:41 www Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -506,38 +506,16 @@ sub changepass {
 
 sub queryauthenticate {
     my ($uname,$udom)=@_;
-    if (($perlvar{'lonRole'} eq 'library') && 
-        ($udom eq $perlvar{'lonDefDomain'})) {
-	my $answer=reply("encrypt:currentauth:$udom:$uname",
-			 $perlvar{'lonHostID'});
-	unless ($answer eq 'unknown_user' or $answer eq 'refused') {
-	    if (length($answer)) {
-		return $answer;
-	    }
-	    else {
-	&logthis("User $uname at $udom lacks an authentication mechanism");
-		return 'no_host';
-	    }
-	}
-    }
-
-    my $tryserver;
-    foreach $tryserver (keys %libserv) {
-	if ($hostdom{$tryserver} eq $udom) {
-           my $answer=reply("encrypt:currentauth:$udom:$uname",$tryserver);
-	   unless ($answer eq 'unknown_user' or $answer eq 'refused') {
-	       if (length($answer)) {
-		   return $answer;
-	       }
-	       else {
-	   &logthis("User $uname at $udom lacks an authentication mechanism");
-		   return 'no_host';
-	       }
-	   }
-       }
+    my $uhome=&homeserver($uname,$udom);
+    if (!$uhome) {
+	&logthis("User $uname at $udom is unknown when looking for authentication mechanism");
+	return 'no_host';
+    }
+    my $answer=reply("encrypt:currentauth:$udom:$uname",$uhome);
+    if ($answer =~ /^(unknown_user|refused|con_lost)/) {
+	&logthis("User $uname at $udom threw error $answer when checking authentication mechanism");
     }
-    &logthis("User $uname at $udom lacks an authentication mechanism");    
-    return 'no_host';
+    return $answer;
 }
 
 # --------- Try to authenticate user from domain's lib servers (first this one)
@@ -1341,8 +1319,15 @@ sub flushcourselogs {
 # Writes to the dynamic metadata of resources to get hit counts, etc.
 #
     foreach my $entry (keys(%accesshash)) {
-        my ($dom,$name,undef,$type)=($entry=~m:___(\w+)/(\w+)/(.*)___(\w+)$:);
-        if ($type eq 'count'){
+        if ($entry =~ /___count$/) {
+            my ($dom,$name);
+            ($dom,$name,undef)=($entry=~m:___(\w+)/(\w+)/(.*)___count$:);
+            if (! defined($dom) || $dom eq '' || 
+                ! defined($name) || $name eq '') {
+                my $cid = $ENV{'request.course.id'};
+                $dom  = $ENV{'request.'.$cid.'.domain'};
+                $name = $ENV{'request.'.$cid.'.num'};
+            }
             my $value = $accesshash{$entry};
             my (undef,$url,undef) = ($entry =~ /^(.*)___(.*)___count$/);
             my %temphash=($url => $value);
@@ -1357,6 +1342,7 @@ sub flushcourselogs {
                 }
             }
         } else {
+            my ($dom,$name) = ($entry=~m:___(\w+)/(\w+)/(.*)___(\w+)$:);
             my %temphash=($entry => $accesshash{$entry});
             if (&put('nohist_resevaldata',\%temphash,$dom,$name) eq 'ok') {
                 delete $accesshash{$entry};
@@ -1397,8 +1383,7 @@ sub courselog {
     } else {
 	$courselogs{$ENV{'request.course.id'}}.=$what;
     }
-#    if (length($courselogs{$ENV{'request.course.id'}})>4048) {
-    if (length($courselogs{$ENV{'request.course.id'}})>48) {
+    if (length($courselogs{$ENV{'request.course.id'}})>4048) {
 	&flushcourselogs();
     }
 }
@@ -1420,6 +1405,7 @@ sub courseacclog {
 
 sub countacc {
     my $url=&declutter(shift);
+    return if (! defined($url) || $url eq '');
     unless ($ENV{'request.course.id'}) { return ''; }
     $accesshash{$ENV{'request.course.id'}.'___'.$url.'___course'}=1;
     my $key=$$.$processmarker.'_'.$dumpcount.'___'.$url.'___count';
@@ -2141,6 +2127,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 {
@@ -3144,10 +3160,11 @@ sub modifyuser {
 
 sub modifystudent {
     my ($udom,$uname,$uid,$umode,$upass,$first,$middle,$last,$gene,$usec,
-        $end,$start,$forceid,$desiredhome,$email)=@_;
-    my $cid='';
-    unless ($cid=$ENV{'request.course.id'}) {
-	return 'not_in_class';
+        $end,$start,$forceid,$desiredhome,$email,$type,$cid)=@_;
+    if (!$cid) {
+	unless ($cid=$ENV{'request.course.id'}) {
+	    return 'not_in_class';
+	}
     }
 # --------------------------------------------------------------- Make the user
     my $reply=&modifyuser
@@ -3157,24 +3174,34 @@ sub modifystudent {
     # This will cause &modify_student_enrollment to get the uid from the
     # students environment
     $uid = undef if (!$forceid);
-    $reply = &modify_student_enrollment($udom,$uname,$uid,$first,$middle,
-                                        $last,$gene,$usec,$end,$start);
+    $reply = &modify_student_enrollment($udom,$uname,$uid,$first,$middle,$last,
+					$gene,$usec,$end,$start,$type,$cid);
     return $reply;
 }
 
 sub modify_student_enrollment {
-    my ($udom,$uname,$uid,$first,$middle,$last,$gene,$usec,$end,$start) = @_;
-    # Get the course id from the environment
-    my $cid='';
-    unless ($cid=$ENV{'request.course.id'}) {
-	return 'not_in_class';
+    my ($udom,$uname,$uid,$first,$middle,$last,$gene,$usec,$end,$start,$type,
+	$cid) = @_;
+    my ($cdom,$cnum,$chome);
+    if (!$cid) {
+	unless ($cid=$ENV{'request.course.id'}) {
+	    return 'not_in_class';
+	}
+	$cdom=$ENV{'course.'.$cid.'.domain'};
+	$cnum=$ENV{'course.'.$cid.'.num'};
+    } else {
+	($cdom,$cnum)=split(/_/,$cid);
     }
+    $chome=$ENV{'course.'.$cid.'.home'};
+    if (!$chome) {
+	$chome=&homeserver($cnum,$cdom);
+    }
+    if (!$chome) { return 'unknown_course'; }
     # Make sure the user exists
     my $uhome=&homeserver($uname,$udom);
     if (($uhome eq '') || ($uhome eq 'no_host')) { 
 	return 'error: no such user';
     }
-    #
     # Get student data if we were not given enough information
     if (!defined($first)  || $first  eq '' || 
         !defined($last)   || $last   eq '' || 
@@ -3187,9 +3214,9 @@ sub modify_student_enrollment {
                        ['firstname','middlename','lastname', 'generation','id']
                        ,$udom,$uname);
 
-        foreach (keys(%tmp)) {
-            &logthis("key $_ = ".$tmp{$_});
-        }
+        #foreach (keys(%tmp)) {
+        #    &logthis("key $_ = ".$tmp{$_});
+        #}
         $first  = $tmp{'firstname'}  if (!defined($first)  || $first  eq '');
         $middle = $tmp{'middlename'} if (!defined($middle) || $middle eq '');
         $last   = $tmp{'lastname'}   if (!defined($last)   || $last eq '');
@@ -3198,11 +3225,9 @@ sub modify_student_enrollment {
     }
     my $fullname = &Apache::loncoursedata::ProcessFullName($last,$gene,
                                                            $first,$middle);
-    my $reply=critical('put:'.$ENV{'course.'.$cid.'.domain'}.':'.
-	              $ENV{'course.'.$cid.'.num'}.':classlist:'.
-                      &escape($uname.':'.$udom).'='.
-                      &escape(join(':',$end,$start,$uid,$usec,$fullname)),
-	              $ENV{'course.'.$cid.'.home'});
+    my $value=&escape($uname.':'.$udom).'='.
+	&escape(join(':',$end,$start,$uid,$usec,$fullname,$type));
+    my $reply=critical('put:'.$cdom.':'.$cnum.':classlist:'.$value,$chome);
     unless (($reply eq 'ok') || ($reply eq 'delayed')) {
 	return 'error: '.$reply;
     }
@@ -3694,10 +3719,8 @@ sub EXT {
 		my $hashid="$udom:$uname";
 		my ($result,$cached)=&is_cached(\%userresdatacache,$hashid,
 						'userres');
-		if (!defined($cached)) { 
-		    my %resourcedata=&get('resourcedata',
-					  [$courselevelr,$courselevelm,
-					   $courselevel],$udom,$uname);
+		if (!defined($cached)) {
+		    my %resourcedata=&dump('resourcedata',$udom,$uname);
 		    $result=\%resourcedata;
 		    &do_cache(\%userresdatacache,$hashid,$result,'userres');
 		}
@@ -3710,12 +3733,13 @@ sub EXT {
 		    if ($$result{$courselevel}) {
 			return $$result{$courselevel}; }
 		} else {
-		    if ($tmp!~/No such file/) {
+		    #error 2 occurs when the .db doesn't exist
+		    if ($tmp!~/error: 2 /) {
 			&logthis("<font color=blue>WARNING:".
 				 " Trying to get resource data for ".
 				 $uname." at ".$udom.": ".
 				 $tmp."</font>");
-		    } elsif ($tmp=~/error:No such file/) {
+		    } elsif ($tmp=~/error: 2 /) {
                         &EXT_cache_set($udom,$uname);
 		    } elsif ($tmp =~ /^(con_lost|no_such_host)/) {
 			return $tmp;
@@ -4447,13 +4471,15 @@ 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;
     }
 }