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

Diff for /loncom/lond between versions 1.518 and 1.523

version 1.518, 2016/02/17 19:15:44 version 1.523, 2016/07/25 19:49:45
Line 41  use IO::File; Line 41  use IO::File;
 #use Apache::File;  #use Apache::File;
 use POSIX;  use POSIX;
 use Crypt::IDEA;  use Crypt::IDEA;
 use LWP::UserAgent();  use HTTP::Request;
 use Digest::MD5 qw(md5_hex);  use Digest::MD5 qw(md5_hex);
 use GDBM_File;  use GDBM_File;
 use Authen::Krb5;  use Authen::Krb5;
Line 58  use Mail::Send; Line 58  use Mail::Send;
 use Crypt::Eksblowfish::Bcrypt;  use Crypt::Eksblowfish::Bcrypt;
 use Digest::SHA;  use Digest::SHA;
 use Encode;  use Encode;
   use LONCAPA::LWPReq;
   
 my $DEBUG = 0;       # Non zero to enable debug log entries.  my $DEBUG = 0;       # Non zero to enable debug log entries.
   
Line 667  sub PushFile { Line 668  sub PushFile {
                 $clientprotocol = 'http' if ($clientprotocol ne 'https');                  $clientprotocol = 'http' if ($clientprotocol ne 'https');
                 my $url = '/adm/'.$filename;                  my $url = '/adm/'.$filename;
                 $url =~ s{_}{/};                  $url =~ s{_}{/};
                 my $ua=new LWP::UserAgent;  
                 $ua->timeout(60);  
                 my $request=new HTTP::Request('GET',"$clientprotocol://$clienthost$url");                  my $request=new HTTP::Request('GET',"$clientprotocol://$clienthost$url");
                 my $response=$ua->request($request);                  my $response = LONCAPA::LWPReq::makerequest($clientname,$request,'',\%perlvar,60,0);
                 if ($response->is_error()) {                  if ($response->is_error()) {
                     &logthis('<font color="red"> Pushfile: unable to install '                      &logthis('<font color="red"> Pushfile: unable to install '
                             .$tablefile." - error attempting to pull data. </font>");                              .$tablefile." - error attempting to pull data. </font>");
Line 1797  sub server_distarch_handler { Line 1796  sub server_distarch_handler {
 }  }
 &register_handler("serverdistarch", \&server_distarch_handler, 0, 1, 0);  &register_handler("serverdistarch", \&server_distarch_handler, 0, 1, 0);
   
   sub server_certs_handler {
       my ($cmd,$tail,$client) = @_;
       my $userinput = "$cmd:$tail";
       my $result;
       my $result = &LONCAPA::Lond::server_certs(\%perlvar);
       &Reply($client,\$result,$userinput);
       return;
   }
   &register_handler("servercerts", \&server_certs_handler, 0, 1, 0);
   
 #   Process a reinit request.  Reinit requests that either  #   Process a reinit request.  Reinit requests that either
 #   lonc or lond be reinitialized so that an updated   #   lonc or lond be reinitialized so that an updated 
 #   host.tab or domain.tab can be processed.  #   host.tab or domain.tab can be processed.
Line 2331  sub update_resource_handler { Line 2340  sub update_resource_handler {
 # FIXME: this should use the LWP mechanism, not internal alarms.  # FIXME: this should use the LWP mechanism, not internal alarms.
                 alarm(1200);                  alarm(1200);
  {   {
     my $ua=new LWP::UserAgent;  
     my $request=new HTTP::Request('GET',"$remoteurl");      my $request=new HTTP::Request('GET',"$remoteurl");
     $response=$ua->request($request,$transname);                      $response=&LONCAPA::LWPReq::makerequest($clientname,$request,$transname,\%perlvar,1200,0,1);
  }   }
  alarm(0);   alarm(0);
  if ($response->is_error()) {   if ($response->is_error()) {
Line 2346  sub update_resource_handler { Line 2354  sub update_resource_handler {
 # FIXME: isn't there an internal LWP mechanism for this?  # FIXME: isn't there an internal LWP mechanism for this?
  alarm(120);   alarm(120);
  {   {
     my $ua=new LWP::UserAgent;  
     my $mrequest=new HTTP::Request('GET',$remoteurl.'.meta');      my $mrequest=new HTTP::Request('GET',$remoteurl.'.meta');
     my $mresponse=$ua->request($mrequest,$fname.'.meta');                              my $mresponse = &LONCAPA::LWPReq::makerequest($clientname,$mrequest,$fname.'.meta',\%perlvar,120,0,1);
     if ($mresponse->is_error()) {      if ($mresponse->is_error()) {
  unlink($fname.'.meta');   unlink($fname.'.meta');
     }      }
Line 2423  sub fetch_user_file_handler { Line 2430  sub fetch_user_file_handler {
  my $remoteurl=$clientprotocol.'://'.$clienthost.'/userfiles/'.$fname;   my $remoteurl=$clientprotocol.'://'.$clienthost.'/userfiles/'.$fname;
  my $response;   my $response;
  Debug("Remote URL : $remoteurl Transfername $transname Destname: $destname");   Debug("Remote URL : $remoteurl Transfername $transname Destname: $destname");
  alarm(120);   alarm(1200);
  {   {
     my $ua=new LWP::UserAgent;  
     my $request=new HTTP::Request('GET',"$remoteurl");      my $request=new HTTP::Request('GET',"$remoteurl");
     $response=$ua->request($request,$transname);              my $verifycert = 1;
               my @machine_ids = &Apache::lonnet::current_machine_ids();
               if (grep(/^\Q$clientname\E$/,@machine_ids)) {
                   $verifycert = 0;
               }
               $response = &LONCAPA::LWPReq::makerequest($clientname,$request,$transname,\%perlvar,1200,$verifycert);
  }   }
  alarm(0);   alarm(0);
  if ($response->is_error()) {   if ($response->is_error()) {
Line 2496  sub remove_user_file_handler { Line 2507  sub remove_user_file_handler {
     if (-e $file) {      if (-e $file) {
  #   #
  #   If the file is a regular file unlink is fine...   #   If the file is a regular file unlink is fine...
  #   However it's possible the client wants a dir.   #   However it's possible the client wants a dir 
  #   removed, in which case rmdir is more approprate:   #   removed, in which case rmdir is more appropriate.
    #   Note: rmdir will only remove an empty directory.
  #   #
         if (-f $file){          if (-f $file){
     unlink($file);      unlink($file);
                       # for html files remove the associated .bak file 
                       # which may have been created by the editor.
                       if ($ufile =~ m{^((docs|supplemental)/(?:\d+|default)/\d+(?:|/.+)/)[^/]+\.x?html?$}i) {
                           my $path = $1;
                           if (-e $file.'.bak') {
                               unlink($file.'.bak');
                           }
                       }
  } elsif(-d $file) {   } elsif(-d $file) {
     rmdir($file);      rmdir($file);
  }   }
Line 5453  sub create_auto_enroll_password_handler Line 5473  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:
Line 5473  sub retrieve_auto_file_handler { Line 5538  sub retrieve_auto_file_handler {
     my ($filename)   = split(/:/, $tail);      my ($filename)   = split(/:/, $tail);
   
     my $source = $perlvar{'lonDaemons'}.'/tmp/'.$filename;      my $source = $perlvar{'lonDaemons'}.'/tmp/'.$filename;
     if ( (-e $source) && ($filename ne '') ) {  
       if ($filename =~m{/\.\./}) {
           &Failure($client, "refused\n", $userinput);
       } elsif ( (-e $source) && ($filename ne '') ) {
  my $reply = '';   my $reply = '';
  if (open(my $fh,$source)) {   if (open(my $fh,$source)) {
     while (<$fh>) {      while (<$fh>) {
Line 5505  sub crsreq_checks_handler { Line 5573  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','textbook');      my @reqtypes = ('official','unofficial','community','textbook','placement');
     eval {      eval {
         local($SIG{__DIE__})='DEFAULT';          local($SIG{__DIE__})='DEFAULT';
         my %validations;          my %validations;
Removed from v.1.518  
changed lines
  Added in v.1.523

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