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

Diff for /loncom/lond between versions 1.489.2.20 and 1.489.2.33

version 1.489.2.20, 2016/08/11 09:52:39 version 1.489.2.33, 2019/08/22 14:51:51
Line 15 Line 15
 #  #
 # LON-CAPA is distributed in the hope that it will be useful,  # LON-CAPA is distributed in the hope that it will be useful,
 # but WITHOUT ANY WARRANTY; without even the implied warranty of  # but WITHOUT ANY WARRANTY; without even the implied warranty of
   
 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the  # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 # GNU General Public License for more details.  # GNU General Public License for more details.
 #  #
Line 55  use LONCAPA::lonssl; Line 54  use LONCAPA::lonssl;
 use Fcntl qw(:flock);  use Fcntl qw(:flock);
 use Apache::lonnet;  use Apache::lonnet;
 use Mail::Send;  use Mail::Send;
   use Crypt::Eksblowfish::Bcrypt;
   use Digest::SHA;
   use Encode;
   
 my $DEBUG = 0;       # Non zero to enable debug log entries.  my $DEBUG = 0;       # Non zero to enable debug log entries.
   
Line 1422  sub du2_handler { Line 1424  sub du2_handler {
 #    selected directory the filename followed by the full output of  #    selected directory the filename followed by the full output of
 #    the stat function is returned.  The returned info for each  #    the stat function is returned.  The returned info for each
 #    file are separated by ':'.  The stat fields are separated by &'s.  #    file are separated by ':'.  The stat fields are separated by &'s.
   #
   #    If the requested path contains /../ or is:
   #
   #    1. for a directory, and the path does not begin with one of:
   #        (a) /home/httpd/html/res/<domain>
   #        (b) /home/httpd/html/userfiles/
   #        (c) /home/httpd/lonUsers/<domain>/<1>/<2>/<3>/<username>/userfiles
   #    or is:
   #
   #    2. for a file, and the path (after prepending) does not begin with one of:
   #        (a) /home/httpd/lonUsers/<domain>/<1>/<2>/<3>/<username>/
   #        (b) /home/httpd/html/res/<domain>/<username>/
   #        (c) /home/httpd/html/userfiles/<domain>/<username>/
   #
   #    the response will be "refused".
   #
 # Parameters:  # Parameters:
 #    $cmd        - The command that dispatched us (ls).  #    $cmd        - The command that dispatched us (ls).
 #    $ulsdir     - The directory path to list... I'm not sure what this  #    $ulsdir     - The directory path to list... I'm not sure what this
Line 1443  sub ls_handler { Line 1461  sub ls_handler {
     my $rights;      my $rights;
     my $ulsout='';      my $ulsout='';
     my $ulsfn;      my $ulsfn;
       if ($ulsdir =~m{/\.\./}) {
           &Failure($client,"refused\n",$userinput);
           return 1;
       }
     if (-e $ulsdir) {      if (-e $ulsdir) {
  if(-d $ulsdir) {   if(-d $ulsdir) {
               unless (($ulsdir =~ m{^/home/httpd/html/(res/$LONCAPA::match_domain|userfiles/)}) ||
                       ($ulsdir =~ m{^/home/httpd/lonUsers/$LONCAPA::match_domain(?:/[\w\-.@]){3}/$LONCAPA::match_name/userfiles})) {
                   &Failure($client,"refused\n",$userinput);
                   return 1;
               }
     if (opendir(LSDIR,$ulsdir)) {      if (opendir(LSDIR,$ulsdir)) {
  while ($ulsfn=readdir(LSDIR)) {   while ($ulsfn=readdir(LSDIR)) {
     undef($obs);      undef($obs);
Line 1468  sub ls_handler { Line 1495  sub ls_handler {
  closedir(LSDIR);   closedir(LSDIR);
     }      }
  } else {   } else {
               unless (($ulsdir =~ m{^/home/httpd/lonUsers/$LONCAPA::match_domain(?:/[\w\-.@]){3}/$LONCAPA::match_name/}) ||
                       ($ulsdir =~ m{^/home/httpd/html/(?:res|userfiles)/$LONCAPA::match_domain/$LONCAPA::match_name/})) { 
                   &Failure($client,"refused\n",$userinput);
                   return 1;
               }
     my @ulsstats=stat($ulsdir);      my @ulsstats=stat($ulsdir);
     $ulsout.=$ulsfn.'&'.join('&',@ulsstats).':';      $ulsout.=$ulsfn.'&'.join('&',@ulsstats).':';
  }   }
Line 1492  sub ls_handler { Line 1524  sub ls_handler {
 #    selected directory the filename followed by the full output of  #    selected directory the filename followed by the full output of
 #    the stat function is returned.  The returned info for each  #    the stat function is returned.  The returned info for each
 #    file are separated by ':'.  The stat fields are separated by &'s.  #    file are separated by ':'.  The stat fields are separated by &'s.
   #
   #    If the requested path contains /../ or is:
   #
   #    1. for a directory, and the path does not begin with one of:
   #        (a) /home/httpd/html/res/<domain>
   #        (b) /home/httpd/html/userfiles/
   #        (c) /home/httpd/lonUsers/<domain>/<1>/<2>/<3>/<username>/userfiles
   #    or is:
   #
   #    2. for a file, and the path (after prepending) does not begin with one of:
   #        (a) /home/httpd/lonUsers/<domain>/<1>/<2>/<3>/<username>/
   #        (b) /home/httpd/html/res/<domain>/<username>/
   #        (c) /home/httpd/html/userfiles/<domain>/<username>/
   #
   #    the response will be "refused".
   #
 # Parameters:  # Parameters:
 #    $cmd        - The command that dispatched us (ls).  #    $cmd        - The command that dispatched us (ls).
 #    $ulsdir     - The directory path to list... I'm not sure what this  #    $ulsdir     - The directory path to list... I'm not sure what this
Line 1512  sub ls2_handler { Line 1560  sub ls2_handler {
     my $rights;      my $rights;
     my $ulsout='';      my $ulsout='';
     my $ulsfn;      my $ulsfn;
       if ($ulsdir =~m{/\.\./}) {
           &Failure($client,"refused\n",$userinput);
           return 1;
       }
     if (-e $ulsdir) {      if (-e $ulsdir) {
         if(-d $ulsdir) {          if(-d $ulsdir) {
               unless (($ulsdir =~ m{^/home/httpd/html/(res/$LONCAPA::match_domain|userfiles/)}) ||
                       ($ulsdir =~ m{^/home/httpd/lonUsers/$LONCAPA::match_domain(?:/[\w\-.@]){3}/$LONCAPA::match_name/userfiles})) {
                   &Failure($client,"refused\n","$userinput");
                   return 1;
               }
             if (opendir(LSDIR,$ulsdir)) {              if (opendir(LSDIR,$ulsdir)) {
                 while ($ulsfn=readdir(LSDIR)) {                  while ($ulsfn=readdir(LSDIR)) {
                     undef($obs);                      undef($obs);
Line 1538  sub ls2_handler { Line 1595  sub ls2_handler {
                 closedir(LSDIR);                  closedir(LSDIR);
             }              }
         } else {          } else {
               unless (($ulsdir =~ m{^/home/httpd/lonUsers/$LONCAPA::match_domain(?:/[\w\-.@]){3}/$LONCAPA::match_name/}) ||
                       ($ulsdir =~ m{^/home/httpd/html/(?:res|userfiles)/$LONCAPA::match_domain/$LONCAPA::match_name/})) {
                   &Failure($client,"refused\n",$userinput);
                   return 1;
               }
             my @ulsstats=stat($ulsdir);              my @ulsstats=stat($ulsdir);
             $ulsout.=$ulsfn.'&'.join('&',@ulsstats).':';              $ulsout.=$ulsfn.'&'.join('&',@ulsstats).':';
         }          }
Line 1554  sub ls2_handler { Line 1616  sub ls2_handler {
 #    selected directory the filename followed by the full output of  #    selected directory the filename followed by the full output of
 #    the stat function is returned.  The returned info for each  #    the stat function is returned.  The returned info for each
 #    file are separated by ':'.  The stat fields are separated by &'s.  #    file are separated by ':'.  The stat fields are separated by &'s.
   #
   #    If the requested path (after prepending) contains /../ or is:
   #
   #    1. for a directory, and the path does not begin with one of:
   #        (a) /home/httpd/html/res/<domain>
   #        (b) /home/httpd/html/userfiles/
   #        (c) /home/httpd/lonUsers/<domain>/<1>/<2>/<3>/<username>/userfiles
   #        (d) /home/httpd/html/priv/<domain> and client is the homeserver
   #
   #    or is:
   #
   #    2. for a file, and the path (after prepending) does not begin with one of:
   #        (a) /home/httpd/lonUsers/<domain>/<1>/<2>/<3>/<username>/
   #        (b) /home/httpd/html/res/<domain>/<username>/
   #        (c) /home/httpd/html/userfiles/<domain>/<username>/
   #        (d) /home/httpd/html/priv/<domain>/<username>/ and client is the homeserver
   #
   #    the response will be "refused".
   #
 # Parameters:  # Parameters:
 #    $cmd        - The command that dispatched us (ls).  #    $cmd        - The command that dispatched us (ls).
 #    $tail       - The tail of the request that invoked us.  #    $tail       - The tail of the request that invoked us.
Line 1593  sub ls3_handler { Line 1674  sub ls3_handler {
     }      }
   
     my $dir_root = $perlvar{'lonDocRoot'};      my $dir_root = $perlvar{'lonDocRoot'};
     if ($getpropath) {      if (($getpropath) || ($getuserdir)) {
         if (($uname =~ /^$LONCAPA::match_name$/) && ($udom =~ /^$LONCAPA::match_domain$/)) {          if (($uname =~ /^$LONCAPA::match_name$/) && ($udom =~ /^$LONCAPA::match_domain$/)) {
             $dir_root = &propath($udom,$uname);              $dir_root = &propath($udom,$uname);
             $dir_root =~ s/\/$//;              $dir_root =~ s/\/$//;
         } else {          } else {
             &Failure($client,"refused\n","$cmd:$tail");              &Failure($client,"refused\n",$userinput);
             return 1;  
         }  
     } elsif ($getuserdir) {  
         if (($uname =~ /^$LONCAPA::match_name$/) && ($udom =~ /^$LONCAPA::match_domain$/)) {  
             my $subdir=$uname.'__';  
             $subdir =~ s/(.)(.)(.).*/$1\/$2\/$3/;  
             $dir_root = $Apache::lonnet::perlvar{'lonUsersDir'}  
                        ."/$udom/$subdir/$uname";  
         } else {  
             &Failure($client,"refused\n","$cmd:$tail");  
             return 1;              return 1;
         }          }
     } elsif ($alternate_root ne '') {      } elsif ($alternate_root ne '') {
Line 1621  sub ls3_handler { Line 1692  sub ls3_handler {
             $ulsdir = $dir_root.'/'.$ulsdir;              $ulsdir = $dir_root.'/'.$ulsdir;
         }          }
     }      }
       if ($ulsdir =~m{/\.\./}) {
           &Failure($client,"refused\n",$userinput);
           return 1;
       }
       my $islocal;
       my @machine_ids = &Apache::lonnet::current_machine_ids();
       if (grep(/^\Q$clientname\E$/,@machine_ids)) {
           $islocal = 1;
       }
     my $obs;      my $obs;
     my $rights;      my $rights;
     my $ulsout='';      my $ulsout='';
     my $ulsfn;      my $ulsfn;
     if (-e $ulsdir) {      if (-e $ulsdir) {
         if(-d $ulsdir) {          if(-d $ulsdir) {
               unless (($getpropath) || ($getuserdir) ||
                       ($ulsdir =~ m{^/home/httpd/html/(res/$LONCAPA::match_domain|userfiles/)}) ||
                       ($ulsdir =~ m{^/home/httpd/lonUsers/$LONCAPA::match_domain(?:/[\w\-.@]){3}/$LONCAPA::match_name/userfiles}) ||
                       (($ulsdir =~ m{^/home/httpd/html/priv/$LONCAPA::match_domain}) && ($islocal))) {
                   &Failure($client,"refused\n",$userinput);
                   return 1;
               }
             if (opendir(LSDIR,$ulsdir)) {              if (opendir(LSDIR,$ulsdir)) {
                 while ($ulsfn=readdir(LSDIR)) {                  while ($ulsfn=readdir(LSDIR)) {
                     undef($obs);                      undef($obs);
Line 1651  sub ls3_handler { Line 1738  sub ls3_handler {
                 closedir(LSDIR);                  closedir(LSDIR);
             }              }
         } else {          } else {
               unless (($getpropath) || ($getuserdir) ||
                       ($ulsdir =~ m{^/home/httpd/lonUsers/$LONCAPA::match_domain(?:/[\w\-.@]){3}/$LONCAPA::match_name/}) ||
                       ($ulsdir =~ m{^/home/httpd/html/(?:res|userfiles)/$LONCAPA::match_domain/$LONCAPA::match_name/}) ||
                       (($ulsdir =~ m{^/home/httpd/html/priv/$LONCAPA::match_domain/$LONCAPA::match_name/}) && ($islocal))) {
                   &Failure($client,"refused\n",$userinput);
                   return 1;
               }
             my @ulsstats=stat($ulsdir);              my @ulsstats=stat($ulsdir);
             $ulsout.=$ulsfn.'&'.join('&',@ulsstats).':';              $ulsout.=$ulsfn.'&'.join('&',@ulsstats).':';
         }          }
Line 1701  sub read_lonnet_global { Line 1795  sub read_lonnet_global {
                 }                  }
                 if ($what eq 'perlvar') {                  if ($what eq 'perlvar') {
                     if (!exists($packagevars{$what}{'lonBalancer'})) {                      if (!exists($packagevars{$what}{'lonBalancer'})) {
                         if ($dist =~ /^(centos|rhes|fedora|scientific)/) {                          if ($dist =~ /^(centos|rhes|fedora|scientific|oracle)/) {
                             my $othervarref=LONCAPA::Configuration::read_conf('httpd.conf');                              my $othervarref=LONCAPA::Configuration::read_conf('httpd.conf');
                             if (ref($othervarref) eq 'HASH') {                              if (ref($othervarref) eq 'HASH') {
                                 $items->{'lonBalancer'} = $othervarref->{'lonBalancer'};                                  $items->{'lonBalancer'} = $othervarref->{'lonBalancer'};
Line 1926  sub authenticate_handler { Line 2020  sub authenticate_handler {
                 my ($remote,$hosted);                  my ($remote,$hosted);
                 my $remotesession = &get_usersession_config($udom,'remotesession');                  my $remotesession = &get_usersession_config($udom,'remotesession');
                 if (ref($remotesession) eq 'HASH') {                  if (ref($remotesession) eq 'HASH') {
                     $remote = $remotesession->{'remote'}                      $remote = $remotesession->{'remote'};
                 }                  }
                 my $hostedsession = &get_usersession_config($clienthomedom,'hostedsession');                  my $hostedsession = &get_usersession_config($clienthomedom,'hostedsession');
                 if (ref($hostedsession) eq 'HASH') {                  if (ref($hostedsession) eq 'HASH') {
Line 2013  sub change_password_handler { Line 2107  sub change_password_handler {
     }      }
     if($validated) {      if($validated) {
  my $realpasswd  = &get_auth_type($udom, $uname); # Defined since authd.   my $realpasswd  = &get_auth_type($udom, $uname); # Defined since authd.
   
  my ($howpwd,$contentpwd)=split(/:/,$realpasswd);   my ($howpwd,$contentpwd)=split(/:/,$realpasswd);
           my $notunique;
  if ($howpwd eq 'internal') {   if ($howpwd eq 'internal') {
     &Debug("internal auth");      &Debug("internal auth");
     my $salt=time;              my $ncpass = &hash_passwd($udom,$npass);
     $salt=substr($salt,6,2);              my (undef,$method,@rest) = split(/!/,$contentpwd);
     my $ncpass=crypt($npass,$salt);              if ($method eq 'bcrypt') {
     if(&rewrite_password_file($udom, $uname, "internal:$ncpass")) {                  my %passwdconf = &Apache::lonnet::get_passwdconf($udom);
                   if (($passwdconf{'numsaved'}) && ($passwdconf{'numsaved'} =~ /^\d+$/)) {
                       my @oldpasswds;
                       my $userpath = &propath($udom,$uname);
                       my $fullpath = $userpath.'/oldpasswds';
                       if (-d $userpath) {
                           my @oldfiles;
                           if (-e $fullpath) {
                               if (opendir(my $dir,$fullpath)) {
                                   (@oldfiles) = grep(/^\d+$/,readdir($dir));
                                   closedir($dir);
                               }
                               if (@oldfiles) {
                                   @oldfiles = sort { $b <=> $a } (@oldfiles);
                                   my $numremoved = 0;
                                   for (my $i=0; $i<@oldfiles; $i++) {
                                       if ($i>=$passwdconf{'numsaved'}) {
                                           if (-f "$fullpath/$oldfiles[$i]") {
                                               if (unlink("$fullpath/$oldfiles[$i]")) {
                                                   $numremoved ++;
                                               }
                                           }
                                       } elsif (open(my $fh,'<',"$fullpath/$oldfiles[$i]")) {
                                           while (my $line = <$fh>) {
                                               push(@oldpasswds,$line);
                                           }
                                           close($fh);
                                       }
                                   }
                                   if ($numremoved) {
                                       &logthis("unlinked $numremoved old password files for $uname:$udom");
                                   }
                               }
                           }
                           push(@oldpasswds,$contentpwd);
                           foreach my $item (@oldpasswds) {
                               my (undef,$method,@rest) = split(/!/,$item);
                               if ($method eq 'bcrypt') {
                                   my $result = &hash_passwd($udom,$npass,@rest);
                                   if ($result eq $item) {
                                       $notunique = 1;
                                       last;
                                   }
                               }
                           }
                           unless ($notunique) {
                               unless (-e $fullpath) {
                                   if (&mkpath("$fullpath/")) {
                                       chmod(0700,$fullpath);
                                   }
                               }
                               if (-d $fullpath) {
                                   my $now = time;
                                   if (open(my $fh,'>',"$fullpath/$now")) {
                                       print $fh $contentpwd;
                                       close($fh);
                                       chmod(0400,"$fullpath/$now");
                                   }
                               }
                           }
                       }
                   }
               }
               if ($notunique) {
                   my $msg="Result of password change for $uname:$udom - password matches one used before";
                   if ($lonhost) {
                       $msg .= " - request originated from: $lonhost";
                   }
                   &logthis($msg);
                   &Reply($client, "prioruse\n", $userinput);
       } elsif (&rewrite_password_file($udom, $uname, "internal:$ncpass")) {
  my $msg="Result of password change for $uname: pwchange_success";   my $msg="Result of password change for $uname: pwchange_success";
                 if ($lonhost) {                  if ($lonhost) {
                     $msg .= " - request originated from: $lonhost";                      $msg .= " - request originated from: $lonhost";
                 }                  }
                 &logthis($msg);                  &logthis($msg);
                   &update_passwd_history($uname,$udom,$howpwd,$context);
  &Reply($client, "ok\n", $userinput);   &Reply($client, "ok\n", $userinput);
     } else {      } else {
  &logthis("Unable to open $uname passwd "                  &logthis("Unable to open $uname passwd "               
Line 2034  sub change_password_handler { Line 2199  sub change_password_handler {
     }      }
  } elsif ($howpwd eq 'unix' && $context ne 'reset_by_email') {   } elsif ($howpwd eq 'unix' && $context ne 'reset_by_email') {
     my $result = &change_unix_password($uname, $npass);      my $result = &change_unix_password($uname, $npass);
               if ($result eq 'ok') {
                   &update_passwd_history($uname,$udom,$howpwd,$context);
               }
     &logthis("Result of password change for $uname: ".      &logthis("Result of password change for $uname: ".
      $result);       $result);
     &Reply($client, \$result, $userinput);      &Reply($client, \$result, $userinput);
Line 2044  sub change_password_handler { Line 2212  sub change_password_handler {
     #      #
     &Failure( $client, "auth_mode_error\n", $userinput);      &Failure( $client, "auth_mode_error\n", $userinput);
  }     }  
   
     } else {      } else {
  if ($failure eq '') {   if ($failure eq '') {
     $failure = 'non_authorized';      $failure = 'non_authorized';
Line 2056  sub change_password_handler { Line 2223  sub change_password_handler {
 }  }
 &register_handler("passwd", \&change_password_handler, 1, 1, 0);  &register_handler("passwd", \&change_password_handler, 1, 1, 0);
   
   sub hash_passwd {
       my ($domain,$plainpass,@rest) = @_;
       my ($salt,$cost);
       if (@rest) {
           $cost = $rest[0];
           # salt is first 22 characters, base-64 encoded by bcrypt
           my $plainsalt = substr($rest[1],0,22);
           $salt = Crypt::Eksblowfish::Bcrypt::de_base64($plainsalt);
       } else {
           my %domdefaults = &Apache::lonnet::get_domain_defaults($domain);
           my $defaultcost = $domdefaults{'intauth_cost'};
           if (($defaultcost eq '') || ($defaultcost =~ /D/)) {
               $cost = 10;
           } else {
               $cost = $defaultcost;
           }
           # Generate random 16-octet base64 salt
           $salt = "";
           $salt .= pack("C", int rand(256)) for 1..16;
       }
       my $hash = &Crypt::Eksblowfish::Bcrypt::bcrypt_hash({
           key_nul => 1,
           cost    => $cost,
           salt    => $salt,
       }, Digest::SHA::sha512(Encode::encode('UTF-8',$plainpass)));
   
       my $result = join("!", "", "bcrypt", sprintf("%02d",$cost),
                   &Crypt::Eksblowfish::Bcrypt::en_base64($salt).
                   &Crypt::Eksblowfish::Bcrypt::en_base64($hash));
       return $result;
   }
   
 #  #
 #   Create a new user.  User in this case means a lon-capa user.  #   Create a new user.  User in this case means a lon-capa user.
 #   The user must either already exist in some authentication realm  #   The user must either already exist in some authentication realm
Line 2099  sub add_user_handler { Line 2298  sub add_user_handler {
     ."makeuser";      ."makeuser";
     }      }
     unless ($fperror) {      unless ($fperror) {
  my $result=&make_passwd_file($uname,$udom,$umode,$npass, $passfilename);   my $result=&make_passwd_file($uname,$udom,$umode,$npass,
                                                $passfilename,'makeuser');
  &Reply($client,\$result, $userinput);     #BUGBUG - could be fail   &Reply($client,\$result, $userinput);     #BUGBUG - could be fail
     } else {      } else {
  &Failure($client, \$fperror, $userinput);   &Failure($client, \$fperror, $userinput);
Line 2168  sub change_authentication_handler { Line 2368  sub change_authentication_handler {
  my $result = &change_unix_password($uname, $npass);   my $result = &change_unix_password($uname, $npass);
  &logthis("Result of password change for $uname: ".$result);   &logthis("Result of password change for $uname: ".$result);
  if ($result eq "ok") {   if ($result eq "ok") {
                       &update_passwd_history($uname,$udom,$umode,'changeuserauth');
     &Reply($client, \$result);      &Reply($client, \$result);
  } else {   } else {
     &Failure($client, \$result);      &Failure($client, \$result);
  }   }
     } else {      } else {
  my $result=&make_passwd_file($uname,$udom,$umode,$npass,$passfilename);   my $result=&make_passwd_file($uname,$udom,$umode,$npass,
                                                $passfilename,'changeuserauth');
  #   #
  #  If the current auth mode is internal, and the old auth mode was   #  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,   #  unix, or krb*,  and the user is an author for this domain,
Line 2194  sub change_authentication_handler { Line 2396  sub change_authentication_handler {
 }  }
 &register_handler("changeuserauth", \&change_authentication_handler, 1,1, 0);  &register_handler("changeuserauth", \&change_authentication_handler, 1,1, 0);
   
   sub update_passwd_history {
       my ($uname,$udom,$umode,$context) = @_;
       my $proname=&propath($udom,$uname);
       my $now = time;
       if (open(my $fh,">>$proname/passwd.log")) {
           print $fh "$now:$umode:$context\n";
           close($fh);
       }
       return;
   }
   
 #  #
 #   Determines if this is the home server for a user.  The home server  #   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  #   for a user will have his/her lon-capa passwd file.  Therefore all we need
Line 2286  sub update_resource_handler { Line 2499  sub update_resource_handler {
  }   }
  alarm(0);   alarm(0);
  if ($response->is_error()) {   if ($response->is_error()) {
 # FIXME: we should probably clean up here instead of just whine                      my $reply=&Apache::lonnet::reply("unsub:$fname","$clientname");
     unlink($transname);                      &devalidate_meta_cache($fname);
                       if (-e $transname) {
                           unlink($transname);
                       }
                       unlink($fname);
     my $message=$response->status_line;      my $message=$response->status_line;
     &logthis("LWP GET: $message for $fname ($remoteurl)");      &logthis("LWP GET: $message for $fname ($remoteurl)");
  } else {   } else {
Line 3076  sub get_profile_entry { Line 3293  sub get_profile_entry {
 #  #
 #  Parameters:  #  Parameters:
 #     $cmd               - Command keyword of request (eget).  #     $cmd               - Command keyword of request (eget).
 #     $tail              - Tail of the command.  See GetProfileEntry #                          for more information about this.  #     $tail              - Tail of the command.  See GetProfileEntry
   #                          for more information about this.
 #     $client            - File open on the client.  #     $client            - File open on the client.
 #  Returns:  #  Returns:
 #     1      - Continue processing  #     1      - Continue processing
Line 3658  sub send_query_handler { Line 3876  sub send_query_handler {
   
     my ($query,$arg1,$arg2,$arg3)=split(/\:/,$tail);      my ($query,$arg1,$arg2,$arg3)=split(/\:/,$tail);
     $query=~s/\n*$//g;      $query=~s/\n*$//g;
       if (($query eq 'usersearch') || ($query eq 'instdirsearch')) {
           my $usersearchconf = &get_usersearch_config($currentdomainid,'directorysrch');
           my $earlyout;
           if (ref($usersearchconf) eq 'HASH') {
               if ($currentdomainid eq $clienthomedom) {
                   if ($query eq 'usersearch') {
                       if ($usersearchconf->{'lcavailable'} eq '0') {
                           $earlyout = 1;
                       }
                   } else {
                       if ($usersearchconf->{'available'} eq '0') {
                           $earlyout = 1;
                       }
                   }
               } else {
                   if ($query eq 'usersearch') {
                       if ($usersearchconf->{'lclocalonly'}) {
                           $earlyout = 1;
                       }
                   } else {
                       if ($usersearchconf->{'localonly'}) {
                           $earlyout = 1;
                       }
                   }
               }
           }
           if ($earlyout) {
               &Reply($client, "query_not_authorized\n");
               return 1;
           }
       }
     &Reply($client, "". &sql_reply("$clientname\&$query".      &Reply($client, "". &sql_reply("$clientname\&$query".
  "\&$arg1"."\&$arg2"."\&$arg3")."\n",   "\&$arg1"."\&$arg2"."\&$arg3")."\n",
   $userinput);    $userinput);
Line 4936  sub tmp_del_handler { Line 5185  sub tmp_del_handler {
 &register_handler("tmpdel", \&tmp_del_handler, 0, 1, 0);  &register_handler("tmpdel", \&tmp_del_handler, 0, 1, 0);
   
 #  #
   #  Process the delbalcookie command. This command deletes a balancer
   #  cookie in the lonBalancedir directory created by switchserver
   #
   # Parameters:
   #   $cmd      - Command that got us here.
   #   $cookie   - Cookie to be deleted.
   #   $client   - socket open on the client process.
   #
   # Returns:
   #   1     - Indicating processing should continue.
   # Side Effects:
   #   A cookie file is deleted from the lonBalancedir directory
   #   A reply is sent to the client.
   sub del_balcookie_handler {
       my ($cmd, $cookie, $client) = @_;
   
       my $userinput= "$cmd:$cookie";
   
       chomp($cookie);
       my $deleted = '';
       if ($cookie =~ /^$LONCAPA::match_domain\_$LONCAPA::match_username\_[a-f0-9]{32}$/) {
           my $execdir=$perlvar{'lonBalanceDir'};
           if (-e "$execdir/$cookie.id") {
               if (open(my $fh,'<',"$execdir/$cookie.id")) {
                   my $dodelete;
                   while (my $line = <$fh>) {
                       chomp($line);
                       if ($line eq $clientname) {
                           $dodelete = 1;
                           last;
                       }
                   }
                   close($fh);
                   if ($dodelete) {
                       if (unlink("$execdir/$cookie.id")) {
                           $deleted = 1;
                       }
                   }
               }
           }
       }
       if ($deleted) {
           &Reply($client, "ok\n", $userinput);
       } else {
           &Failure( $client, "error: ".($!+0)."Unlinking cookie file Failed ".
                     "while attempting delbalcookie\n", $userinput);
       }
       return 1;
   }
   &register_handler("delbalcookie", \&del_balcookie_handler, 0, 1, 0);
   
   #
 #   Processes the setannounce command.  This command  #   Processes the setannounce command.  This command
 #   creates a file named announce.txt in the top directory of  #   creates a file named announce.txt in the top directory of
 #   the documentn root and sets its contents.  The announce.txt file is  #   the documentn root and sets its contents.  The announce.txt file is
Line 5214  sub validate_course_section_handler { Line 5515  sub validate_course_section_handler {
 # Formal Parameters:  # Formal Parameters:
 #    $cmd     - The command request that got us dispatched.  #    $cmd     - The command request that got us dispatched.
 #    $tail    - The tail of the command.   In this case this is a colon separated  #    $tail    - The tail of the command.   In this case this is a colon separated
 #               set of words that will be split into:  #               set of values that will be split into:
 #               $inst_class  - Institutional code for the specific class section     #               $inst_class  - Institutional code for the specific class section   
 #               $courseowner - The escaped username:domain of the course owner   #               $ownerlist   - An escaped comma-separated list of username:domain
   #                              of the course owner, and co-owner(s).
 #               $cdom        - The domain of the course from the institution's  #               $cdom        - The domain of the course from the institution's
 #                              point of view.  #                              point of view.
 #    $client  - The socket open on the client.  #    $client  - The socket open on the client.
Line 5241  sub validate_class_access_handler { Line 5543  sub validate_class_access_handler {
 &register_handler("autovalidateclass_sec", \&validate_class_access_handler, 0, 1, 0);  &register_handler("autovalidateclass_sec", \&validate_class_access_handler, 0, 1, 0);
   
 #  #
   #   Validate course owner or co-owners(s) access to enrollment data for all sections
   #   and crosslistings for a particular course.
   #
   #
   # Formal Parameters:
   #    $cmd     - The command request that got us dispatched.
   #    $tail    - The tail of the command.   In this case this is a colon separated
   #               set of values that will be split into:
   #               $ownerlist   - An escaped comma-separated list of username:domain
   #                              of the course owner, and co-owner(s).
   #               $cdom        - The domain of the course from the institution's
   #                              point of view.
   #               $classes     - Frozen hash of institutional course sections and
   #                              crosslistings.
   #    $client  - The socket open on the client.
   # Returns:
   #    1 - continue processing.
   #
   
   sub validate_classes_handler {
       my ($cmd, $tail, $client) = @_;
       my $userinput = "$cmd:$tail";
       my ($ownerlist,$cdom,$classes) = split(/:/, $tail);
       my $classesref = &Apache::lonnet::thaw_unescape($classes);
       my $owners = &unescape($ownerlist);
       my $result;
       eval {
           local($SIG{__DIE__})='DEFAULT';
           my %validations;
           my $response = &localenroll::check_instclasses($owners,$cdom,$classesref,
                                                          \%validations);
           if ($response eq 'ok') {
               foreach my $key (keys(%validations)) {
                   $result .= &escape($key).'='.&Apache::lonnet::freeze_escape($validations{$key}).'&';
               }
               $result =~ s/\&$//;
           } else {
               $result = 'error';
           }
       };
       if (!$@) {
           &Reply($client, \$result, $userinput);
       } else {
           &Failure($client,"unknown_cmd\n",$userinput);
       }
       return 1;
   }
   &register_handler("autovalidateinstclasses", \&validate_classes_handler, 0, 1, 0);
   
   #
 #   Create a password for a new LON-CAPA user added by auto-enrollment.  #   Create a password for a new LON-CAPA user added by auto-enrollment.
 #   Only used for case where authentication method for new user is localauth  #   Only used for case where authentication method for new user is localauth
 #  #
Line 5275  sub create_auto_enroll_password_handler Line 5627  sub create_auto_enroll_password_handler
 &register_handler("autocreatepassword", \&create_auto_enroll_password_handler,   &register_handler("autocreatepassword", \&create_auto_enroll_password_handler, 
   0, 1, 0);    0, 1, 0);
   
   sub auto_export_grades_handler {
       my ($cmd, $tail, $client) = @_;
       my $userinput = "$cmd:$tail";
       my ($cdom,$cnum,$info,$data) = split(/:/,$tail);
       my $inforef = &Apache::lonnet::thaw_unescape($info);
       my $dataref = &Apache::lonnet::thaw_unescape($data);
       my ($outcome,$result);;
       eval {
           local($SIG{__DIE__})='DEFAULT';
           my %rtnhash;
           $outcome=&localenroll::export_grades($cdom,$cnum,$inforef,$dataref,\%rtnhash);
           if ($outcome eq 'ok') {
               foreach my $key (keys(%rtnhash)) {
                   $result .= &escape($key).'='.&Apache::lonnet::freeze_escape($rtnhash{$key}).'&';
               }
               $result =~ s/\&$//;
           }
       };
       if (!$@) {
           if ($outcome eq 'ok') {
               if ($cipher) {
                   my $cmdlength=length($result);
                   $result.="         ";
                   my $encresult='';
                   for (my $encidx=0;$encidx<=$cmdlength;$encidx+=8) {
                       $encresult.= unpack("H16",
                                           $cipher->encrypt(substr($result,
                                                                   $encidx,
                                                                   8)));
                   }
                   &Reply( $client, "enc:$cmdlength:$encresult\n", $userinput);
               } else {
                   &Failure( $client, "error:no_key\n", $userinput);
               }
           } else {
               &Reply($client, "$outcome\n", $userinput);
           }
       } else {
           &Failure($client,"export_error\n",$userinput);
       }
       return 1;
   }
   &register_handler("autoexportgrades", \&auto_export_grades_handler,
                     0, 1, 0);
   
   
 #   Retrieve and remove temporary files created by/during autoenrollment.  #   Retrieve and remove temporary files created by/during autoenrollment.
 #  #
 # Formal Parameters:  # Formal Parameters:
 #    $cmd      - The command that got us dispatched.  #    $cmd      - The command that got us dispatched.
 #    $tail     - The tail of the command.  In our case this is a colon   #    $tail     - The tail of the command.  In our case this is a colon 
 #                separated list that will be split into:  #                separated list that will be split into:
 #                $filename - The name of the file to remove.  #                $filename - The name of the file to retrieve.
 #                            The filename is given as a path relative to  #                            The filename is given as a path relative to
 #                            the LonCAPA temp file directory.  #                            the LonCAPA temp file directory.
 #    $client   - Socket open on the client.  #    $client   - Socket open on the client.
Line 5297  sub retrieve_auto_file_handler { Line 5695  sub retrieve_auto_file_handler {
     my $source = $perlvar{'lonDaemons'}.'/tmp/'.$filename;      my $source = $perlvar{'lonDaemons'}.'/tmp/'.$filename;
     if ($filename =~m{/\.\./}) {      if ($filename =~m{/\.\./}) {
         &Failure($client, "refused\n", $userinput);          &Failure($client, "refused\n", $userinput);
       } elsif ($filename !~ /^$LONCAPA::match_domain\_$LONCAPA::match_courseid\_.+_classlist\.xml$/) {
           &Failure($client, "refused\n", $userinput);
     } elsif ( (-e $source) && ($filename ne '') ) {      } elsif ( (-e $source) && ($filename ne '') ) {
  my $reply = '';   my $reply = '';
  if (open(my $fh,$source)) {   if (open(my $fh,$source)) {
Line 6170  my $wwwid=getpwnam('www'); Line 6570  my $wwwid=getpwnam('www');
 if ($wwwid!=$<) {  if ($wwwid!=$<) {
    my $emailto="$perlvar{'lonAdmEMail'},$perlvar{'lonSysEMail'}";     my $emailto="$perlvar{'lonAdmEMail'},$perlvar{'lonSysEMail'}";
    my $subj="LON: $currenthostid User ID mismatch";     my $subj="LON: $currenthostid User ID mismatch";
    system("echo 'User ID mismatch.  lond must be run as user www.' |\     system("echo 'User ID mismatch.  lond must be run as user www.' |".
  mailto $emailto -s '$subj' > /dev/null");            " mail -s '$subj' $emailto > /dev/null");
    exit 1;     exit 1;
 }  }
   
Line 6621  sub make_new_child { Line 7021  sub make_new_child {
         &Authen::Krb5::init_context();          &Authen::Krb5::init_context();
   
         my $no_ets;          my $no_ets;
         if ($dist =~ /^(?:centos|rhes|scientific)(\d+)$/) {          if ($dist =~ /^(?:centos|rhes|scientific|oracle)(\d+)$/) {
             if ($1 >= 7) {              if ($1 >= 7) {
                 $no_ets = 1;                  $no_ets = 1;
             }              }
Line 6754  sub make_new_child { Line 7154  sub make_new_child {
   ."Attempted insecure connection disallowed </font>");    ."Attempted insecure connection disallowed </font>");
  close $client;   close $client;
  $clientok = 0;   $clientok = 0;
   
     }      }
  }   }
     } else {      } else {
Line 6763  sub make_new_child { Line 7162  sub make_new_child {
  ."$clientip failed to initialize: >$remotereq< </font>");   ."$clientip failed to initialize: >$remotereq< </font>");
  &status('No init '.$clientip);   &status('No init '.$clientip);
     }      }
       
  } else {   } else {
     &logthis(      &logthis(
      "<font color='blue'>WARNING: Unknown client $clientip</font>");       "<font color='blue'>WARNING: Unknown client $clientip</font>");
Line 6921  sub password_filename { Line 7319  sub password_filename {
 #    domain    - domain of the user.  #    domain    - domain of the user.
 #    name      - User's name.  #    name      - User's name.
 #    contents  - New contents of the file.  #    contents  - New contents of the file.
   #    saveold   - (optional). If true save old file in a passwd.bak file.
 # Returns:  # Returns:
 #   0    - Failed.  #   0    - Failed.
 #   1    - Success.  #   1    - Success.
 #  #
 sub rewrite_password_file {  sub rewrite_password_file {
     my ($domain, $user, $contents) = @_;      my ($domain, $user, $contents, $saveold) = @_;
   
     my $file = &password_filename($domain, $user);      my $file = &password_filename($domain, $user);
     if (defined $file) {      if (defined $file) {
           if ($saveold) {
               my $bakfile = $file.'.bak';
               if (CopyFile($file,$bakfile)) {
                   chmod(0400,$bakfile);
                   &logthis("Old password saved in passwd.bak for internally authenticated user: $user:$domain");
               } else {
                   &logthis("Failed to save old password in passwd.bak for internally authenticated user: $user:$domain");
               }
           }
  my $pf = IO::File->new(">$file");   my $pf = IO::File->new(">$file");
  if($pf) {   if($pf) {
     print $pf "$contents\n";      print $pf "$contents\n";
Line 7020  sub validate_user { Line 7428  sub validate_user {
                 $contentpwd = $domdefaults{'auth_arg_def'};                   $contentpwd = $domdefaults{'auth_arg_def'}; 
             }              }
         }          }
     }       }
     if ($howpwd ne 'nouser') {      if ($howpwd ne 'nouser') {
  if($howpwd eq "internal") { # Encrypted is in local password file.   if($howpwd eq "internal") { # Encrypted is in local password file.
     $validated = (crypt($password, $contentpwd) eq $contentpwd);              if (length($contentpwd) == 13) {
                   $validated = (crypt($password,$contentpwd) eq $contentpwd);
                   if ($validated) {
                       my %domdefaults = &Apache::lonnet::get_domain_defaults($domain);
                       if ($domdefaults{'intauth_switch'}) {
                           my $ncpass = &hash_passwd($domain,$password);
                           my $saveold;
                           if ($domdefaults{'intauth_switch'} == 2) {
                               $saveold = 1;
                           }
                           if (&rewrite_password_file($domain,$user,"$howpwd:$ncpass",$saveold)) {
                               &update_passwd_history($user,$domain,$howpwd,'conversion');
                               &logthis("Validated password hashed with bcrypt for $user:$domain");
                           }
                       }
                   }
               } else {
                   $validated = &check_internal_passwd($password,$contentpwd,$domain,$user);
               }
  }   }
  elsif ($howpwd eq "unix") { # User is a normal unix user.   elsif ($howpwd eq "unix") { # User is a normal unix user.
     $contentpwd = (getpwnam($user))[1];      $contentpwd = (getpwnam($user))[1];
Line 7091  sub validate_user { Line 7517  sub validate_user {
     return $validated;      return $validated;
 }  }
   
   sub check_internal_passwd {
       my ($plainpass,$stored,$domain,$user) = @_;
       my (undef,$method,@rest) = split(/!/,$stored);
       if ($method eq 'bcrypt') {
           my $result = &hash_passwd($domain,$plainpass,@rest);
           if ($result ne $stored) {
               return 0;
           }
           my %domdefaults = &Apache::lonnet::get_domain_defaults($domain);
           if ($domdefaults{'intauth_check'}) {
               # Upgrade to a larger number of rounds if necessary
               my $defaultcost = $domdefaults{'intauth_cost'};
               if (($defaultcost eq '') || ($defaultcost =~ /D/)) {
                   $defaultcost = 10;
               }
               if (int($rest[0])<int($defaultcost)) {
                   if ($domdefaults{'intauth_check'} == 1) {
                       my $ncpass = &hash_passwd($domain,$plainpass);
                       if (&rewrite_password_file($domain,$user,"internal:$ncpass")) {
                           &update_passwd_history($user,$domain,'internal','update cost');
                           &logthis("Validated password hashed with bcrypt for $user:$domain");
                       }
                       return 1;
                   } elsif ($domdefaults{'intauth_check'} == 2) {
                       return 0;
                   }
               }
           } else {
               return 1;
           }
       }
       return 0;
   }
   
   sub get_last_authchg {
       my ($domain,$user) = @_;
       my $lastmod;
       my $logname = &propath($domain,$user).'/passwd.log';
       if (-e "$logname") {
           $lastmod = (stat("$logname"))[9];
       }
       return $lastmod;
   }
   
 sub krb4_authen {  sub krb4_authen {
     my ($password,$null,$user,$contentpwd) = @_;      my ($password,$null,$user,$contentpwd) = @_;
     my $validated = 0;      my $validated = 0;
Line 7406  sub change_unix_password { Line 7876  sub change_unix_password {
   
   
 sub make_passwd_file {  sub make_passwd_file {
     my ($uname,$udom,$umode,$npass,$passfilename)=@_;      my ($uname,$udom,$umode,$npass,$passfilename,$action)=@_;
     my $result="ok";      my $result="ok";
     if ($umode eq 'krb4' or $umode eq 'krb5') {      if ($umode eq 'krb4' or $umode eq 'krb5') {
  {   {
     my $pf = IO::File->new(">$passfilename");      my $pf = IO::File->new(">$passfilename");
     if ($pf) {      if ($pf) {
  print $pf "$umode:$npass\n";   print $pf "$umode:$npass\n";
                   &update_passwd_history($uname,$udom,$umode,$action);
     } else {      } else {
  $result = "pass_file_failed_error";   $result = "pass_file_failed_error";
     }      }
  }   }
     } elsif ($umode eq 'internal') {      } elsif ($umode eq 'internal') {
  my $salt=time;          my $ncpass = &hash_passwd($udom,$npass);
  $salt=substr($salt,6,2);  
  my $ncpass=crypt($npass,$salt);  
  {   {
     &Debug("Creating internal auth");      &Debug("Creating internal auth");
     my $pf = IO::File->new(">$passfilename");      my $pf = IO::File->new(">$passfilename");
     if($pf) {      if($pf) {
  print $pf "internal:$ncpass\n";    print $pf "internal:$ncpass\n"; 
                   &update_passwd_history($uname,$udom,$umode,$action);
     } else {      } else {
  $result = "pass_file_failed_error";   $result = "pass_file_failed_error";
     }      }
Line 7435  sub make_passwd_file { Line 7905  sub make_passwd_file {
     my $pf = IO::File->new(">$passfilename");      my $pf = IO::File->new(">$passfilename");
     if($pf) {      if($pf) {
  print $pf "localauth:$npass\n";   print $pf "localauth:$npass\n";
                   &update_passwd_history($uname,$udom,$umode,$action);
     } else {      } else {
  $result = "pass_file_failed_error";   $result = "pass_file_failed_error";
     }      }
Line 7505  sub get_usersession_config { Line 7976  sub get_usersession_config {
     return;      return;
 }  }
   
   sub get_usersearch_config {
       my ($dom,$name) = @_;
       my ($usersearchconf,$cached)=&Apache::lonnet::is_cached_new($name,$dom);
       if (defined($cached)) {
           return $usersearchconf;
       } else {
           my %domconfig = &Apache::lonnet::get_dom('configuration',['directorysrch'],$dom);
           &Apache::lonnet::do_cache_new($name,$dom,$domconfig{'directorysrch'},3600);
           return $domconfig{'directorysrch'};
       }
       return;
   }
   
 sub distro_and_arch {  sub distro_and_arch {
     return $dist.':'.$arch;      return $dist.':'.$arch;
Removed from v.1.489.2.20  
changed lines
  Added in v.1.489.2.33

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
500 Internal Server Error

Internal Server Error

The server encountered an internal error or misconfiguration and was unable to complete your request.

Please contact the server administrator at root@localhost to inform them of the time this error occurred, and the actions you performed just before this error.

More information about this error may be available in the server error log.