[BACK]Return to lond CVS log [TXT] [DIR] Up to [LON-CAPA] / loncom

Diff for /loncom/lond between versions 1.223 and 1.227

version 1.223, 2004/08/05 11:37:05 version 1.227, 2004/08/10 11:38:11
Line 52  use LONCAPA::lonlocal; Line 52  use LONCAPA::lonlocal;
 use LONCAPA::lonssl;  use LONCAPA::lonssl;
 use Fcntl qw(:flock);  use Fcntl qw(:flock);
   
 my $DEBUG = 1;       # Non zero to enable debug log entries.  my $DEBUG = 0;       # Non zero to enable debug log entries.
   
 my $status='';  my $status='';
 my $lastlog='';  my $lastlog='';
Line 162  sub ResetStatistics { Line 162  sub ResetStatistics {
     $Failures     = 0;      $Failures     = 0;
 }  }
   
   
   
 #------------------------------------------------------------------------  #------------------------------------------------------------------------
 #  #
 #   LocalConnection  #   LocalConnection
Line 194  sub LocalConnection { Line 192  sub LocalConnection {
  ."$clientdns ne $thisserver </font>");   ."$clientdns ne $thisserver </font>");
  close $Socket;   close $Socket;
  return undef;   return undef;
     }       }  else {
     else {  
  chomp($initcmd); # Get rid of \n in filename.   chomp($initcmd); # Get rid of \n in filename.
  my ($init, $type, $name) = split(/:/, $initcmd);   my ($init, $type, $name) = split(/:/, $initcmd);
  Debug(" Init command: $init $type $name ");   Debug(" Init command: $init $type $name ");
Line 326  sub InsecureConnection { Line 323  sub InsecureConnection {
     $answer    =~s/\W//g;      $answer    =~s/\W//g;
     if($challenge eq $answer) {      if($challenge eq $answer) {
  return 1;   return 1;
     }       } else {
     else {  
  logthis("<font color='blue'>WARNING client did not respond to challenge</font>");   logthis("<font color='blue'>WARNING client did not respond to challenge</font>");
  &status("No challenge reqply");   &status("No challenge reqply");
  return 0;   return 0;
Line 374  sub isClient { Line 370  sub isClient {
 #                     - This allows dynamic changes to the manager table  #                     - This allows dynamic changes to the manager table
 #                       without the need to signal to the lond.  #                       without the need to signal to the lond.
 #  #
   
 sub ReadManagerTable {  sub ReadManagerTable {
   
     #   Clean out the old table first..      #   Clean out the old table first..
Line 656  sub PushFile { Line 651  sub PushFile {
  &logthis('<font color="red"> Pushfile: unable to install '   &logthis('<font color="red"> Pushfile: unable to install '
  .$tablefile." $! </font>");   .$tablefile." $! </font>");
  return "error:$!";   return "error:$!";
     }      } else {
     else {  
  &logthis('<font color="green"> Installed new '.$tablefile   &logthis('<font color="green"> Installed new '.$tablefile
  ."</font>");   ."</font>");
   
Line 1503  sub change_password_handler { Line 1497  sub change_password_handler {
     &Failure( $client, "auth_mode_error\n", $userinput);      &Failure( $client, "auth_mode_error\n", $userinput);
  }     }  
   
     }      } else {
     else {  
  &Failure( $client, "non_authorized\n", $userinput);   &Failure( $client, "non_authorized\n", $userinput);
     }      }
   
Line 1513  sub change_password_handler { Line 1506  sub change_password_handler {
 register_handler("passwd", \&change_password_handler, 1, 1, 0);  register_handler("passwd", \&change_password_handler, 1, 1, 0);
   
   
   #
   #   Create a new user.  User in this case means a lon-capa user.
   #   The user must either already exist in some authentication realm
   #   like kerberos or the /etc/passwd.  If not, a user completely local to
   #   this loncapa system is created.
   #
   # Parameters:
   #    $cmd      - The command that got us here.
   #    $tail     - Tail of the command (remaining parameters).
   #    $client   - File descriptor connected to client.
   # Returns
   #     0        - Requested to exit, caller should shut down.
   #     1        - Continue processing.
   # Implicit inputs:
   #    The authentication systems describe above have their own forms of implicit
   #    input into the authentication process that are described above.
   sub add_user_handler {
   
       my ($cmd, $tail, $client) = @_;
   
   
       my ($udom,$uname,$umode,$npass)=split(/:/,$tail);
       my $userinput = $cmd.":".$tail; # Reconstruct the full request line.
   
       &Debug("cmd =".$cmd." $udom =".$udom." uname=".$uname);
   
   
       if($udom eq $currentdomainid) { # Reject new users for other domains...
   
    my $oldumask=umask(0077);
    chomp($npass);
    $npass=&unescape($npass);
    my $passfilename  = &password_path($udom, $uname);
    &Debug("Password file created will be:".$passfilename);
    if (-e $passfilename) {
       &Failure( $client, "already_exists\n", $userinput);
    } else {
       my @fpparts=split(/\//,$passfilename);
       my $fpnow=$fpparts[0].'/'.$fpparts[1].'/'.$fpparts[2];
       my $fperror='';
       for (my $i=3;$i<= ($#fpparts-1);$i++) {
    $fpnow.='/'.$fpparts[$i]; 
    unless (-e $fpnow) {
       &logthis("mkdir $fpnow");
       unless (mkdir($fpnow,0777)) {
    $fperror="error: ".($!+0)." mkdir failed while attempting "
       ."makeuser";
       }
    }
       }
       unless ($fperror) {
    my $result=&make_passwd_file($uname, $umode,$npass, $passfilename);
    &Reply($client, $result, $userinput);     #BUGBUG - could be fail
       } else {
    &Failure($client, "$fperror\n", $userinput);
       }
    }
    umask($oldumask);
       }  else {
    &Failure($client, "not_right_domain\n",
    $userinput); # Even if we are multihomed.
       
       }
       return 1;
   
   }
   &register_handler("makeuser", \&add_user_handler, 1, 1, 0);
   
   #
   #   Change the authentication method of a user.  Note that this may
   #   also implicitly change the user's password if, for example, the user is
   #   joining an existing authentication realm.  Known authentication realms at
   #   this time are:
   #    internal   - Purely internal password file (only loncapa knows this user)
   #    local      - Institutionally written authentication module.
   #    unix       - Unix user (/etc/passwd with or without /etc/shadow).
   #    kerb4      - kerberos version 4
   #    kerb5      - kerberos version 5
   #
   # Parameters:
   #    $cmd      - The command that got us here.
   #    $tail     - Tail of the command (remaining parameters).
   #    $client   - File descriptor connected to client.
   # Returns
   #     0        - Requested to exit, caller should shut down.
   #     1        - Continue processing.
   # Implicit inputs:
   #    The authentication systems describe above have their own forms of implicit
   #    input into the authentication process that are described above.
   #
   sub change_authentication_handler {
   
       my ($cmd, $tail, $client) = @_;
      
       my $userinput  = "$cmd:$tail";              # Reconstruct user input.
   
       my ($udom,$uname,$umode,$npass)=split(/:/,$tail);
       &Debug("cmd = ".$cmd." domain= ".$udom."uname =".$uname." umode= ".$umode);
       if ($udom ne $currentdomainid) {
    &Failure( $client, "not_right_domain\n", $client);
       } else {
   
    chomp($npass);
   
    $npass=&unescape($npass);
    my $passfilename = &password_path($udom, $uname);
    if ($passfilename) { # Not allowed to create a new user!!
       my $result=&make_passwd_file($uname, $umode,$npass,$passfilename);
       &Reply($client, $result, $userinput);
    } else {       
       &Failure($client, "non_authorized", $userinput); # Fail the user now.
    }
       }
       return 1;
   }
   &register_handler("changeuserauth", \&change_authentication_handler, 1,1, 0);
   
   #
   #   Determines if this is the home server for a user.  The home server
   #   for a user will have his/her lon-capa passwd file.  Therefore all we need
   #   to do is determine if this file exists.
   #
   # Parameters:
   #    $cmd      - The command that got us here.
   #    $tail     - Tail of the command (remaining parameters).
   #    $client   - File descriptor connected to client.
   # Returns
   #     0        - Requested to exit, caller should shut down.
   #     1        - Continue processing.
   # Implicit inputs:
   #    The authentication systems describe above have their own forms of implicit
   #    input into the authentication process that are described above.
   #
   sub is_home_handler {
       my ($cmd, $tail, $client) = @_;
      
       my $userinput  = "$cmd:$tail";
      
       my ($udom,$uname)=split(/:/,$tail);
       chomp($uname);
       my $passfile = &password_filename($udom, $uname);
       if($passfile) {
    &Reply( $client, "found\n", $userinput);
       } else {
    &Failure($client, "not_found\n", $userinput);
       }
       return 1;
   }
   &register_handler("home", \&is_home_handler, 0,1,0);
   
   #
   #   Process an update request for a resource?? I think what's going on here is
   #   that a resource has been modified that we hold a subscription to.
   #   If the resource is not local, then we must update, or at least invalidate our
   #   cached copy of the resource. 
   #   FUTURE WORK:
   #      I need to look at this logic carefully.  My druthers would be to follow
   #      typical caching logic, and simple invalidate the cache, drop any subscription
   #      an let the next fetch start the ball rolling again... however that may
   #      actually be more difficult than it looks given the complex web of
   #      proxy servers.
   # Parameters:
   #    $cmd      - The command that got us here.
   #    $tail     - Tail of the command (remaining parameters).
   #    $client   - File descriptor connected to client.
   # Returns
   #     0        - Requested to exit, caller should shut down.
   #     1        - Continue processing.
   # Implicit inputs:
   #    The authentication systems describe above have their own forms of implicit
   #    input into the authentication process that are described above.
   #
   sub update_resource_handler {
   
       my ($cmd, $tail, $client) = @_;
      
       my $userinput = "$cmd:$tail";
      
       my $fname= $tail; # This allows interactive testing
   
   
       my $ownership=ishome($fname);
       if ($ownership eq 'not_owner') {
    if (-e $fname) {
       my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
    $atime,$mtime,$ctime,$blksize,$blocks)=stat($fname);
       my $now=time;
       my $since=$now-$atime;
       if ($since>$perlvar{'lonExpire'}) {
    my $reply=&reply("unsub:$fname","$clientname");
    unlink("$fname");
       } else {
    my $transname="$fname.in.transfer";
    my $remoteurl=&reply("sub:$fname","$clientname");
    my $response;
    alarm(120);
    {
       my $ua=new LWP::UserAgent;
       my $request=new HTTP::Request('GET',"$remoteurl");
       $response=$ua->request($request,$transname);
    }
    alarm(0);
    if ($response->is_error()) {
       unlink($transname);
       my $message=$response->status_line;
       &logthis("LWP GET: $message for $fname ($remoteurl)");
    } else {
       if ($remoteurl!~/\.meta$/) {
    alarm(120);
    {
       my $ua=new LWP::UserAgent;
       my $mrequest=new HTTP::Request('GET',$remoteurl.'.meta');
       my $mresponse=$ua->request($mrequest,$fname.'.meta');
       if ($mresponse->is_error()) {
    unlink($fname.'.meta');
       }
    }
    alarm(0);
       }
       rename($transname,$fname);
    }
       }
       &Reply( $client, "ok\n", $userinput);
    } else {
       &Failure($client, "not_found\n", $userinput);
    }
       } else {
    &Failure($client, "rejected\n", $userinput);
       }
       return 1;
   }
   &register_handler("update", \&update_resource_handler, 0 ,1, 0);
   
   #
   #   Fetch a user file from a remote server to the user's home directory
   #   userfiles subdir.
   # Parameters:
   #    $cmd      - The command that got us here.
   #    $tail     - Tail of the command (remaining parameters).
   #    $client   - File descriptor connected to client.
   # Returns
   #     0        - Requested to exit, caller should shut down.
   #     1        - Continue processing.
   #
   sub fetch_user_file_handler {
   
       my ($cmd, $tail, $client) = @_;
   
       my $userinput = "$cmd:$tail";
       my $fname           = $tail;
       my ($udom,$uname,$ufile)=split(/\//,$fname);
       my $udir=&propath($udom,$uname).'/userfiles';
       unless (-e $udir) {
    mkdir($udir,0770); 
       }
       if (-e $udir) {
    $ufile=~s/^[\.\~]+//;
    $ufile=~s/\///g;
    my $destname=$udir.'/'.$ufile;
    my $transname=$udir.'/'.$ufile.'.in.transit';
    my $remoteurl='http://'.$clientip.'/userfiles/'.$fname;
    my $response;
    alarm(120);
    {
       my $ua=new LWP::UserAgent;
       my $request=new HTTP::Request('GET',"$remoteurl");
       $response=$ua->request($request,$transname);
    }
    alarm(0);
    if ($response->is_error()) {
       unlink($transname);
       my $message=$response->status_line;
       &logthis("LWP GET: $message for $fname ($remoteurl)");
       &Failure($client, "failed\n", $userinput);
    } else {
       if (!rename($transname,$destname)) {
    &logthis("Unable to move $transname to $destname");
    unlink($transname);
    &Failure($client, "failed\n", $userinput);
       } else {
    &Reply($client, "ok\n", $userinput);
       }
    }   
       } else {
    &Failure($client, "not_home\n", $userinput);
       }
       return 1;
   }
   &register_handler("fetchuserfile", \&fetch_user_file_handler, 0, 1, 0);
   
   #
   #   Remove a file from a user's home directory userfiles subdirectory.
   # Parameters:
   #    cmd   - the Lond request keyword that got us here.
   #    tail  - the part of the command past the keyword.
   #    client- File descriptor connected with the client.
   #
   # Returns:
   #    1    - Continue processing.
   
   sub remove_user_file_handler {
       my ($cmd, $tail, $client) = @_;
   
       my ($fname) = split(/:/, $tail); # Get rid of any tailing :'s lonc may have sent.
   
       my ($udom,$uname,$ufile) = ($fname =~ m|^([^/]+)/([^/]+)/(.+)$|);
       &logthis("$udom - $uname - $ufile");
       if ($ufile =~m|/\.\./|) {
    # any files paths with /../ in them refuse 
    # to deal with
    &Failure($client, "refused\n", "$cmd:$tail");
       } else {
    my $udir = &propath($udom,$uname);
    if (-e $udir) {
       my $file=$udir.'/userfiles/'.$ufile;
       if (-e $file) {
    unlink($file);
    if (-e $file) {
       &Failure($client, "failed\n", "$cmd:$tail");
    } else {
       &Reply($client, "ok\n", "$cmd:$tail");
    }
       } else {
    &Failure($client, "not_found\n", "$cmd:$tail");
       }
    } else {
       &Failure($client, "not_home\n", "$cmd:$tail");
    }
       }
       return 1;
   }
   &register_handler("removeuserfile", \&remove_user_file_handler, 0,1,0);
   
   
   #
   #  Authenticate access to a user file by checking the user's 
   #  session token(?)
   #
   # Parameters:
   #   cmd      - The request keyword that dispatched to tus.
   #   tail     - The tail of the request (colon separated parameters).
   #   client   - Filehandle open on the client.
   # Return:
   #    1.
   
   sub token_auth_user_file_handler {
       my ($cmd, $tail, $client) = @_;
   
       my ($fname, $session) = split(/:/, $tail);
       
       chomp($session);
       my $reply='non_auth';
       if (open(ENVIN,$perlvar{'lonIDsDir'}.'/'.
        $session.'.id')) {
    while (my $line=<ENVIN>) {
       if ($line=~ m|userfile\.\Q$fname\E\=|) { $reply='ok'; }
    }
    close(ENVIN);
    &Reply($client, $reply);
       } else {
    &Failure($client, "invalid_token\n", "$cmd:$tail");
       }
       return 1;
   
   }
   
   &register_handler("tokenauthuserfile", \&token_auth_user_file_handler, 0,1,0);
 #---------------------------------------------------------------  #---------------------------------------------------------------
 #  #
 #   Getting, decoding and dispatching requests:  #   Getting, decoding and dispatching requests:
Line 1523  register_handler("passwd", \&change_pass Line 1883  register_handler("passwd", \&change_pass
 #   Gets a Request message from the client.  The transaction  #   Gets a Request message from the client.  The transaction
 #   is defined as a 'line' of text.  We remove the new line  #   is defined as a 'line' of text.  We remove the new line
 #   from the text line.    #   from the text line.  
 #     #
 sub get_request {  sub get_request {
     my $input = <$client>;      my $input = <$client>;
     chomp($input);      chomp($input);
Line 1628  sub process_request { Line 1988  sub process_request {
   
   
   
 # -------------------------------------------------------------------- makeuser  
     if ($userinput =~ /^makeuser/) { # encoded and client.  
  &Debug("Make user received");  
  my $oldumask=umask(0077);  
  if (($wasenc==1) && isClient) {  
     my   
  ($cmd,$udom,$uname,$umode,$npass)=split(/:/,$userinput);  
     &Debug("cmd =".$cmd." $udom =".$udom.  
    " uname=".$uname);  
     chomp($npass);  
     $npass=&unescape($npass);  
     my $proname=propath($udom,$uname);  
     my $passfilename="$proname/passwd";  
     &Debug("Password file created will be:".  
    $passfilename);  
     if (-e $passfilename) {  
  print $client "already_exists\n";  
     } elsif ($udom ne $currentdomainid) {  
  print $client "not_right_domain\n";  
     } else {  
  my @fpparts=split(/\//,$proname);  
  my $fpnow=$fpparts[0].'/'.$fpparts[1].'/'.$fpparts[2];  
  my $fperror='';  
  for (my $i=3;$i<=$#fpparts;$i++) {  
     $fpnow.='/'.$fpparts[$i];   
     unless (-e $fpnow) {  
  unless (mkdir($fpnow,0777)) {  
     $fperror="error: ".($!+0)  
  ." mkdir failed while attempting "  
  ."makeuser";  
  }  
     }  
  }  
  unless ($fperror) {  
     my $result=&make_passwd_file($uname, $umode,$npass,  
  $passfilename);  
     print $client $result;  
  } else {  
     print $client "$fperror\n";  
  }  
     }  
  } else {  
     Reply($client, "refused\n", $userinput);  
       
  }  
  umask($oldumask);  
 # -------------------------------------------------------------- changeuserauth  
     } elsif ($userinput =~ /^changeuserauth/) { # encoded & client  
  &Debug("Changing authorization");  
  if (($wasenc==1) && isClient) {  
     my   
  ($cmd,$udom,$uname,$umode,$npass)=split(/:/,$userinput);  
     chomp($npass);  
     &Debug("cmd = ".$cmd." domain= ".$udom.  
    "uname =".$uname." umode= ".$umode);  
     $npass=&unescape($npass);  
     my $proname=&propath($udom,$uname);  
     my $passfilename="$proname/passwd";  
     if ($udom ne $currentdomainid) {  
  print $client "not_right_domain\n";  
     } else {  
  my $result=&make_passwd_file($uname, $umode,$npass,  
      $passfilename);  
  Reply($client, $result, $userinput);  
     }  
  } else {  
     Reply($client, "refused\n", $userinput);  
       
  }  
 # ------------------------------------------------------------------------ home  
     } elsif ($userinput =~ /^home/) { # client clear or encoded  
  if(isClient) {  
     my ($cmd,$udom,$uname)=split(/:/,$userinput);  
     chomp($uname);  
     my $proname=propath($udom,$uname);  
     if (-e $proname) {  
  print $client "found\n";  
     } else {  
  print $client "not_found\n";  
     }  
  } else {  
     Reply($client, "refused\n", $userinput);  
       
  }  
 # ---------------------------------------------------------------------- update  
     } elsif ($userinput =~ /^update/) { # client clear or encoded.  
  if(isClient) {  
     my ($cmd,$fname)=split(/:/,$userinput);  
     my $ownership=ishome($fname);  
     if ($ownership eq 'not_owner') {  
  if (-e $fname) {  
     my ($dev,$ino,$mode,$nlink,  
  $uid,$gid,$rdev,$size,  
  $atime,$mtime,$ctime,  
  $blksize,$blocks)=stat($fname);  
     my $now=time;  
     my $since=$now-$atime;  
     if ($since>$perlvar{'lonExpire'}) {  
  my $reply=  
     &reply("unsub:$fname","$clientname");  
     unlink("$fname");  
     } else {  
  my $transname="$fname.in.transfer";  
  my $remoteurl=  
     &reply("sub:$fname","$clientname");  
  my $response;  
  {  
     my $ua=new LWP::UserAgent;  
     my $request=new HTTP::Request('GET',"$remoteurl");  
     $response=$ua->request($request,$transname);  
  }  
  if ($response->is_error()) {  
     unlink($transname);  
     my $message=$response->status_line;  
     &logthis(  
      "LWP GET: $message for $fname ($remoteurl)");  
  } else {  
     if ($remoteurl!~/\.meta$/) {  
  my $ua=new LWP::UserAgent;  
  my $mrequest=  
     new HTTP::Request('GET',$remoteurl.'.meta');  
  my $mresponse=  
     $ua->request($mrequest,$fname.'.meta');  
  if ($mresponse->is_error()) {  
     unlink($fname.'.meta');  
  }  
     }  
     rename($transname,$fname);  
  }  
     }  
     print $client "ok\n";  
  } else {  
     print $client "not_found\n";  
  }  
     } else {  
  print $client "rejected\n";  
     }  
  } else {  
     Reply($client, "refused\n", $userinput);  
       
  }  
 # -------------------------------------- fetch a user file from a remote server  
     } elsif ($userinput =~ /^fetchuserfile/) { # Client clear or enc.  
  if(isClient) {  
     my ($cmd,$fname)=split(/:/,$userinput);  
     my ($udom,$uname,$ufile) = ($fname =~ m|^([^/]+)/([^/]+)/(.+)$|);  
     my $udir=propath($udom,$uname).'/userfiles';  
     unless (-e $udir) { mkdir($udir,0770); }  
     if (-e $udir) {  
  $ufile=~s/^[\.\~]+//;  
  my $path = $udir;  
  if ($ufile =~m|(.+)/([^/]+)$|) {  
     my @parts=split('/',$1);  
     foreach my $part (@parts) {  
  $path .= '/'.$part;  
  if ((-e $path)!=1) {  
     mkdir($path,0770);  
  }  
     }  
  }  
  my $destname=$udir.'/'.$ufile;  
  my $transname=$udir.'/'.$ufile.'.in.transit';  
  my $remoteurl='http://'.$clientip.'/userfiles/'.$fname;  
  my $response;  
  {  
     my $ua=new LWP::UserAgent;  
     my $request=new HTTP::Request('GET',"$remoteurl");  
     $response=$ua->request($request,$transname);  
  }  
  if ($response->is_error()) {  
     unlink($transname);  
     my $message=$response->status_line;  
     &logthis("LWP GET: $message for $fname ($remoteurl)");  
     print $client "failed\n";  
  } else {  
     if (!rename($transname,$destname)) {  
  &logthis("Unable to move $transname to $destname");  
  unlink($transname);  
  print $client "failed\n";  
     } else {  
  print $client "ok\n";  
     }  
  }  
     } else {  
  print $client "not_home\n";  
     }  
  } else {  
     Reply($client, "refused\n", $userinput);  
  }  
 # --------------------------------------------------------- remove a user file   
     } elsif ($userinput =~ /^removeuserfile/) { # Client clear or enc.  
  if(isClient) {  
     my ($cmd,$fname)=split(/:/,$userinput);  
     my ($udom,$uname,$ufile) = ($fname =~ m|^([^/]+)/([^/]+)/(.+)$|);  
     &logthis("$udom - $uname - $ufile");  
     if ($ufile =~m|/\.\./|) {  
  # any files paths with /../ in them refuse   
  # to deal with  
  print $client "refused\n";  
     } else {  
  my $udir=propath($udom,$uname);  
  if (-e $udir) {  
     my $file=$udir.'/userfiles/'.$ufile;  
     if (-e $file) {  
  unlink($file);  
  if (-e $file) {  
     print $client "failed\n";  
  } else {  
     print $client "ok\n";  
  }  
     } else {  
  print $client "not_found\n";  
     }  
  } else {  
     print $client "not_home\n";  
  }  
     }  
  } else {  
     Reply($client, "refused\n", $userinput);  
  }  
 # ------------------------------------------ authenticate access to a user file  
     } elsif ($userinput =~ /^tokenauthuserfile/) { # Client only  
  if(isClient) {  
     my ($cmd,$fname,$session)=split(/:/,$userinput);  
     chomp($session);  
     my $reply='non_auth';  
     if (open(ENVIN,$perlvar{'lonIDsDir'}.'/'.  
      $session.'.id')) {  
  while (my $line=<ENVIN>) {  
     if ($line=~ m|userfile\.\Q$fname\E\=|) { $reply='ok'; }  
     }  
  close(ENVIN);  
  print $client $reply."\n";  
     } else {  
  print $client "invalid_token\n";  
     }  
  } else {  
     Reply($client, "refused\n", $userinput);  
       
  }  
 # ----------------------------------------------------------------- unsubscribe  # ----------------------------------------------------------------- unsubscribe
     } elsif ($userinput =~ /^unsub/) {      if ($userinput =~ /^unsub/) {
  if(isClient) {   if(isClient) {
     my ($cmd,$fname)=split(/:/,$userinput);      my ($cmd,$fname)=split(/:/,$userinput);
     if (-e $fname) {      if (-e $fname) {
Line 2495  sub process_request { Line 2615  sub process_request {
  print $store2 "done\n";   print $store2 "done\n";
  close $store2;   close $store2;
  print $client "ok\n";   print $client "ok\n";
     }      } else {
     else {  
  print $client "error: ".($!+0)   print $client "error: ".($!+0)
     ." IO::File->new Failed ".      ." IO::File->new Failed ".
     "while attempting queryreply\n";      "while attempting queryreply\n";
Line 3010  sub register_handler { Line 3129  sub register_handler {
         
     $Dispatcher{$request_name} = \@entry;      $Dispatcher{$request_name} = \@entry;
         
      
 }  }
   
   
Line 3057  sub catchexception { Line 3175  sub catchexception {
     $server->close();      $server->close();
     die($error);      die($error);
 }  }
   
 sub timeout {  sub timeout {
     &status("Handling Timeout");      &status("Handling Timeout");
     &logthis("<font color='red'>CRITICAL: TIME OUT ".$$."</font>");      &logthis("<font color='red'>CRITICAL: TIME OUT ".$$."</font>");
Line 3065  sub timeout { Line 3182  sub timeout {
 }  }
 # -------------------------------- Set signal handlers to record abnormal exits  # -------------------------------- Set signal handlers to record abnormal exits
   
   
 $SIG{'QUIT'}=\&catchexception;  $SIG{'QUIT'}=\&catchexception;
 $SIG{__DIE__}=\&catchexception;  $SIG{__DIE__}=\&catchexception;
   
Line 3694  sub make_new_child { Line 3812  sub make_new_child {
  $inittype = ""; # This forces insecure attempt.   $inittype = ""; # This forces insecure attempt.
  &logthis("<font color=\"blue\"> Certificates not "   &logthis("<font color=\"blue\"> Certificates not "
  ."installed -- trying insecure auth</font>");   ."installed -- trying insecure auth</font>");
     }      } else { # SSL certificates are in place so
     else { # SSL certificates are in place so  
     } # Leave the inittype alone.      } # Leave the inittype alone.
  }   }
   
Line 3929  sub get_auth_type Line 4046  sub get_auth_type
  }   }
   
  return "$authtype:$availinfo";   return "$authtype:$availinfo";
     }      } else {
     else {  
  Debug("Returning nouser");   Debug("Returning nouser");
  return "nouser";   return "nouser";
     }      }
Line 4010  sub validate_user { Line 4126  sub validate_user {
    $password);     $password);
  if(!$k4error) {   if(!$k4error) {
     $validated = 1;      $validated = 1;
  }   } else {
  else {  
     $validated = 0;      $validated = 0;
     &logthis('krb4: '.$user.', '.$contentpwd.', '.      &logthis('krb4: '.$user.', '.$contentpwd.', '.
      &Authen::Krb4::get_err_txt($Authen::Krb4::error));       &Authen::Krb4::get_err_txt($Authen::Krb4::error));
  }   }
     }      } else {
     else {  
  $validated = 0; # Password has a match with null.   $validated = 0; # Password has a match with null.
     }      }
  }   } elsif ($howpwd eq "krb5") { # User is in kerberos 5 auth. domain.
  elsif ($howpwd eq "krb5") { # User is in kerberos 5 auth. domain.  
     if(!($password =~ /$null/)) { # Null password not allowed.      if(!($password =~ /$null/)) { # Null password not allowed.
  my $krbclient = &Authen::Krb5::parse_name($user.'@'   my $krbclient = &Authen::Krb5::parse_name($user.'@'
   .$contentpwd);    .$contentpwd);
Line 4034  sub validate_user { Line 4147  sub validate_user {
  $password,   $password,
  $credentials);   $credentials);
  $validated = ($krbreturn == 1);   $validated = ($krbreturn == 1);
     }      } else {
     else {  
  $validated = 0;   $validated = 0;
     }      }
  }   } elsif ($howpwd eq "localauth") { 
  elsif ($howpwd eq "localauth") {   
     #  Authenticate via installation specific authentcation method:      #  Authenticate via installation specific authentcation method:
     $validated = &localauth::localauth($user,       $validated = &localauth::localauth($user, 
        $password,          $password, 
        $contentpwd);         $contentpwd);
  }   } else { # Unrecognized auth is also bad.
  else { # Unrecognized auth is also bad.  
     $validated = 0;      $validated = 0;
  }   }
     } else {      } else {
Line 4308  sub make_passwd_file { Line 4418  sub make_passwd_file {
     }      }
   
     my $execpath       ="$perlvar{'lonDaemons'}/"."lcuseradd";      my $execpath       ="$perlvar{'lonDaemons'}/"."lcuseradd";
     my $lc_error_file  = "/tmp/lcuseradd".$$.".status";  
       my $lc_error_file  = $execdir."/tmp/lcuseradd".$$.".status";
     {      {
  &Debug("Executing external: ".$execpath);   &Debug("Executing external: ".$execpath);
  &Debug("user  = ".$uname.", Password =". $npass);   &Debug("user  = ".$uname.", Password =". $npass);
Line 4329  sub make_passwd_file { Line 4440  sub make_passwd_file {
  my $error_text = &lcuseraddstrerror($useraddok);   my $error_text = &lcuseraddstrerror($useraddok);
  &logthis("Failed lcuseradd: $error_text");   &logthis("Failed lcuseradd: $error_text");
  $result = "lcuseradd_failed:$error_text\n";   $result = "lcuseradd_failed:$error_text\n";
     }      }  else {
     else {  
  my $pf = IO::File->new(">$passfilename");   my $pf = IO::File->new(">$passfilename");
  print $pf "unix:\n";   print $pf "unix:\n";
     }      }
Removed from v.1.223  
changed lines
  Added in v.1.227

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