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

Diff for /loncom/lond between versions 1.500 and 1.505

version 1.500, 2013/04/11 14:59:29 version 1.505, 2014/01/01 17:41:37
Line 130  my @passwderrors = ("ok", Line 130  my @passwderrors = ("ok",
    "pwchange_failure - lcpasswd Error filename is invalid");     "pwchange_failure - lcpasswd Error filename is invalid");
   
   
 #  The array below are lcuseradd error strings.:  
   
 my $lastadderror = 13;  
 my @adderrors    = ("ok",  
     "User ID mismatch, lcuseradd must run as user www",  
     "lcuseradd Incorrect number of command line parameters must be 3",  
     "lcuseradd Incorrect number of stdinput lines, must be 3",  
     "lcuseradd Too many other simultaneous pwd changes in progress",  
     "lcuseradd User does not exist",  
     "lcuseradd Unable to make www member of users's group",  
     "lcuseradd Unable to su to root",  
     "lcuseradd Unable to set password",  
     "lcuseradd Username has invalid characters",  
     "lcuseradd Password has an invalid character",  
     "lcuseradd User already exists",  
     "lcuseradd Could not add user.",  
     "lcuseradd Password mismatch");  
   
   
 # This array are the errors from lcinstallfile:  # This array are the errors from lcinstallfile:
   
 my @installerrors = ("ok",  my @installerrors = ("ok",
Line 1704  sub read_lonnet_global { Line 1685  sub read_lonnet_global {
 sub server_devalidatecache_handler {  sub server_devalidatecache_handler {
     my ($cmd,$tail,$client) = @_;      my ($cmd,$tail,$client) = @_;
     my $userinput = "$cmd:$tail";      my $userinput = "$cmd:$tail";
     my ($name,$id) = map { &unescape($_); } split(/:/,$tail);      my $items = &unescape($tail);
     &Apache::lonnet::devalidate_cache_new($name,$id);      my @cached = split(/\&/,$items);
       foreach my $key (@cached) {
           if ($key =~ /:/) {
               my ($name,$id) = map { &unescape($_); } split(/:/,$key);
               &Apache::lonnet::devalidate_cache_new($name,$id);
           }
       }
     my $result = 'ok';      my $result = 'ok';
     &Reply($client,\$result,$userinput);      &Reply($client,\$result,$userinput);
     return 1;      return 1;
Line 2131  sub change_authentication_handler { Line 2118  sub change_authentication_handler {
  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!!
     # If just changing the unix passwd. need to arrange to run      # If just changing the unix passwd. need to arrange to run
     # passwd since otherwise make_passwd_file will run      # passwd since otherwise make_passwd_file will fail as 
     # lcuseradd which fails if an account already exists      # creation of unix authenticated users is no longer supported
     # (to prevent an unscrupulous LONCAPA admin from stealing              # except from the command line, when running make_domain_coordinator.pl
     # an existing account by overwriting it as a LonCAPA account).  
   
     if(($oldauth =~/^unix/) && ($umode eq "unix")) {      if(($oldauth =~/^unix/) && ($umode eq "unix")) {
  my $result = &change_unix_password($uname, $npass);   my $result = &change_unix_password($uname, $npass);
Line 2152  sub change_authentication_handler { Line 2138  sub change_authentication_handler {
  #  re-run manage_permissions for that role in order to be able   #  re-run manage_permissions for that role in order to be able
  #  to take ownership of the construction space back to www:www   #  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);
     }      }
                 
Line 3858  sub put_course_id_hash_handler { Line 3837  sub put_course_id_hash_handler {
 #                 creationcontext - include courses created in specified context   #                 creationcontext - include courses created in specified context 
 #  #
 #                 domcloner - flag to indicate if user can create CCs in course's domain.  #                 domcloner - flag to indicate if user can create CCs in course's domain.
 #                             If so, ability to clone course is automatic.   #                             If so, ability to clone course is automatic.
   #                 hasuniquecode - filter by courses for which a six character unique code has 
   #                                 been set.
 #  #
 #     $client  - The socket open on the client.  #     $client  - The socket open on the client.
 # Returns:  # Returns:
Line 3883  sub dump_course_id_handler { Line 3864  sub dump_course_id_handler {
     my ($udom,$since,$description,$instcodefilter,$ownerfilter,$coursefilter,      my ($udom,$since,$description,$instcodefilter,$ownerfilter,$coursefilter,
         $typefilter,$regexp_ok,$rtn_as_hash,$selfenrollonly,$catfilter,$showhidden,          $typefilter,$regexp_ok,$rtn_as_hash,$selfenrollonly,$catfilter,$showhidden,
         $caller,$cloner,$cc_clone_list,$cloneonly,$createdbefore,$createdafter,          $caller,$cloner,$cc_clone_list,$cloneonly,$createdbefore,$createdafter,
         $creationcontext,$domcloner) =split(/:/,$tail);          $creationcontext,$domcloner,$hasuniquecode) =split(/:/,$tail);
     my $now = time;      my $now = time;
     my ($cloneruname,$clonerudom,%cc_clone);      my ($cloneruname,$clonerudom,%cc_clone);
     if (defined($description)) {      if (defined($description)) {
Line 3956  sub dump_course_id_handler { Line 3937  sub dump_course_id_handler {
     } else {      } else {
         $creationcontext = '.';          $creationcontext = '.';
     }      }
       unless ($hasuniquecode) {
           $hasuniquecode = '.';
       }
     my $unpack = 1;      my $unpack = 1;
     if ($description eq '.' && $instcodefilter eq '.' && $ownerfilter eq '.' &&       if ($description eq '.' && $instcodefilter eq '.' && $ownerfilter eq '.' && 
         $typefilter eq '.') {          $typefilter eq '.') {
Line 4044  sub dump_course_id_handler { Line 4028  sub dump_course_id_handler {
                 $selfenroll_end = $items->{'selfenroll_end_date'};                  $selfenroll_end = $items->{'selfenroll_end_date'};
                 $created = $items->{'created'};                  $created = $items->{'created'};
                 $context = $items->{'context'};                  $context = $items->{'context'};
                   if ($hasuniquecode ne '.') {
                       next unless ($items->{'uniquecode'});
                   }
                 if ($selfenrollonly) {                  if ($selfenrollonly) {
                     next if (!$selfenroll_types);                      next if (!$selfenroll_types);
                     if (($selfenroll_end > 0) && ($selfenroll_end <= $now)) {                      if (($selfenroll_end > 0) && ($selfenroll_end <= $now)) {
Line 4466  sub get_id_handler { Line 4453  sub get_id_handler {
 }  }
 &register_handler("idget", \&get_id_handler, 0, 1, 0);  &register_handler("idget", \&get_id_handler, 0, 1, 0);
   
   #   Deletes one or more ids in a domain's id database.
   #
   #   Parameters:
   #       $cmd                  - Command keyword (iddel).
   #       $tail                 - Command tail.  In this case a colon
   #                               separated list containing:
   #                               The domain for which we are deleting the id(s).
   #                               &-separated list of id(s) to delete.
   #       $client               - File open on client socket.
   # Returns:
   #     1   - Continue processing
   #     0   - Exit server.
   #     
   #
   
   sub del_id_handler {
       my ($cmd,$tail,$client) = @_;
   
       my $userinput = "$cmd:$tail";
   
       my ($udom,$what)=split(/:/,$tail);
       chomp($what);
       my $hashref = &tie_domain_hash($udom, "ids", &GDBM_WRCREAT(),
                                      "D", $what);
       if ($hashref) {
           my @keys=split(/\&/,$what);
           foreach my $key (@keys) {
               delete($hashref->{$key});
           }
           if (&untie_user_hash($hashref)) {
               &Reply($client, "ok\n", $userinput);
           } else {
               &Failure($client, "error: ".($!+0)." untie(GDBM) Failed ".
                       "while attempting iddel\n", $userinput);
           }
       } else {
           &Failure( $client, "error: ".($!+0)." tie(GDBM) Failed ".
                    "while attempting iddel\n", $userinput);
       }
       return 1;
   }
   &register_handler("iddel", \&del_id_handler, 0, 1, 0);
   
 #  #
 # Puts broadcast e-mail sent by Domain Coordinator in nohist_dcmail database   # Puts broadcast e-mail sent by Domain Coordinator in nohist_dcmail database 
 #  #
Line 5990  sub lcpasswdstrerror { Line 6020  sub lcpasswdstrerror {
     }      }
 }  }
   
 #  
 # Convert an error return code from lcuseradd to a string value:  
 #  
 sub lcuseraddstrerror {  
     my $ErrorCode = shift;  
     if(($ErrorCode < 0) || ($ErrorCode > $lastadderror)) {  
  return "lcuseradd - Unrecognized error code: ".$ErrorCode;  
     } else {  
  return $adderrors[$ErrorCode];  
     }  
 }  
   
 # grabs exception and records it to log before exiting  # grabs exception and records it to log before exiting
 sub catchexception {  sub catchexception {
     my ($error)=@_;      my ($error)=@_;
Line 6492  sub make_new_child { Line 6510  sub make_new_child {
         &Authen::Krb5::init_context();          &Authen::Krb5::init_context();
  unless (($dist eq 'fedora5') || ($dist eq 'fedora4') ||     unless (($dist eq 'fedora5') || ($dist eq 'fedora4') ||  
  ($dist eq 'fedora6') || ($dist eq 'suse9.3') ||   ($dist eq 'fedora6') || ($dist eq 'suse9.3') ||
                 ($dist eq 'suse12.2') || ($dist eq 'suse12.3')) {                  ($dist eq 'suse12.2') || ($dist eq 'suse12.3') ||
                   ($dist eq 'suse13.1')) {
     &Authen::Krb5::init_ets();      &Authen::Krb5::init_ets();
  }   }
   
Line 7295  sub make_passwd_file { Line 7314  sub make_passwd_file {
     }      }
  }   }
     } elsif ($umode eq 'unix') {      } elsif ($umode eq 'unix') {
  {   &logthis(">>>Attempt to create unix account blocked -- unix auth not available for new users.");
     #   $result="no_new_unix_accounts";
     #  Don't allow the creation of privileged accounts!!! that would  
     #  be real bad!!!  
     #  
     my $uid = getpwnam($uname);  
     if((defined $uid) && ($uid == 0)) {  
  &logthis(">>>Attempt to create privileged account blocked");  
  return "no_priv_account_error\n";  
     }  
   
     my $execpath       ="$perlvar{'lonDaemons'}/"."lcuseradd";  
   
     my $lc_error_file  = $execdir."/tmp/lcuseradd".$$.".status";  
     {  
  &Debug("Executing external: ".$execpath);  
  &Debug("user  = ".$uname.", Password =". $npass);  
  my $se = IO::File->new("|$execpath > $perlvar{'lonDaemons'}/logs/lcuseradd.log");  
  print $se "$uname\n";  
                 print $se "$udom\n";  
  print $se "$npass\n";  
  print $se "$npass\n";  
  print $se "$lc_error_file\n"; # Status -> unique file.  
     }  
     if (-r $lc_error_file) {  
  &Debug("Opening error file: $lc_error_file");  
  my $error = IO::File->new("< $lc_error_file");  
  my $useraddok = <$error>;  
  $error->close;  
  unlink($lc_error_file);  
   
  chomp $useraddok;  
   
  if($useraddok > 0) {  
     my $error_text = &lcuseraddstrerror($useraddok);  
     &logthis("Failed lcuseradd: $error_text");  
     $result = "lcuseradd_failed:$error_text";  
  }  else {  
     my $pf = IO::File->new(">$passfilename");  
     if($pf) {  
  print $pf "unix:\n";  
     } else {  
  $result = "pass_file_failed_error";  
     }  
  }  
     }  else {  
  &Debug("Could not locate lcuseradd error: $lc_error_file");  
  $result="bug_lcuseradd_no_output_file";  
     }  
  }  
     } elsif ($umode eq 'none') {      } elsif ($umode eq 'none') {
  {   {
     my $pf = IO::File->new("> $passfilename");      my $pf = IO::File->new("> $passfilename");
Removed from v.1.500  
changed lines
  Added in v.1.505

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