--- loncom/lonnet/perl/lonnet.pm 2008/12/19 17:04:57 1.979 +++ loncom/lonnet/perl/lonnet.pm 2009/01/02 22:45:43 1.982 @@ -1,7 +1,7 @@ # The LearningOnline Network # TCP networking package # -# $Id: lonnet.pm,v 1.979 2008/12/19 17:04:57 raeburn Exp $ +# $Id: lonnet.pm,v 1.982 2009/01/02 22:45:43 raeburn Exp $ # # Copyright Michigan State University Board of Trustees # @@ -525,7 +525,7 @@ sub delenv { tie(my %disk_env,'GDBM_File',$env{'user.environment'}, (&GDBM_WRITER()|&GDBM_NOLOCK()),0640)) { foreach my $key (keys(%disk_env)) { - if ($key=~/^$delthis/) { + if ($key=~/^\Q$delthis\E/) { delete($env{$key}); delete($disk_env{$key}); } @@ -1231,7 +1231,6 @@ sub inst_userrules { sub get_domain_defaults { my ($domain) = @_; my $cachetime = 60*60*24; - my ($defauthtype,$defautharg,$deflang,%deftools); my ($result,$cached)=&is_cached_new('domdefaults',$domain); if (defined($cached)) { if (ref($result) eq 'HASH') { @@ -1245,6 +1244,8 @@ sub get_domain_defaults { $domdefaults{'lang_def'} = $domconfig{'defaults'}{'lang_def'}; $domdefaults{'auth_def'} = $domconfig{'defaults'}{'auth_def'}; $domdefaults{'auth_arg_def'} = $domconfig{'defaults'}{'auth_arg_def'}; + $domdefaults{'timezone_def'} = $domconfig{'defaults'}{'timezone_def'}; + $domdefaults{'datelocale_def'} = $domconfig{'defaults'}{'datelocale_def'} } else { $domdefaults{'lang_def'} = &domain($domain,'lang_def'); $domdefaults{'auth_def'} = &domain($domain,'auth_def'); @@ -1791,7 +1792,7 @@ sub ssi_body { } my $output=''; my $response; - if ($filelink=~/^http\:/) { + if ($filelink=~/^https?\:/) { ($output,$response)=&externalssi($filelink); } else { ($output,$response)=&ssi($filelink,%form); @@ -8332,7 +8333,10 @@ sub repcopy_userfile { 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()) { @@ -8347,7 +8351,7 @@ sub repcopy_userfile { sub tokenwrapper { my $uri=shift; - $uri=~s|^http\://([^/]+)||; + $uri=~s|^https?\://([^/]+)||; $uri=~s|^/||; $env{'user.environment'}=~/\/([^\/]+)\.id/; my $token=$1; @@ -8355,7 +8359,10 @@ sub tokenwrapper { 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 { @@ -8370,7 +8377,10 @@ sub tokenwrapper { 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); @@ -8452,7 +8462,7 @@ sub filelocation { 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/-/-;