--- loncom/lonnet/perl/lonnet.pm 2003/12/05 00:28:32 1.454 +++ loncom/lonnet/perl/lonnet.pm 2003/12/12 00:20:08 1.459 @@ -1,7 +1,7 @@ # The LearningOnline Network # TCP networking package # -# $Id: lonnet.pm,v 1.454 2003/12/05 00:28:32 albertel Exp $ +# $Id: lonnet.pm,v 1.459 2003/12/12 00:20:08 albertel 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'; @@ -3144,10 +3130,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 +3144,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 +3184,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 +3195,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; } @@ -3708,12 +3703,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("WARNING:". " Trying to get resource data for ". $uname." at ".$udom.": ". $tmp.""); - } elsif ($tmp=~/error:No such file/) { + } elsif ($tmp=~/error: 2 /) { &EXT_cache_set($udom,$uname); } elsif ($tmp =~ /^(con_lost|no_such_host)/) { return $tmp;