--- loncom/lonnet/perl/lonnet.pm 2008/03/12 02:46:27 1.949 +++ loncom/lonnet/perl/lonnet.pm 2008/03/24 05:23:19 1.952 @@ -1,7 +1,7 @@ # The LearningOnline Network # TCP networking package # -# $Id: lonnet.pm,v 1.949 2008/03/12 02:46:27 raeburn Exp $ +# $Id: lonnet.pm,v 1.952 2008/03/24 05:23:19 raeburn Exp $ # # Copyright Michigan State University Board of Trustees # @@ -705,24 +705,38 @@ sub queryauthenticate { # --------- Try to authenticate user from domain's lib servers (first this one) sub authenticate { - my ($uname,$upass,$udom)=@_; + my ($uname,$upass,$udom,$checkdefauth)=@_; $upass=&escape($upass); $uname= &LONCAPA::clean_username($uname); my $uhome=&homeserver($uname,$udom,1); + my $newhome; if ((!$uhome) || ($uhome eq 'no_host')) { # Maybe the machine was offline and only re-appeared again recently? &reconlonc(); # One more - my $uhome=&homeserver($uname,$udom,1); + $uhome=&homeserver($uname,$udom,1); + if (($uhome eq 'no_host') && $checkdefauth) { + if (defined(&domain($udom,'primary'))) { + $newhome=&domain($udom,'primary'); + } + if ($newhome ne '') { + $uhome = $newhome; + } + } if ((!$uhome) || ($uhome eq 'no_host')) { &logthis("User $uname at $udom is unknown in authenticate"); - } - return 'no_host'; + return 'no_host'; + } } - my $answer=reply("encrypt:auth:$udom:$uname:$upass",$uhome); + my $answer=reply("encrypt:auth:$udom:$uname:$upass:$checkdefauth",$uhome); if ($answer eq 'authorized') { - &logthis("User $uname at $udom authorized by $uhome"); - return $uhome; + if ($newhome) { + &logthis("User $uname at $udom authorized by $uhome, but needs account"); + return 'no_account_on_host'; + } else { + &logthis("User $uname at $udom authorized by $uhome"); + return $uhome; + } } if ($answer eq 'non_authorized') { &logthis("User $uname at $udom rejected by $uhome"); @@ -1705,19 +1719,13 @@ sub absolute_url { # form Hash that describes how the rendering should be done # and other things. # Returns: -# Scalar context: The content of the reply. -# Array context: 2 element list of the content and the full response variable. +# Scalar context: The content of the response. +# Array context: 2 element list of the content and the full response object. # -# Returns: -# The content of the response. sub ssi { my ($fn,%form)=@_; - my $count = scalar(@_); - - my $ua=new LWP::UserAgent; - my $request; $form{'no_update_last_known'}=1; @@ -1731,7 +1739,6 @@ sub ssi { $request->header(Cookie => $ENV{'HTTP_COOKIE'}); my $response=$ua->request($request); - my $status = $response->code; if (wantarray) { return ($response->content, $response); @@ -3969,6 +3976,7 @@ sub tmpget { my %returnhash; foreach my $item (split(/\&/,$rep)) { my ($key,$value)=split(/=/,$item); + next if ($key =~ /^error: 2 /); $returnhash{&unescape($key)}=&thaw_unescape($value); } return %returnhash;