version 1.520, 2016/05/08 19:05:10
|
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 {
|
} |
} |
®ister_handler("serverdistarch", \&server_distarch_handler, 0, 1, 0); |
®ister_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; |
|
} |
|
®ister_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 5462 sub create_auto_enroll_password_handler
|
Line 5473 sub create_auto_enroll_password_handler
|
®ister_handler("autocreatepassword", \&create_auto_enroll_password_handler, |
®ister_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; |
|
} |
|
®ister_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 5482 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>) { |