version 1.522, 2016/05/30 03:16:38
|
version 1.524, 2016/08/11 16:35:14
|
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 7715 sub make_passwd_file {
|
Line 7726 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"; |
} |
} |