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

Diff for /loncom/lond between versions 1.285 and 1.296

version 1.285, 2005/06/21 11:01:35 version 1.296, 2005/09/01 07:49:43
Line 48  use localauth; Line 48  use localauth;
 use localenroll;  use localenroll;
 use localstudentphoto;  use localstudentphoto;
 use File::Copy;  use File::Copy;
   use File::Find;
 use LONCAPA::ConfigFileEdit;  use LONCAPA::ConfigFileEdit;
 use LONCAPA::lonlocal;  use LONCAPA::lonlocal;
 use LONCAPA::lonssl;  use LONCAPA::lonssl;
Line 112  my %Dispatcher; Line 113  my %Dispatcher;
 #  #
 my $lastpwderror    = 13; # Largest error number from lcpasswd.  my $lastpwderror    = 13; # Largest error number from lcpasswd.
 my @passwderrors = ("ok",  my @passwderrors = ("ok",
    "lcpasswd must be run as user 'www'",     "pwchange_failure - lcpasswd must be run as user 'www'",
    "lcpasswd got incorrect number of arguments",     "pwchange_failure - lcpasswd got incorrect number of arguments",
    "lcpasswd did not get the right nubmer of input text lines",     "pwchange_failure - lcpasswd did not get the right nubmer of input text lines",
    "lcpasswd too many simultaneous pwd changes in progress",     "pwchange_failure - lcpasswd too many simultaneous pwd changes in progress",
    "lcpasswd User does not exist.",     "pwchange_failure - lcpasswd User does not exist.",
    "lcpasswd Incorrect current passwd",     "pwchange_failure - lcpasswd Incorrect current passwd",
    "lcpasswd Unable to su to root.",     "pwchange_failure - lcpasswd Unable to su to root.",
    "lcpasswd Cannot set new passwd.",     "pwchange_failure - lcpasswd Cannot set new passwd.",
    "lcpasswd Username has invalid characters",     "pwchange_failure - lcpasswd Username has invalid characters",
    "lcpasswd Invalid characters in password",     "pwchange_failure - lcpasswd Invalid characters in password",
    "lcpasswd User already exists",      "pwchange_failure - lcpasswd User already exists", 
                    "lcpasswd Something went wrong with user addition.",                     "pwchange_failure - lcpasswd Something went wrong with user addition.",
     "lcpasswd Password mismatch",     "pwchange_failure - lcpasswd Password mismatch",
     "lcpasswd Error filename is invalid");     "pwchange_failure - lcpasswd Error filename is invalid");
   
   
 #  The array below are lcuseradd error strings.:  #  The array below are lcuseradd error strings.:
Line 1363  sub du_handler { Line 1364  sub du_handler {
     #  etc.      #  etc.
     #      #
     if (-d $ududir) {      if (-d $ududir) {
  #  And as Shakespeare would say to make   my $total_size=0;
  #  assurance double sure,    my $code=sub { 
  # use execute_command to ensure that the command is not executed in      if ($_=~/\.\d+\./) { return;} 
  # a shell that can screw us up.      if ($_=~/\.meta$/) { return;}
       $total_size+=(stat($_))[7];
  my $duout = execute_command("du -ks $ududir");   };
  $duout=~s/[^\d]//g; #preserve only the numbers   chdir($ududir);
  &Reply($client,"$duout\n","$cmd:$ududir");   find($code,$ududir);
    $total_size=int($total_size/1024);
    &Reply($client,"$total_size\n","$cmd:$ududir");
     } else {      } else {
   
  &Failure($client, "bad_directory:$ududir\n","$cmd:$ududir");    &Failure($client, "bad_directory:$ududir\n","$cmd:$ududir"); 
   
     }      }
     return 1;      return 1;
 }  }
Line 1413  sub ls_handler { Line 1414  sub ls_handler {
  if(-d $ulsdir) {   if(-d $ulsdir) {
     if (opendir(LSDIR,$ulsdir)) {      if (opendir(LSDIR,$ulsdir)) {
  while ($ulsfn=readdir(LSDIR)) {   while ($ulsfn=readdir(LSDIR)) {
     undef $obs, $rights;       undef($obs);
       undef($rights); 
     my @ulsstats=stat($ulsdir.'/'.$ulsfn);      my @ulsstats=stat($ulsdir.'/'.$ulsfn);
     #We do some obsolete checking here      #We do some obsolete checking here
     if(-e $ulsdir.'/'.$ulsfn.".meta") {       if(-e $ulsdir.'/'.$ulsfn.".meta") { 
Line 1480  sub ls2_handler { Line 1482  sub ls2_handler {
         if(-d $ulsdir) {          if(-d $ulsdir) {
             if (opendir(LSDIR,$ulsdir)) {              if (opendir(LSDIR,$ulsdir)) {
                 while ($ulsfn=readdir(LSDIR)) {                  while ($ulsfn=readdir(LSDIR)) {
                     undef $obs, $rights;                       undef($obs);
       undef($rights); 
                     my @ulsstats=stat($ulsdir.'/'.$ulsfn);                      my @ulsstats=stat($ulsdir.'/'.$ulsfn);
                     #We do some obsolete checking here                      #We do some obsolete checking here
                     if(-e $ulsdir.'/'.$ulsfn.".meta") {                       if(-e $ulsdir.'/'.$ulsfn.".meta") { 
Line 1701  sub change_password_handler { Line 1704  sub change_password_handler {
  &Failure( $client, "non_authorized\n",$userinput);   &Failure( $client, "non_authorized\n",$userinput);
     }      }
  } elsif ($howpwd eq 'unix') {   } elsif ($howpwd eq 'unix') {
     # Unix means we have to access /etc/password      my $result = &change_unix_password($uname, $npass);
     &Debug("auth is unix");  
     my $execdir=$perlvar{'lonDaemons'};  
     &Debug("Opening lcpasswd pipeline");  
     my $pf = IO::File->new("|$execdir/lcpasswd > "  
    ."$perlvar{'lonDaemons'}"  
    ."/logs/lcpasswd.log");  
     print $pf "$uname\n$npass\n$npass\n";  
     close $pf;  
     my $err = $?;  
     my $result = ($err>0 ? 'pwchange_failure' : 'ok');  
     &logthis("Result of password change for $uname: ".      &logthis("Result of password change for $uname: ".
      &lcpasswdstrerror($?));       $result);
     &Reply($client, "$result\n", $userinput);      &Reply($client, "$result\n", $userinput);
  } else {   } else {
     # this just means that the current password mode is not      # this just means that the current password mode is not
Line 1812  sub add_user_handler { Line 1805  sub add_user_handler {
 # Implicit inputs:  # Implicit inputs:
 #    The authentication systems describe above have their own forms of implicit  #    The authentication systems describe above have their own forms of implicit
 #    input into the authentication process that are described above.  #    input into the authentication process that are described above.
   # NOTE:
   #   This is also used to change the authentication credential values (e.g. passwd).
   #   
 #  #
 sub change_authentication_handler {  sub change_authentication_handler {
   
Line 1831  sub change_authentication_handler { Line 1827  sub change_authentication_handler {
  my $oldauth = &get_auth_type($udom, $uname); # Get old auth info.   my $oldauth = &get_auth_type($udom, $uname); # Get old auth info.
  my $passfilename = &password_path($udom, $uname);   my $passfilename = &password_path($udom, $uname);
  if ($passfilename) { # Not allowed to create a new user!!   if ($passfilename) { # Not allowed to create a new user!!
     my $result=&make_passwd_file($uname, $umode,$npass,$passfilename);      # If just changing the unix passwd. need to arrange to run
     #      # passwd since otherwise make_passwd_file will run
     #  If the current auth mode is internal, and the old auth mode was      # lcuseradd which fails if an account already exists
     #  unix, or krb*,  and the user is an author for this domain,      # (to prevent an unscrupulous LONCAPA admin from stealing
     #  re-run manage_permissions for that role in order to be able      # an existing account by overwriting it as a LonCAPA account).
     #  to take ownership of the construction space back to www:www  
     #      if(($oldauth =~/^unix/) && ($umode eq "unix")) {
    my $result = &change_unix_password($uname, $npass);
     if( (($oldauth =~ /^unix/) && ($umode eq "internal")) ||   &logthis("Result of password change for $uname: ".$result);
  (($oldauth =~ /^internal/) && ($umode eq "unix")) ) {    if ($result eq "ok") {
  if(&is_author($udom, $uname)) {      &Reply($client, "$result\n")
     &Debug(" Need to manage author permissions...");   } else {
     &manage_permissions("/$udom/_au", $udom, $uname, "$umode:");      &Failure($client, "$result\n");
    }
       } else {
    my $result=&make_passwd_file($uname, $umode,$npass,$passfilename);
    #
    #  If the current auth mode is internal, and the old auth mode was
    #  unix, or krb*,  and the user is an author for this domain,
    #  re-run manage_permissions for that role in order to be able
    #  to take ownership of the construction space back to www:www
    #
   
   
    if( (($oldauth =~ /^unix/) && ($umode eq "internal")) ||
       (($oldauth =~ /^internal/) && ($umode eq "unix")) ) { 
       if(&is_author($udom, $uname)) {
    &Debug(" Need to manage author permissions...");
    &manage_permissions("/$udom/_au", $udom, $uname, "$umode:");
       }
  }   }
    &Reply($client, $result, $userinput);
     }      }
                 
   
     &Reply($client, $result, $userinput);  
  } else {          } else {       
     &Failure($client, "non_authorized\n", $userinput); # Fail the user now.      &Failure($client, "non_authorized\n", $userinput); # Fail the user now.
  }   }
Line 4392  sub ReadHostTable { Line 4405  sub ReadHostTable {
     open (CONFIG,"$perlvar{'lonTabDir'}/hosts.tab") || die "Can't read host file";      open (CONFIG,"$perlvar{'lonTabDir'}/hosts.tab") || die "Can't read host file";
     my $myloncapaname = $perlvar{'lonHostID'};      my $myloncapaname = $perlvar{'lonHostID'};
     Debug("My loncapa name is : $myloncapaname");      Debug("My loncapa name is : $myloncapaname");
       my %name_to_ip;
     while (my $configline=<CONFIG>) {      while (my $configline=<CONFIG>) {
  if ($configline !~ /^\s*\#/ && $configline !~ /^\s*$/ ) {   if ($configline !~ /^\s*\#/ && $configline !~ /^\s*$/ ) {
     my ($id,$domain,$role,$name)=split(/:/,$configline);      my ($id,$domain,$role,$name)=split(/:/,$configline);
     $name=~s/\s//g;      $name=~s/\s//g;
     my $ip = gethostbyname($name);      my $ip;
     if (length($ip) ne 4) {      if (!exists($name_to_ip{$name})) {
  &logthis("Skipping host $id name $name no IP $ip found\n");   $ip = gethostbyname($name);
  next;   if (!$ip || length($ip) ne 4) {
       &logthis("Skipping host $id name $name no IP found\n");
       next;
    }
    $ip=inet_ntoa($ip);
    $name_to_ip{$name} = $ip;
       } else {
    $ip = $name_to_ip{$name};
     }      }
     $ip=inet_ntoa($ip);  
     $hostid{$ip}=$id;         # LonCAPA name of host by IP.      $hostid{$ip}=$id;         # LonCAPA name of host by IP.
     $hostdom{$id}=$domain;    # LonCAPA domain name of host.       $hostdom{$id}=$domain;    # LonCAPA domain name of host. 
     $hostip{$id}=$ip;         # IP address of host.      $hostip{$id}=$ip;         # IP address of host.
Line 4768  $SIG{USR2} = \&UpdateHosts; Line 4788  $SIG{USR2} = \&UpdateHosts;
   
 ReadHostTable;  ReadHostTable;
   
   my $dist=`$perlvar{'lonDaemons'}/distprobe`;
   
 # --------------------------------------------------------------  # --------------------------------------------------------------
 #   Accept connections.  When a connection comes in, it is validated  #   Accept connections.  When a connection comes in, it is validated
 #   and if good, a child process is created to process transactions  #   and if good, a child process is created to process transactions
Line 4843  sub make_new_child { Line 4865  sub make_new_child {
 #        my $tmpsnum=0;            # Now global  #        my $tmpsnum=0;            # Now global
 #---------------------------------------------------- kerberos 5 initialization  #---------------------------------------------------- kerberos 5 initialization
         &Authen::Krb5::init_context();          &Authen::Krb5::init_context();
         &Authen::Krb5::init_ets();   if ($dist ne 'fedora4') {
       &Authen::Krb5::init_ets();
    }
   
  &status('Accepted connection');   &status('Accepted connection');
 # =============================================================================  # =============================================================================
Line 5053  sub is_author { Line 5077  sub is_author {
 #    user      - Name of the user for which the role is being put.  #    user      - Name of the user for which the role is being put.
 #    authtype  - The authentication type associated with the user.  #    authtype  - The authentication type associated with the user.
 #  #
 sub manage_permissions  sub manage_permissions {
 {  
   
   
     my ($request, $domain, $user, $authtype) = @_;      my ($request, $domain, $user, $authtype) = @_;
   
     &Debug("manage_permissions: $request $domain $user $authtype");      &Debug("manage_permissions: $request $domain $user $authtype");
   
     # See if the request is of the form /$domain/_au      # See if the request is of the form /$domain/_au
     if($request =~ /^(\/$domain\/_au)$/) { # It's an author rolesput...      if($request =~ /^(\/\Q$domain\E\/_au)$/) { # It's an author rolesput...
  my $execdir = $perlvar{'lonDaemons'};   my $execdir = $perlvar{'lonDaemons'};
  my $userhome= "/home/$user" ;   my $userhome= "/home/$user" ;
  &logthis("system $execdir/lchtmldir $userhome $user $authtype");   &logthis("system $execdir/lchtmldir $userhome $user $authtype");
Line 5455  sub thisversion { Line 5476  sub thisversion {
 sub subscribe {  sub subscribe {
     my ($userinput,$clientip)=@_;      my ($userinput,$clientip)=@_;
     my $result;      my $result;
     my ($cmd,$fname)=split(/:/,$userinput);      my ($cmd,$fname)=split(/:/,$userinput,2);
     my $ownership=&ishome($fname);      my $ownership=&ishome($fname);
     if ($ownership eq 'owner') {      if ($ownership eq 'owner') {
 # explitly asking for the current version?  # explitly asking for the current version?
Line 5499  sub subscribe { Line 5520  sub subscribe {
     }      }
     return $result;      return $result;
 }  }
   #  Change the passwd of a unix user.  The caller must have
   #  first verified that the user is a loncapa user.
   #
   # Parameters:
   #    user      - Unix user name to change.
   #    pass      - New password for the user.
   # Returns:
   #    ok    - if success
   #    other - Some meaningfule error message string.
   # NOTE:
   #    invokes a setuid script to change the passwd.
   sub change_unix_password {
       my ($user, $pass) = @_;
   
       &Debug("change_unix_password");
       my $execdir=$perlvar{'lonDaemons'};
       &Debug("Opening lcpasswd pipeline");
       my $pf = IO::File->new("|$execdir/lcpasswd > "
      ."$perlvar{'lonDaemons'}"
      ."/logs/lcpasswd.log");
       print $pf "$user\n$pass\n$pass\n";
       close $pf;
       my $err = $?;
       return ($err < @passwderrors) ? $passwderrors[$err] : 
    "pwchange_falure - unknown error";
   
       
   }
   
   
 sub make_passwd_file {  sub make_passwd_file {
     my ($uname, $umode,$npass,$passfilename)=@_;      my ($uname, $umode,$npass,$passfilename)=@_;
Removed from v.1.285  
changed lines
  Added in v.1.296

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