Diff for /loncom/lond between versions 1.489.2.6 and 1.489.2.17

version 1.489.2.6, 2013/08/04 03:13:39 version 1.489.2.17, 2015/03/12 00:37:30
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 640  sub ConfigFileFromSelector { Line 621  sub ConfigFileFromSelector {
 #     String to send to client ("ok" or "refused" if bad file).  #     String to send to client ("ok" or "refused" if bad file).
 #  #
 sub PushFile {  sub PushFile {
     my $request = shift;          my $request = shift;
     my ($command, $filename, $contents) = split(":", $request, 3);      my ($command, $filename, $contents) = split(":", $request, 3);
     &Debug("PushFile");      &Debug("PushFile");
           
Line 670  sub PushFile { Line 651  sub PushFile {
   
     if($filename eq "host") {      if($filename eq "host") {
  $contents = AdjustHostContents($contents);   $contents = AdjustHostContents($contents);
       } elsif ($filename eq 'dns_host' || $filename eq 'dns_domain') {
           if ($contents eq '') {
               &logthis('<font color="red"> Pushfile: unable to install '
                       .$tablefile." - no data received from push. </font>");
               return 'error: push had no data';
           }
           if (&Apache::lonnet::get_host_ip($clientname)) {
               my $clienthost = &Apache::lonnet::hostname($clientname);
               if ($managers{$clientip} eq $clientname) {
                   my $clientprotocol = $Apache::lonnet::protocol{$clientname};
                   $clientprotocol = 'http' if ($clientprotocol ne 'https');
                   my $url = '/adm/'.$filename;
                   $url =~ s{_}{/};
                   my $ua=new LWP::UserAgent;
                   $ua->timeout(60);
                   my $request=new HTTP::Request('GET',"$clientprotocol://$clienthost$url");
                   my $response=$ua->request($request);
                   if ($response->is_error()) {
                       &logthis('<font color="red"> Pushfile: unable to install '
                               .$tablefile." - error attempting to pull data. </font>");
                       return 'error: pull failed';
                   } else {
                       my $result = $response->content;
                       chomp($result);
                       unless ($result eq $contents) {
                           &logthis('<font color="red"> Pushfile: unable to install '
                                   .$tablefile." - pushed data and pulled data differ. </font>");
                           my $pushleng = length($contents);
                           my $pullleng = length($result);
                           if ($pushleng != $pullleng) {
                               return "error: $pushleng vs $pullleng bytes";
                           } else {
                               return "error: mismatch push and pull";
                           }
                       }
                   }
               }
           }
     }      }
   
     #  Install the new file:      #  Install the new file:
Line 1704  sub read_lonnet_global { Line 1723  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 2135  sub change_authentication_handler { Line 2160  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 2156  sub change_authentication_handler { Line 2180  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 2795  sub newput_user_profile_entry { Line 2812  sub newput_user_profile_entry {
     foreach my $pair (@pairs) {      foreach my $pair (@pairs) {
  my ($key,$value)=split(/=/,$pair);   my ($key,$value)=split(/=/,$pair);
  if (exists($hashref->{$key})) {   if (exists($hashref->{$key})) {
               if (!&untie_user_hash($hashref)) {
                   &logthis("error: ".($!+0)." untie (GDBM) failed ".
                            "while attempting newput - early out as key exists");
               }
     &Failure($client, "key_exists: ".$key."\n",$userinput);      &Failure($client, "key_exists: ".$key."\n",$userinput);
     return 1;      return 1;
  }   }
Line 3298  sub dump_with_regexp { Line 3319  sub dump_with_regexp {
 #                          namespace   - Name of the database being modified  #                          namespace   - Name of the database being modified
 #                          rid         - Resource keyword to modify.  #                          rid         - Resource keyword to modify.
 #                          what        - new value associated with rid.  #                          what        - new value associated with rid.
   #                          laststore   - (optional) version=timestamp
   #                                        for most recent transaction for rid
   #                                        in namespace, when cstore was called
 #  #
 #    $client             - Socket open on the client.  #    $client             - Socket open on the client.
 #  #
Line 3306  sub dump_with_regexp { Line 3330  sub dump_with_regexp {
 #      1 (keep on processing).  #      1 (keep on processing).
 #  Side-Effects:  #  Side-Effects:
 #    Writes to the client  #    Writes to the client
   #    Successful storage will cause either 'ok', or, if $laststore was included
   #    in the tail of the request, and the version number for the last transaction
   #    is larger than the version in $laststore, delay:$numtrans , where $numtrans
   #    is the number of store evevnts recorded for rid in namespace since
   #    lonnet::store() was called by the client.
   #
 sub store_handler {  sub store_handler {
     my ($cmd, $tail, $client) = @_;      my ($cmd, $tail, $client) = @_;
     
     my $userinput = "$cmd:$tail";      my $userinput = "$cmd:$tail";
   
     my ($udom,$uname,$namespace,$rid,$what) =split(/:/,$tail);      chomp($tail);
       my ($udom,$uname,$namespace,$rid,$what,$laststore) =split(/:/,$tail);
     if ($namespace ne 'roles') {      if ($namespace ne 'roles') {
   
  chomp($what);  
  my @pairs=split(/\&/,$what);   my @pairs=split(/\&/,$what);
  my $hashref  = &tie_user_hash($udom, $uname, $namespace,   my $hashref  = &tie_user_hash($udom, $uname, $namespace,
        &GDBM_WRCREAT(), "S",         &GDBM_WRCREAT(), "S",
        "$rid:$what");         "$rid:$what");
  if ($hashref) {   if ($hashref) {
     my $now = time;      my $now = time;
     my @previouskeys=split(/&/,$hashref->{"keys:$rid"});              my $numtrans;
     my $key;              if ($laststore) {
                   my ($previousversion,$previoustime) = split(/\=/,$laststore);
                   my ($lastversion,$lasttime) = (0,0);
                   $lastversion = $hashref->{"version:$rid"};
                   if ($lastversion) {
                       $lasttime = $hashref->{"$lastversion:$rid:timestamp"};
                   }
                   if (($previousversion) && ($previousversion !~ /\D/)) {
                       if (($lastversion > $previousversion) && ($lasttime >= $previoustime)) {
                           $numtrans = $lastversion - $previousversion;
                       }
                   } elsif ($lastversion) {
                       $numtrans = $lastversion;
                   }
                   if ($numtrans) {
                       $numtrans =~ s/D//g;
                   }
               }
   
     $hashref->{"version:$rid"}++;      $hashref->{"version:$rid"}++;
     my $version=$hashref->{"version:$rid"};      my $version=$hashref->{"version:$rid"};
     my $allkeys='';       my $allkeys=''; 
Line 3335  sub store_handler { Line 3383  sub store_handler {
     $allkeys.='timestamp';      $allkeys.='timestamp';
     $hashref->{"$version:keys:$rid"}=$allkeys;      $hashref->{"$version:keys:$rid"}=$allkeys;
     if (&untie_user_hash($hashref)) {      if (&untie_user_hash($hashref)) {
  &Reply($client, "ok\n", $userinput);                  my $msg = 'ok';
                   if ($numtrans) {
                       $msg = 'delay:'.$numtrans;
                   }
                   &Reply($client, "$msg\n", $userinput);
     } else {      } else {
  &Failure($client, "error: ".($!+0)." untie(GDBM) Failed ".   &Failure($client, "error: ".($!+0)." untie(GDBM) Failed ".
  "while attempting store\n", $userinput);   "while attempting store\n", $userinput);
Line 3851  sub put_course_id_hash_handler { Line 3903  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 3865  sub dump_course_id_handler { Line 3919  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 3938  sub dump_course_id_handler { Line 3992  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 4026  sub dump_course_id_handler { Line 4083  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 4448  sub get_id_handler { Line 4508  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.  #   Deletes one or more ids in a domain's id database.
 #  #
 #   Parameters:  #   Parameters:
 #       $cmd                  - Command keyword (iddel).  #       $cmd                  - Command keyword (iddel).
Line 5258  sub crsreq_checks_handler { Line 5318  sub crsreq_checks_handler {
     my $userinput = "$cmd:$tail";      my $userinput = "$cmd:$tail";
     my $dom = $tail;      my $dom = $tail;
     my $result;      my $result;
     my @reqtypes = ('official','unofficial','community');      my @reqtypes = ('official','unofficial','community','textbook');
     eval {      eval {
         local($SIG{__DIE__})='DEFAULT';          local($SIG{__DIE__})='DEFAULT';
         my %validations;          my %validations;
Line 5285  sub crsreq_checks_handler { Line 5345  sub crsreq_checks_handler {
 sub validate_crsreq_handler {  sub validate_crsreq_handler {
     my ($cmd, $tail, $client) = @_;      my ($cmd, $tail, $client) = @_;
     my $userinput = "$cmd:$tail";      my $userinput = "$cmd:$tail";
     my ($dom,$owner,$crstype,$inststatuslist,$instcode,$instseclist) = split(/:/, $tail);      my ($dom,$owner,$crstype,$inststatuslist,$instcode,$instseclist,$customdata) = split(/:/, $tail);
     $instcode = &unescape($instcode);      $instcode = &unescape($instcode);
     $owner = &unescape($owner);      $owner = &unescape($owner);
     $crstype = &unescape($crstype);      $crstype = &unescape($crstype);
     $inststatuslist = &unescape($inststatuslist);      $inststatuslist = &unescape($inststatuslist);
     $instcode = &unescape($instcode);      $instcode = &unescape($instcode);
     $instseclist = &unescape($instseclist);      $instseclist = &unescape($instseclist);
       my $custominfo = &Apache::lonnet::thaw_unescape($customdata);
     my $outcome;      my $outcome;
     eval {      eval {
         local($SIG{__DIE__})='DEFAULT';          local($SIG{__DIE__})='DEFAULT';
         $outcome = &localenroll::validate_crsreq($dom,$owner,$crstype,          $outcome = &localenroll::validate_crsreq($dom,$owner,$crstype,
                                                  $inststatuslist,$instcode,                                                   $inststatuslist,$instcode,
                                                  $instseclist);                                                   $instseclist,$custominfo);
     };      };
     if (!$@) {      if (!$@) {
         &Reply($client, \$outcome, $userinput);          &Reply($client, \$outcome, $userinput);
Line 5308  sub validate_crsreq_handler { Line 5369  sub validate_crsreq_handler {
 }  }
 &register_handler("autocrsreqvalidation", \&validate_crsreq_handler, 0, 1, 0);  &register_handler("autocrsreqvalidation", \&validate_crsreq_handler, 0, 1, 0);
   
   sub crsreq_update_handler {
       my ($cmd, $tail, $client) = @_;
       my $userinput = "$cmd:$tail";
       my ($cdom,$cnum,$crstype,$action,$ownername,$ownerdomain,$fullname,$title,$code,
           $accessstart,$accessend,$infohashref) =
           split(/:/, $tail);
       $crstype = &unescape($crstype);
       $action = &unescape($action);
       $ownername = &unescape($ownername);
       $ownerdomain = &unescape($ownerdomain);
       $fullname = &unescape($fullname);
       $title = &unescape($title);
       $code = &unescape($code);
       $accessstart = &unescape($accessstart);
       $accessend = &unescape($accessend);
       my $incoming = &Apache::lonnet::thaw_unescape($infohashref);
       my ($result,$outcome);
       eval {
           local($SIG{__DIE__})='DEFAULT';
           my %rtnhash;
           $outcome = &localenroll::crsreq_updates($cdom,$cnum,$crstype,$action,
                                                   $ownername,$ownerdomain,$fullname,
                                                   $title,$code,$accessstart,$accessend,
                                                   $incoming,\%rtnhash);
           if ($outcome eq 'ok') {
               my @posskeys = qw(createdweb createdmsg queuedweb queuedmsg formitems reviewweb);
               foreach my $key (keys(%rtnhash)) {
                   if (grep(/^\Q$key\E/,@posskeys)) {
                       $result .= &escape($key).'='.&Apache::lonnet::freeze_escape($rtnhash{$key}).'&';
                   }
               }
               $result =~ s/\&$//;
           }
       };
       if (!$@) {
           if ($outcome eq 'ok') {
               &Reply($client, \$result, $userinput);
           } else {
               &Reply($client, "format_error\n", $userinput);
           }
       } else {
           &Failure($client,"unknown_cmd\n",$userinput);
       }
       return 1;
   }
   &register_handler("autocrsrequpdate", \&crsreq_update_handler, 0, 1, 0);
   
 #  #
 #   Read and retrieve institutional code format (for support form).  #   Read and retrieve institutional code format (for support form).
 # Formal Parameters:  # Formal Parameters:
Line 6015  sub lcpasswdstrerror { Line 6123  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 6512  sub make_new_child { Line 6608  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();
  unless (($dist eq 'fedora5') || ($dist eq 'fedora4') ||    
  ($dist eq 'fedora6') || ($dist eq 'suse9.3') ||          my $no_ets;
                 ($dist eq 'suse12.2') || ($dist eq 'suse12.3')) {          if ($dist =~ /^(?:centos|rhes|scientific)(\d+)$/) {
     &Authen::Krb5::init_ets();              if ($1 >= 7) {
  }                  $no_ets = 1;
               }
           } elsif ($dist =~ /^suse(\d+\.\d+)$/) {
               if (($1 eq '9.3') || ($1 >= 12.2)) {
                   $no_ets = 1;
               }
           } elsif ($dist =~ /^sles(\d+)$/) {
               if ($1 > 11) {
                   $no_ets = 1;
               }
           } elsif ($dist =~ /^fedora(\d+)$/) {
               if ($1 < 7) {
                   $no_ets = 1;
               }
           }
           unless ($no_ets) {
               &Authen::Krb5::init_ets();
           }
   
  &status('Accepted connection');   &status('Accepted connection');
 # =============================================================================  # =============================================================================
Line 7316  sub make_passwd_file { Line 7429  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.489.2.6  
changed lines
  Added in v.1.489.2.17


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