[BACK]Return to lonnet.pm CVS log [TXT] [DIR] Up to [LON-CAPA] / loncom / lonnet / perl

Diff for /loncom/lonnet/perl/lonnet.pm between versions 1.834 and 1.836

version 1.834, 2007/02/18 01:52:20 version 1.836, 2007/02/23 15:49:23
Line 201  sub reply { Line 201  sub reply {
 # ----------------------------------------------------------- Send USR1 to lonc  # ----------------------------------------------------------- Send USR1 to lonc
   
 sub reconlonc {  sub reconlonc {
     my $peerfile=shift;      &logthis("Trying to reconnect lonc");
     &logthis("Trying to reconnect for $peerfile");  
     my $loncfile="$perlvar{'lonDaemons'}/logs/lonc.pid";      my $loncfile="$perlvar{'lonDaemons'}/logs/lonc.pid";
     if (open(my $fh,"<$loncfile")) {      if (open(my $fh,"<$loncfile")) {
  my $loncpid=<$fh>;   my $loncpid=<$fh>;
Line 211  sub reconlonc { Line 210  sub reconlonc {
     &logthis("lonc at pid $loncpid responding, sending USR1");      &logthis("lonc at pid $loncpid responding, sending USR1");
             kill USR1 => $loncpid;              kill USR1 => $loncpid;
             sleep 1;              sleep 1;
             if (-e "$peerfile") { return; }           } else {
             &logthis("$peerfile still not there, give it another try");  
             sleep 5;  
             if (-e "$peerfile") { return; }  
             &logthis(  
   "<font color=\"blue\">WARNING: $peerfile still not there, giving up</font>");  
         } else {  
     &logthis(      &logthis(
                "<font color=\"blue\">WARNING:".                 "<font color=\"blue\">WARNING:".
                " lonc at pid $loncpid not responding, giving up</font>");                 " lonc at pid $loncpid not responding, giving up</font>");
         }          }
     } else {      } else {
      &logthis('<font color="blue">WARNING: lonc not running, giving up</font>');   &logthis('<font color="blue">WARNING: lonc not running, giving up</font>');
     }      }
 }  }
   
Line 615  sub authenticate { Line 608  sub authenticate {
     my ($uname,$upass,$udom)=@_;      my ($uname,$upass,$udom)=@_;
     $upass=&escape($upass);      $upass=&escape($upass);
     $uname= &LONCAPA::clean_username($uname);      $uname= &LONCAPA::clean_username($uname);
     my $uhome=&homeserver($uname,$udom);      my $uhome=&homeserver($uname,$udom,1);
     if (!$uhome) {      if ((!$uhome) || ($uhome eq 'no_host')) {
  &logthis("User $uname at $udom is unknown in authenticate");  # Maybe the machine was offline and only re-appeared again recently?
           &reconlonc();
   # One more
    my $uhome=&homeserver($uname,$udom,1);
    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",$uhome);
Line 647  sub homeserver { Line 646  sub homeserver {
  exists($badServerCache{$tryserver}));   exists($badServerCache{$tryserver}));
  if ($hostdom{$tryserver} eq $udom) {   if ($hostdom{$tryserver} eq $udom) {
            my $answer=reply("home:$udom:$uname",$tryserver);             my $answer=reply("home:$udom:$uname",$tryserver);
            if ($answer eq 'found') {              if ($answer eq 'found') {
                  delete($badServerCache{$tryserver}); 
        return $homecache{$index}=$tryserver;         return $homecache{$index}=$tryserver;
            } elsif ($answer eq 'no_host') {             } elsif ($answer eq 'no_host') {
        $badServerCache{$tryserver}=1;         $badServerCache{$tryserver}=1;
Line 7085  sub setup_random_from_rndseed { Line 7085  sub setup_random_from_rndseed {
 }  }
   
 sub latest_receipt_algorithm_id {  sub latest_receipt_algorithm_id {
     return 'receipt2';      return 'receipt3';
 }  }
   
 sub recunique {  sub recunique {
     my $fucourseid=shift;      my $fucourseid=shift;
     my $unique;      my $unique;
     if ($env{"course.$fucourseid.receiptalg"} eq 'receipt2') {      if ($env{"course.$fucourseid.receiptalg"} eq 'receipt2' ||
    $env{"course.$fucourseid.receiptalg"} eq 'receipt3' ) {
  $unique=$env{"course.$fucourseid.internal.encseed"};   $unique=$env{"course.$fucourseid.internal.encseed"};
     } else {      } else {
  $unique=$perlvar{'lonReceipt'};   $unique=$perlvar{'lonReceipt'};
Line 7102  sub recunique { Line 7103  sub recunique {
 sub recprefix {  sub recprefix {
     my $fucourseid=shift;      my $fucourseid=shift;
     my $prefix;      my $prefix;
     if ($env{"course.$fucourseid.receiptalg"} eq 'receipt2') {      if ($env{"course.$fucourseid.receiptalg"} eq 'receipt2'||
    $env{"course.$fucourseid.receiptalg"} eq 'receipt3' ) {
  $prefix=$env{"course.$fucourseid.internal.encpref"};   $prefix=$env{"course.$fucourseid.internal.encpref"};
     } else {      } else {
  $prefix=$perlvar{'lonHostID'};   $prefix=$perlvar{'lonHostID'};
Line 7112  sub recprefix { Line 7114  sub recprefix {
   
 sub ireceipt {  sub ireceipt {
     my ($funame,$fudom,$fucourseid,$fusymb,$part)=@_;      my ($funame,$fudom,$fucourseid,$fusymb,$part)=@_;
   
       my $return =&recprefix($fucourseid).'-';
   
       if ($env{"course.$fucourseid.receiptalg"} eq 'receipt3' ||
    $env{'request.state'} eq 'construct') {
    $return .= (&digest("$funame,$fudom,$fucourseid,$fusymb,$part")%10000);
    return $return;
       }
   
     my $cuname=unpack("%32C*",$funame);      my $cuname=unpack("%32C*",$funame);
     my $cudom=unpack("%32C*",$fudom);      my $cudom=unpack("%32C*",$fudom);
     my $cucourseid=unpack("%32C*",$fucourseid);      my $cucourseid=unpack("%32C*",$fucourseid);
     my $cusymb=unpack("%32C*",$fusymb);      my $cusymb=unpack("%32C*",$fusymb);
     my $cunique=&recunique($fucourseid);      my $cunique=&recunique($fucourseid);
     my $cpart=unpack("%32S*",$part);      my $cpart=unpack("%32S*",$part);
     my $return =&recprefix($fucourseid).'-';      if ($env{"course.$fucourseid.receiptalg"} eq 'receipt2') {
     if ($env{"course.$fucourseid.receiptalg"} eq 'receipt2' ||  
  $env{'request.state'} eq 'construct') {  
  #&logthis("doing receipt2  using parts $cpart, uname $cuname and udom $cudom gets  ".($cpart%$cuname)." and ".($cpart%$cudom));   #&logthis("doing receipt2  using parts $cpart, uname $cuname and udom $cudom gets  ".($cpart%$cuname)." and ".($cpart%$cudom));
                 
  $return.= ($cunique%$cuname+   $return.= ($cunique%$cuname+
Removed from v.1.834  
changed lines
  Added in v.1.836

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>