[LON-CAPA-cvs] cvs: loncom(version_2_8_X) /lonnet/perl lonnet.pm

[raeburn]

raeburn		Sun Dec 21 15:26:50 2008 EDT

  Modified files:              (Branch: version_2_8_X)
    /loncom/lonnet/perl	lonnet.pm 
  Log:
  - Backport 1.979, 1.980.
  
  
Index: loncom/lonnet/perl/lonnet.pm
diff -u loncom/lonnet/perl/lonnet.pm:1.976.2.2 loncom/lonnet/perl/lonnet.pm:1.976.2.3
--- loncom/lonnet/perl/lonnet.pm:1.976.2.2	Sun Dec 21 15:20:54 2008
+++ loncom/lonnet/perl/lonnet.pm	Sun Dec 21 15:26:50 2008
@@ -1,7 +1,7 @@
 # The LearningOnline Network
 # TCP networking package
 #
-# $Id: lonnet.pm,v 1.976.2.2 2008/12/21 15:20:54 raeburn Exp $
+# $Id: lonnet.pm,v 1.976.2.3 2008/12/21 15:26:50 raeburn Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -1787,7 +1787,7 @@
     }
     my $output='';
     my $response;
-    if ($filelink=~/^http\:/) {
+    if ($filelink=~/^https?\:/) {
        ($output,$response)=&externalssi($filelink);
     } else {
        ($output,$response)=&ssi($filelink,%form);
@@ -8301,7 +8301,10 @@
     if (-e $transferfile) { return 'ok'; }
     my $request;
     $uri=~s/^\///;
-    $request=new HTTP::Request('GET','http://'.&hostname(&homeserver($cnum,$cdom)).'/raw/'.$uri);
+    my $homeserver = &homeserver($cnum,$cdom);
+    my $protocol = $protocol{$homeserver};
+    $protocol = 'http' if ($protocol ne 'https');
+    $request=new HTTP::Request('GET',$protocol.'://'.&hostname($homeserver).'/raw/'.$uri);
     my $response=$ua->request($request,$transferfile);
 # did it work?
     if ($response->is_error()) {
@@ -8316,7 +8319,7 @@
 
 sub tokenwrapper {
     my $uri=shift;
-    $uri=~s|^http\://([^/]+)||;
+    $uri=~s|^https?\://([^/]+)||;
     $uri=~s|^/||;
     $env{'user.environment'}=~/\/([^\/]+)\.id/;
     my $token=$1;
@@ -8324,7 +8327,10 @@
     if ($udom && $uname && $file) {
 	$file=~s|(\?\.*)*$||;
         &appenv({"userfile.$udom/$uname/$file" => $env{'request.course.id'}});
-        return 'http://'.&hostname(&homeserver($uname,$udom)).'/'.$uri.
+        my $homeserver = &homeserver($uname,$udom);
+        my $protocol = $protocol{$homeserver};
+        $protocol = 'http' if ($protocol ne 'https');
+        return $protocol.'://'.&hostname($homeserver).'/'.$uri.
                (($uri=~/\?/)?'&':'?').'token='.$token.
                                '&tokenissued='.$perlvar{'lonHostID'};
     } else {
@@ -8339,7 +8345,10 @@
 sub getuploaded {
     my ($reqtype,$uri,$cdom,$cnum,$info,$rtncode) = @_;
     $uri=~s/^\///;
-    $uri = 'http://'.&hostname(&homeserver($cnum,$cdom)).'/raw/'.$uri;
+    my $homeserver = &homeserver($cnum,$cdom);
+    my $protocol = $protocol{$homeserver};
+    $protocol = 'http' if ($protocol ne 'https');
+    $uri = $protocol.'://'.&hostname($homeserver).'/raw/'.$uri;
     my $ua=new LWP::UserAgent;
     my $request=new HTTP::Request($reqtype,$uri);
     my $response=$ua->request($request);
@@ -8421,7 +8430,7 @@
 
 sub hreflocation {
     my ($dir,$file)=@_;
-    unless (($file=~m-^http://-i) || ($file=~m-^/-)) {
+    unless (($file=~m-^https?\://-i) || ($file=~m-^/-)) {
 	$file=filelocation($dir,$file);
     } elsif ($file=~m-^/adm/-) {
 	$file=~s-^/adm/wrapper/-/-;