Diff for /loncom/lonnet/perl/lonnet.pm between versions 1.1396 and 1.1397

version 1.1396, 2018/12/22 01:56:25 version 1.1397, 2018/12/27 18:14:50
Line 311  sub get_server_loncaparev { Line 311  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 $hostname = &hostname($lonhost);
                     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.'/adm/about.html';
                     my $request=new HTTP::Request('GET',$url);                      my $request=new HTTP::Request('GET',$url);
                     my $response=&LONCAPA::LWPReq::makerequest($lonhost,$request,'',\%perlvar,4,1);                      my $response=&LONCAPA::LWPReq::makerequest($lonhost,$request,'',\%perlvar,4,1);
                     unless ($response->is_error()) {                      unless ($response->is_error()) {
Line 1007  sub spareserver { Line 1008  sub spareserver {
     }      }
   
     if (!$want_server_name) {      if (!$want_server_name) {
         my $protocol = 'http';  
         if ($protocol{$spare_server} eq 'https') {  
             $protocol = $protocol{$spare_server};  
         }  
         if (defined($spare_server)) {          if (defined($spare_server)) {
             my $hostname = &hostname($spare_server);              my $hostname = &hostname($spare_server);
             if (defined($hostname)) {              if (defined($hostname)) {
                   my $protocol = 'http';
                   if ($protocol{$spare_server} eq 'https') {
                       $protocol = $protocol{$spare_server};
                   }
         $spare_server = $protocol.'://'.$hostname;          $spare_server = $protocol.'://'.$hostname;
             }              }
         }          }
Line 3376  sub remove_stale_resfile { Line 3377  sub remove_stale_resfile {
                     (grep { $_ eq $homeserver } &current_machine_ids())) {                      (grep { $_ eq $homeserver } &current_machine_ids())) {
                 my $fname = &filelocation('',$url);                  my $fname = &filelocation('',$url);
                 if (-e $fname) {                  if (-e $fname) {
                     my $protocol = $protocol{$homeserver};  
                     $protocol = 'http' if ($protocol ne 'https');  
                     my $hostname = &hostname($homeserver);                      my $hostname = &hostname($homeserver);
                     if ($hostname) {                      if ($hostname) {
                           my $protocol = $protocol{$homeserver};
                           $protocol = 'http' if ($protocol ne 'https');
                         my $uri = &declutter($url);                          my $uri = &declutter($url);
                         my $request=new HTTP::Request('HEAD',$protocol.'://'.$hostname.'/raw/'.$uri);                          my $request=new HTTP::Request('HEAD',$protocol.'://'.$hostname.'/raw/'.$uri);
                         my $response = &LONCAPA::LWPReq::makerequest($homeserver,$request,'',\%perlvar,5,0,1);                          my $response = &LONCAPA::LWPReq::makerequest($homeserver,$request,'',\%perlvar,5,0,1);
Line 13357  sub repcopy_userfile { Line 13358  sub repcopy_userfile {
     my $request;      my $request;
     $uri=~s/^\///;      $uri=~s/^\///;
     my $homeserver = &homeserver($cnum,$cdom);      my $homeserver = &homeserver($cnum,$cdom);
       my $hostname = &hostname($homeserver); 
     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.'/raw/'.$uri);
     my $response = &LONCAPA::LWPReq::makerequest($homeserver,$request,$transferfile,\%perlvar,'',0,1);      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()) {
Line 13383  sub tokenwrapper { Line 13385  sub tokenwrapper {
  $file=~s|(\?\.*)*$||;   $file=~s|(\?\.*)*$||;
         &appenv({"userfile.$udom/$uname/$file" => $env{'request.course.id'}});          &appenv({"userfile.$udom/$uname/$file" => $env{'request.course.id'}});
         my $homeserver = &homeserver($uname,$udom);          my $homeserver = &homeserver($uname,$udom);
           my $hostname = &hostname($homeserver);
         my $protocol = $protocol{$homeserver};          my $protocol = $protocol{$homeserver};
         $protocol = 'http' if ($protocol ne 'https');          $protocol = 'http' if ($protocol ne 'https');
         return $protocol.'://'.&hostname($homeserver).'/'.$uri.          return $protocol.'://'.$hostname.'/'.$uri.
                (($uri=~/\?/)?'&':'?').'token='.$token.                 (($uri=~/\?/)?'&':'?').'token='.$token.
                                '&tokenissued='.$perlvar{'lonHostID'};                                 '&tokenissued='.$perlvar{'lonHostID'};
     } else {      } else {
Line 13401  sub getuploaded { Line 13404  sub getuploaded {
     my ($reqtype,$uri,$cdom,$cnum,$info,$rtncode) = @_;      my ($reqtype,$uri,$cdom,$cnum,$info,$rtncode) = @_;
     $uri=~s/^\///;      $uri=~s/^\///;
     my $homeserver = &homeserver($cnum,$cdom);      my $homeserver = &homeserver($cnum,$cdom);
       my $hostname = &hostname($homeserver);
     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.'/raw/'.$uri;
     my $request=new HTTP::Request($reqtype,$uri);      my $request=new HTTP::Request($reqtype,$uri);
     my $response=&LONCAPA::LWPReq::makerequest($homeserver,$request,'',\%perlvar,'',0,1);      my $response=&LONCAPA::LWPReq::makerequest($homeserver,$request,'',\%perlvar,'',0,1);
     $$rtncode = $response->code;      $$rtncode = $response->code;

Removed from v.1.1396  
changed lines
  Added in v.1.1397


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