[LON-CAPA-cvs] cvs: loncom /auth lonacc.pm lonlogin.pm /interface lonmsg.pm lonrequestcourse.pm lonsyllabus.pm resetpw.pm selfenroll.pm /lonnet/perl lonnet.pm
raeburn
raeburn at source.lon-capa.org
Thu Dec 27 13:14:50 EST 2018
raeburn Thu Dec 27 18:14:50 2018 EDT
Modified files:
/loncom/interface lonmsg.pm lonrequestcourse.pm lonsyllabus.pm
resetpw.pm selfenroll.pm
/loncom/auth lonacc.pm lonlogin.pm
/loncom/lonnet/perl lonnet.pm
Log:
- Call Apache::lonnet::hostname($lonhost) before accessing
$Apache::lonnet::protocol{$lonhost) so %Apache::lonnet::protocol is populated.
-------------- next part --------------
Index: loncom/interface/lonmsg.pm
diff -u loncom/interface/lonmsg.pm:1.243 loncom/interface/lonmsg.pm:1.244
--- loncom/interface/lonmsg.pm:1.243 Tue Jul 21 21:26:32 2015
+++ loncom/interface/lonmsg.pm Thu Dec 27 18:14:25 2018
@@ -1,7 +1,7 @@
# The LearningOnline Network with CAPA
# Routines for messaging
#
-# $Id: lonmsg.pm,v 1.243 2015/07/21 21:26:32 raeburn Exp $
+# $Id: lonmsg.pm,v 1.244 2018/12/27 18:14:25 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -491,9 +491,10 @@
$text=~s/\<\;/\</gs;
$text=~s/\>\;/\>/gs;
my $homeserver = &Apache::lonnet::homeserver($touname,$toudom);
+ my $hostname = &Apache::lonnet::hostname($homeserver);
my $protocol = $Apache::lonnet::protocol{$homeserver};
$protocol = 'http' if ($protocol ne 'https');
- my $url = $protocol.'://'.&Apache::lonnet::hostname($homeserver).
+ my $url = $protocol.'://'.$hostname.
'/adm/email?username='.$touname.'&domain='.$toudom.
'&display='.&escape($msgid);
my ($sendtime,$shortsubj,$fromname,$fromdomain,$status,$fromcid,
Index: loncom/interface/lonrequestcourse.pm
diff -u loncom/interface/lonrequestcourse.pm:1.104 loncom/interface/lonrequestcourse.pm:1.105
--- loncom/interface/lonrequestcourse.pm:1.104 Fri Aug 17 23:19:03 2018
+++ loncom/interface/lonrequestcourse.pm Thu Dec 27 18:14:25 2018
@@ -1,7 +1,7 @@
# The LearningOnline Network
# Request a course
#
-# $Id: lonrequestcourse.pm,v 1.104 2018/08/17 23:19:03 raeburn Exp $
+# $Id: lonrequestcourse.pm,v 1.105 2018/12/27 18:14:25 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -4330,9 +4330,10 @@
$buttontext = &mt('Create course');
}
}
+ my $hostname = &Apache::lonnet::hostname($lonhost);
my $protocol = $Apache::lonnet::protocol{$lonhost};
$protocol = 'http' if ($protocol ne 'https');
- my $crscreator = $protocol.'://'.&Apache::lonnet::hostname($lonhost).'/cgi-bin/createpending.pl';
+ my $crscreator = $protocol.'://'.$hostname.'/cgi-bin/createpending.pl';
$output .= '<input type="hidden" name="crscreator" value="'.$crscreator.'" />'."\n".
'<input type="hidden" name="token" value="'.$token.'" />'."\n".
'<input type="submit" name="validate" value="'.$buttontext.'" />'."\n".
Index: loncom/interface/lonsyllabus.pm
diff -u loncom/interface/lonsyllabus.pm:1.143 loncom/interface/lonsyllabus.pm:1.144
--- loncom/interface/lonsyllabus.pm:1.143 Mon Feb 20 18:29:23 2017
+++ loncom/interface/lonsyllabus.pm Thu Dec 27 18:14:25 2018
@@ -1,7 +1,7 @@
# The LearningOnline Network
# Syllabus
#
-# $Id: lonsyllabus.pm,v 1.143 2017/02/20 18:29:23 raeburn Exp $
+# $Id: lonsyllabus.pm,v 1.144 2018/12/27 18:14:25 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -306,6 +306,7 @@
if ($allowed) {
#---------------------------------- Print External URL Syllabus Info if editing
if ($target ne 'tex') {
+ my $hostname = &Apache::lonnet::hostname($homeserver);
my $protocol = $Apache::lonnet::protocol{$homeserver};
$protocol = 'http' if ($protocol ne 'https');
my $link = $r->uri;
@@ -313,7 +314,7 @@
$link .= '?usehttp=1';
$protocol = 'http';
}
- $link = $protocol.'://'.&Apache::lonnet::hostname($homeserver).$link;
+ $link = $protocol.'://'.$hostname.$link;
$r->print('<div class="LC_left_float">'
.'<span class="LC_help_open_topic LC_info">'
.'<span class="LC_info">'
@@ -899,9 +900,10 @@
sub syllabus_file_info {
my ($item,$cnum,$cdom,$lonhost,$context) = @_;
+ my $hostname = &Apache::lonnet::hostname($lonhost);
my $protocol = $Apache::lonnet::protocol{$lonhost};
$protocol = 'http' if ($protocol ne 'https');
- my $absurl = $protocol.'://'.&Apache::lonnet::hostname($lonhost).$item;
+ my $absurl = $protocol.'://'.$hostname.$item;
my ($filename) = ($item =~ m{([^/]+)$});
my $file=&Apache::lonnet::filelocation("",$item);
my ($depbutton,$filetype,$editable);
@@ -1574,9 +1576,10 @@
my ($cdom,$cnum) = @_;
my $home=&Apache::lonnet::homeserver($cnum,$cdom);
if ($home ne 'no_host') {
+ my $hostname = &Apache::lonnet::hostname($home);
my $protocol = $Apache::lonnet::protocol{$home};
$protocol = 'http' if ($protocol ne 'https');
- return $protocol.'://'.&Apache::lonnet::hostname($home);
+ return $protocol.'://'.$hostname;
}
return;
}
Index: loncom/interface/resetpw.pm
diff -u loncom/interface/resetpw.pm:1.41 loncom/interface/resetpw.pm:1.42
--- loncom/interface/resetpw.pm:1.41 Mon Oct 2 16:40:18 2017
+++ loncom/interface/resetpw.pm Thu Dec 27 18:14:25 2018
@@ -1,7 +1,7 @@
# The LearningOnline Network
# Allow access to password changing via a token sent to user's e-mail.
#
-# $Id: resetpw.pm,v 1.41 2017/10/02 16:40:18 raeburn Exp $
+# $Id: resetpw.pm,v 1.42 2018/12/27 18:14:25 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -412,13 +412,17 @@
sub homeserver_redirect {
my ($uname,$udom,$domdesc,$brcrum) = @_;
- my $uhome = &Apache::lonnet::homeserver();
- if ($uhome eq 'no_host') {
+ my $uhome;
+ if ($uname ne '') && ($udom ne '')) {
+ $uhome = &Apache::lonnet::homeserver($uname,$udom);
+ }
+ if (($uhome eq 'no_host') || ($uhome eq '')) {
$uhome = &Apache::lonnet::domain($udom,'primary');
}
+ my $hostname = &Apache::lonnet::hostname($uhome);
my $protocol = $Apache::lonnet::protocol{$uhome};
$protocol = 'http' if ($protocol ne 'https');
- my $url = $protocol.'://'.&Apache::lonnet::hostname($uhome).'/adm/resetpw';
+ my $url = $protocol.'://'.$hostname.'/adm/resetpw';
# Breadcrumbs
my $start_page = &Apache::loncommon::start_page('Switching Server',undef,
{'redirect' => [0,$url],
@@ -494,10 +498,10 @@
if ($homeserver eq 'no_host') {
$r->print(&generic_failure_msg($contact_name,$contact_email));
} else {
+ my $hostname = &Apache::lonnet::hostname($homeserver);
my $protocol = $Apache::lonnet::protocol{$homeserver};
$protocol = 'http' if ($protocol ne 'https');
- my $url = $protocol.'://'.&Apache::lonnet::hostname($homeserver).
- '/adm/resetpw';
+ my $url = $protocol.'://'.$hostname.'/adm/resetpw';
my ($opentag,$closetag);
if ($url) {
$opentag = '<a href="'.$url.'">';
Index: loncom/interface/selfenroll.pm
diff -u loncom/interface/selfenroll.pm:1.34 loncom/interface/selfenroll.pm:1.35
--- loncom/interface/selfenroll.pm:1.34 Sun Aug 7 01:39:49 2016
+++ loncom/interface/selfenroll.pm Thu Dec 27 18:14:25 2018
@@ -1,7 +1,7 @@
# The LearningOnline Network
# Allow users to self-enroll in a course
#
-# $Id: selfenroll.pm,v 1.34 2016/08/07 01:39:49 raeburn Exp $
+# $Id: selfenroll.pm,v 1.35 2018/12/27 18:14:25 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -664,9 +664,10 @@
if ($buttontext eq '') {
$buttontext = &mt('Complete my enrollment');
}
+ my $hostname = &Apache::lonnet::hostname($lonhost);
my $protocol = $Apache::lonnet::protocol{$lonhost};
$protocol = 'http' if ($protocol ne 'https');
- my $enroller = $protocol.'://'.&Apache::lonnet::hostname($lonhost).'/cgi-bin/enrollqueued.pl';
+ my $enroller = $protocol.'://'.$hostname.'/cgi-bin/enrollqueued.pl';
$output .= '<input type="hidden" name="enroller" value="'.$enroller.'" />'."\n".
'<input type="hidden" name="token" value="'.$token.'" />'."\n".
'<input type="submit" name="validate" value="'.$buttontext.'" />'."\n".
Index: loncom/auth/lonacc.pm
diff -u loncom/auth/lonacc.pm:1.172 loncom/auth/lonacc.pm:1.173
--- loncom/auth/lonacc.pm:1.172 Mon Dec 17 21:43:05 2018
+++ loncom/auth/lonacc.pm Thu Dec 27 18:14:38 2018
@@ -1,7 +1,7 @@
# The LearningOnline Network
# Cookie Based Access Handler
#
-# $Id: lonacc.pm,v 1.172 2018/12/17 21:43:05 raeburn Exp $
+# $Id: lonacc.pm,v 1.173 2018/12/27 18:14:38 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -558,6 +558,7 @@
my $lonhost = &Apache::lonnet::host_from_dns($hostname);
if ($lonhost) {
my $actual = &Apache::lonnet::absolute_url($hostname);
+ my $exphostname = &Apache::lonnet::hostname($lonhost);
my $expected = $Apache::lonnet::protocol{$lonhost}.'://'.$hostname;
unless ($actual eq $expected) {
$env{'request.use_absolute'} = $expected;
Index: loncom/auth/lonlogin.pm
diff -u loncom/auth/lonlogin.pm:1.177 loncom/auth/lonlogin.pm:1.178
--- loncom/auth/lonlogin.pm:1.177 Wed Dec 26 20:10:21 2018
+++ loncom/auth/lonlogin.pm Thu Dec 27 18:14:38 2018
@@ -1,7 +1,7 @@
# The LearningOnline Network
# Login Screen
#
-# $Id: lonlogin.pm,v 1.177 2018/12/26 20:10:21 raeburn Exp $
+# $Id: lonlogin.pm,v 1.178 2018/12/27 18:14:38 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -852,12 +852,13 @@
sub redirect_page {
my ($desthost,$path,$linkprot) = @_;
+ my $hostname = &Apache::lonnet::hostname($desthost);
my $protocol = $Apache::lonnet::protocol{$desthost};
$protocol = 'http' if ($protocol ne 'https');
unless ($path =~ m{^/}) {
$path = '/'.$path;
}
- my $url = $protocol.'://'.&Apache::lonnet::hostname($desthost).$path;
+ my $url = $protocol.'://'.$hostname.$path;
if ($env{'form.firsturl'} ne '') {
$url .='?firsturl='.$env{'form.firsturl'};
}
Index: loncom/lonnet/perl/lonnet.pm
diff -u loncom/lonnet/perl/lonnet.pm:1.1396 loncom/lonnet/perl/lonnet.pm:1.1397
--- loncom/lonnet/perl/lonnet.pm:1.1396 Sat Dec 22 01:56:25 2018
+++ loncom/lonnet/perl/lonnet.pm Thu Dec 27 18:14:50 2018
@@ -1,7 +1,7 @@
# The LearningOnline Network
# TCP networking package
#
-# $Id: lonnet.pm,v 1.1396 2018/12/22 01:56:25 raeburn Exp $
+# $Id: lonnet.pm,v 1.1397 2018/12/27 18:14:50 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -311,9 +311,10 @@
$answer = &reply('serverloncaparev',$lonhost);
if (($answer eq 'unknown_cmd') || ($answer eq 'con_lost')) {
if ($caller eq 'loncron') {
+ my $hostname = &hostname($lonhost);
my $protocol = $protocol{$lonhost};
$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 $response=&LONCAPA::LWPReq::makerequest($lonhost,$request,'',\%perlvar,4,1);
unless ($response->is_error()) {
@@ -1007,13 +1008,13 @@
}
if (!$want_server_name) {
- my $protocol = 'http';
- if ($protocol{$spare_server} eq 'https') {
- $protocol = $protocol{$spare_server};
- }
if (defined($spare_server)) {
my $hostname = &hostname($spare_server);
if (defined($hostname)) {
+ my $protocol = 'http';
+ if ($protocol{$spare_server} eq 'https') {
+ $protocol = $protocol{$spare_server};
+ }
$spare_server = $protocol.'://'.$hostname;
}
}
@@ -3376,10 +3377,10 @@
(grep { $_ eq $homeserver } ¤t_machine_ids())) {
my $fname = &filelocation('',$url);
if (-e $fname) {
- my $protocol = $protocol{$homeserver};
- $protocol = 'http' if ($protocol ne 'https');
my $hostname = &hostname($homeserver);
if ($hostname) {
+ my $protocol = $protocol{$homeserver};
+ $protocol = 'http' if ($protocol ne 'https');
my $uri = &declutter($url);
my $request=new HTTP::Request('HEAD',$protocol.'://'.$hostname.'/raw/'.$uri);
my $response = &LONCAPA::LWPReq::makerequest($homeserver,$request,'',\%perlvar,5,0,1);
@@ -13357,9 +13358,10 @@
my $request;
$uri=~s/^\///;
my $homeserver = &homeserver($cnum,$cdom);
+ my $hostname = &hostname($homeserver);
my $protocol = $protocol{$homeserver};
$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);
# did it work?
if ($response->is_error()) {
@@ -13383,9 +13385,10 @@
$file=~s|(\?\.*)*$||;
&appenv({"userfile.$udom/$uname/$file" => $env{'request.course.id'}});
my $homeserver = &homeserver($uname,$udom);
+ my $hostname = &hostname($homeserver);
my $protocol = $protocol{$homeserver};
$protocol = 'http' if ($protocol ne 'https');
- return $protocol.'://'.&hostname($homeserver).'/'.$uri.
+ return $protocol.'://'.$hostname.'/'.$uri.
(($uri=~/\?/)?'&':'?').'token='.$token.
'&tokenissued='.$perlvar{'lonHostID'};
} else {
@@ -13401,9 +13404,10 @@
my ($reqtype,$uri,$cdom,$cnum,$info,$rtncode) = @_;
$uri=~s/^\///;
my $homeserver = &homeserver($cnum,$cdom);
+ my $hostname = &hostname($homeserver);
my $protocol = $protocol{$homeserver};
$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 $response=&LONCAPA::LWPReq::makerequest($homeserver,$request,'',\%perlvar,'',0,1);
$$rtncode = $response->code;
More information about the LON-CAPA-cvs
mailing list