[BACK]Return to lonnet.pm CVS log [TXT] [DIR] Up to [LON-CAPA] / loncom / lonnet / perl

Diff for /loncom/lonnet/perl/lonnet.pm between versions 1.1344 and 1.1345

version 1.1344, 2017/05/09 03:04:32 version 1.1345, 2017/05/23 03:07:43
Line 71  delayed. Line 71  delayed.
 package Apache::lonnet;  package Apache::lonnet;
   
 use strict;  use strict;
 use LWP::UserAgent();  
 use HTTP::Date;  use HTTP::Date;
 use Image::Magick;  use Image::Magick;
   
Line 101  use LONCAPA qw(:DEFAULT :match); Line 100  use LONCAPA qw(:DEFAULT :match);
 use LONCAPA::Configuration;  use LONCAPA::Configuration;
 use LONCAPA::lonmetadata;  use LONCAPA::lonmetadata;
 use LONCAPA::Lond;  use LONCAPA::Lond;
   use LONCAPA::LWPReq;
   
 use File::Copy;  use File::Copy;
   
Line 305  sub get_server_loncaparev { Line 305  sub get_server_loncaparev {
             $answer = &reply('serverloncaparev',$lonhost);              $answer = &reply('serverloncaparev',$lonhost);
             if (($answer eq 'unknown_cmd') || ($answer eq 'con_lost')) {              if (($answer eq 'unknown_cmd') || ($answer eq 'con_lost')) {
                 if ($caller eq 'loncron') {                  if ($caller eq 'loncron') {
                     my $ua=new LWP::UserAgent;  
                     $ua->timeout(4);  
                     my $protocol = $protocol{$lonhost};                      my $protocol = $protocol{$lonhost};
                     $protocol = 'http' if ($protocol ne 'https');                      $protocol = 'http' if ($protocol ne 'https');
                     my $url = $protocol.'://'.&hostname($lonhost).'/adm/about.html';                      my $url = $protocol.'://'.&hostname($lonhost).'/adm/about.html';
                     my $request=new HTTP::Request('GET',$url);                      my $request=new HTTP::Request('GET',$url);
                     my $response=$ua->request($request);                      my $response=&LONCAPA::LWPReq::makerequest($lonhost,$request,'',\%perlvar,4,1);
                     unless ($response->is_error()) {                      unless ($response->is_error()) {
                         my $content = $response->content;                          my $content = $response->content;
                         if ($content =~ /<p>VERSION\:\s*([\w.\-]+)<\/p>/) {                          if ($content =~ /<p>VERSION\:\s*([\w.\-]+)<\/p>/) {
Line 2953  sub repcopy { Line 2951  sub repcopy {
    mkdir($path,0777);     mkdir($path,0777);
                }                 }
            }             }
            my $ua=new LWP::UserAgent;  
            my $request=new HTTP::Request('GET',"$remoteurl");             my $request=new HTTP::Request('GET',"$remoteurl");
            my $response=$ua->request($request,$transname);             my $response;
              if ($remoteurl =~ m{/raw/}) {
                  $response=&LONCAPA::LWPReq::makerequest($home,$request,$transname,\%perlvar,'',0,1);
              } else {
                  $response=&LONCAPA::LWPReq::makerequest($home,$request,$transname,\%perlvar,'',1);
              }
            if ($response->is_error()) {             if ($response->is_error()) {
        unlink($transname);         unlink($transname);
                my $message=$response->status_line;                 my $message=$response->status_line;
Line 2965  sub repcopy { Line 2967  sub repcopy {
            } else {             } else {
        if ($remoteurl!~/\.meta$/) {         if ($remoteurl!~/\.meta$/) {
                   my $mrequest=new HTTP::Request('GET',$remoteurl.'.meta');                    my $mrequest=new HTTP::Request('GET',$remoteurl.'.meta');
                   my $mresponse=$ua->request($mrequest,$filename.'.meta');                    my $mresponse;
                     if ($remoteurl =~ m{/raw/}) {
                         $mresponse = &LONCAPA::LWPReq::makerequest($home,$mrequest,$filename.'.meta',\%perlvar,'',0,1);
                     } else {
                         $mresponse = &LONCAPA::LWPReq::makerequest($home,$mrequest,$filename.'.meta',\%perlvar,'',1);
                     }
                   if ($mresponse->is_error()) {                    if ($mresponse->is_error()) {
       unlink($filename.'.meta');        unlink($filename.'.meta');
                       &logthis(                        &logthis(
Line 3028  sub absolute_url { Line 3035  sub absolute_url {
 sub ssi {  sub ssi {
   
     my ($fn,%form)=@_;      my ($fn,%form)=@_;
     my $ua=new LWP::UserAgent;  
     my $request;      my $request;
   
     $form{'no_update_last_known'}=1;      $form{'no_update_last_known'}=1;
Line 3046  sub ssi { Line 3052  sub ssi {
     }      }
   
     $request->header(Cookie => $ENV{'HTTP_COOKIE'});      $request->header(Cookie => $ENV{'HTTP_COOKIE'});
     my $response= $ua->request($request);      my $lonhost = $perlvar{'lonHostID'};
     my $content = $response->content;      my $response= &LONCAPA::LWPReq::makerequest($lonhost,$request,'',\%perlvar);
   
   
     if (wantarray) {      if (wantarray) {
  return ($content, $response);   return ($response->content, $response);
     } else {      } else {
  return $content;   return $response->content;
     }      }
 }  }
   
 sub externalssi {  sub externalssi {
     my ($url)=@_;      my ($url)=@_;
     my $ua=new LWP::UserAgent;  
     my $request=new HTTP::Request('GET',$url);      my $request=new HTTP::Request('GET',$url);
     my $response=$ua->request($request);      my $response = &LONCAPA::LWPReq::makerequest('',$request,'',\%perlvar);
     if (wantarray) {      if (wantarray) {
         return ($response->content, $response);          return ($response->content, $response);
     } else {      } else {
Line 12760  sub repcopy_userfile { Line 12764  sub repcopy_userfile {
     }      }
 # now the path exists for sure  # now the path exists for sure
 # get a user agent  # get a user agent
     my $ua=new LWP::UserAgent;  
     my $transferfile=$file.'.in.transfer';      my $transferfile=$file.'.in.transfer';
 # FIXME: this should flock  # FIXME: this should flock
     if (-e $transferfile) { return 'ok'; }      if (-e $transferfile) { return 'ok'; }
Line 12770  sub repcopy_userfile { Line 12773  sub repcopy_userfile {
     my $protocol = $protocol{$homeserver};      my $protocol = $protocol{$homeserver};
     $protocol = 'http' if ($protocol ne 'https');      $protocol = 'http' if ($protocol ne 'https');
     $request=new HTTP::Request('GET',$protocol.'://'.&hostname($homeserver).'/raw/'.$uri);      $request=new HTTP::Request('GET',$protocol.'://'.&hostname($homeserver).'/raw/'.$uri);
     my $response=$ua->request($request,$transferfile);      my $response = &LONCAPA::LWPReq::makerequest($homeserver,$request,$transferfile,\%perlvar,'',0,1);
 # did it work?  # did it work?
     if ($response->is_error()) {      if ($response->is_error()) {
  unlink($transferfile);   unlink($transferfile);
Line 12814  sub getuploaded { Line 12817  sub getuploaded {
     my $protocol = $protocol{$homeserver};      my $protocol = $protocol{$homeserver};
     $protocol = 'http' if ($protocol ne 'https');      $protocol = 'http' if ($protocol ne 'https');
     $uri = $protocol.'://'.&hostname($homeserver).'/raw/'.$uri;      $uri = $protocol.'://'.&hostname($homeserver).'/raw/'.$uri;
     my $ua=new LWP::UserAgent;  
     my $request=new HTTP::Request($reqtype,$uri);      my $request=new HTTP::Request($reqtype,$uri);
     my $response=$ua->request($request);      my $response=&LONCAPA::LWPReq::makerequest($homeserver,$request,'',\%perlvar,'',0,1);
     $$rtncode = $response->code;      $$rtncode = $response->code;
     if (! $response->is_success()) {      if (! $response->is_success()) {
  return 'failed';   return 'failed';
Line 13104  sub get_dns { Line 13106  sub get_dns {
     }      }
     while (%alldns) {      while (%alldns) {
  my ($dns) = sort { $b cmp $a } keys(%alldns);   my ($dns) = sort { $b cmp $a } keys(%alldns);
  my $ua=new LWP::UserAgent;  
         $ua->timeout(30);  
  my $request=new HTTP::Request('GET',"$alldns{$dns}://$dns$url");   my $request=new HTTP::Request('GET',"$alldns{$dns}://$dns$url");
  my $response=$ua->request($request);          my $response = &LONCAPA::LWPReq::makerequest('',$request,'',\%perlvar,30,0);
         delete($alldns{$dns});          delete($alldns{$dns});
  next if ($response->is_error());   next if ($response->is_error());
  my @content = split("\n",$response->content);   my @content = split("\n",$response->content);
Removed from v.1.1344  
changed lines
  Added in v.1.1345

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