--- loncom/interface/lonsupportreq.pm 2017/10/15 03:43:52 1.79.2.3.2.1
+++ loncom/interface/lonsupportreq.pm 2022/01/19 13:57:19 1.79.2.10
@@ -1,7 +1,7 @@
# The LearningOnline Network with CAPA
# Helpdesk request form
#
-# $Id: lonsupportreq.pm,v 1.79.2.3.2.1 2017/10/15 03:43:52 raeburn Exp $
+# $Id: lonsupportreq.pm,v 1.79.2.10 2022/01/19 13:57:19 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -69,7 +69,9 @@ sub handler {
}
}
my $origurl = $env{'form.origurl'};
- $origurl =~ s{^https?://}{};
+ if ($origurl =~ m{^https?://[^/]+(.*)$}) {
+ $origurl = $1;
+ }
$origurl =~ s/(`)//g;
$origurl =~ s/\$/\(\$\)/g;
my $command = $env{'form.command'};
@@ -151,7 +153,6 @@ sub print_request_form {
}
}
- my %coursecodes;
my %codes;
my @codetitles;
my %cat_titles;
@@ -159,9 +160,7 @@ sub print_request_form {
my %idlist;
my %idnums;
my %idlist_titles;
- my $caller = 'global';
my $totcodes = 0;
- my $format_reply;
my $jscript = '';
my $loaditems = qq|
function initialize_codes() {
@@ -169,10 +168,17 @@ function initialize_codes() {
}
|;
unless ($helpform{'course'} eq 'no') {
- $totcodes = &Apache::courseclassifier::retrieve_instcodes(\%coursecodes,$codedom);
- if ($totcodes > 0) {
- $format_reply = &Apache::lonnet::auto_instcode_format($caller,$codedom,\%coursecodes,\%codes,\@codetitles,\%cat_titles,\%cat_order);
- if ($format_reply eq 'ok') {
+ my $instcats = &Apache::lonnet::get_dom_instcats($codedom);
+ if (ref($instcats) eq 'HASH') {
+ if ((ref($instcats->{'codetitles'}) eq 'ARRAY') && (ref($instcats->{'codes'}) eq 'HASH') &&
+ (ref($instcats->{'cat_titles'}) eq 'HASH') && (ref($instcats->{'cat_order'}) eq 'HASH')) {
+ %codes = %{$instcats->{'codes'}};
+ @codetitles = @{$instcats->{'codetitles'}};
+ %cat_titles = %{$instcats->{'cat_titles'}};
+ %cat_order = %{$instcats->{'cat_order'}};
+ $totcodes = scalar(keys(%codes));
+ }
+ if ($totcodes > 0) {
my $numtypes = @codetitles;
&Apache::courseclassifier::build_code_selections(\%codes,\@codetitles,\%cat_titles,\%cat_order,\%idlist,\%idnums,\%idlist_titles);
my ($scripttext,$longtitles) = &Apache::courseclassifier::javascript_definitions(\@codetitles,\%idlist,\%idlist_titles,\%idnums,\%cat_titles);
@@ -316,7 +322,9 @@ $loaditems
// ]]>
ENDJS
- if ($recaptcha_version >=2) {
+ if ($knownuser) {
+ $js .="\n".'';
+ } elsif ($recaptcha_version >=2) {
$js.= "\n".''."\n";
}
my %add_entries = (
@@ -385,7 +393,11 @@ ENDJS
$i = $num%2;
if ($knownuser) {
if ($homeserver) {
- unless ($helpform{'cc'} eq 'no') {
+ my $ip = &Apache::lonnet::get_requestor_ip($r);
+ my %setters;
+ my ($startblock,$endblock,$triggerblock,$by_ip,$blockdom) =
+ &Apache::loncommon::blockcheck(\%setters,'com',$ip);
+ unless (($helpform{'cc'} eq 'no') || ($by_ip)) {
$output .= &Apache::lonhtmlcommon::row_title($html_lt{'emac'},undef,$css[$i]).
'
'."\n".
&Apache::lonhtmlcommon::row_closure();
@@ -574,10 +586,11 @@ ENDJS
$showmax = $helpform{'maxsize'};
}
$showmax = ' ('.sprintf("%.2f",$showmax).' '.&mt('MB max.').')';
- $output .= &Apache::lonhtmlcommon::row_title($html_lt{'opfi'},undef,$css[$i]).
- '
'.
- "\n".$html_lt{'uplf'}.$showmax."\n".
- &Apache::lonhtmlcommon::row_closure();
+ $output .= &Apache::lonhtmlcommon::row_title($html_lt{'opfi'},undef,$css[$i])
+ .' '
+ .''
+ .'
'."\n".$html_lt{'uplf'}.$showmax."\n"
+ .&Apache::lonhtmlcommon::row_closure();
$num ++;
$i = $num%2;
}
@@ -654,10 +667,19 @@ sub print_request_receipt {
return;
}
}
- my @ENVvars = ('HTTP_HOST','HTTP_USER_AGENT','REMOTE_ADDR','SERVER_ADDR','SERVER_NAME');
+ my $ip = &Apache::lonnet::get_requestor_ip($r);
+ my %setters;
+ my ($startblock,$endblock,$triggerblock,$by_ip,$blockdom) =
+ &Apache::loncommon::blockcheck(\%setters,'com',$ip);
+ my @ENVvars = ('HTTP_HOST','HTTP_USER_AGENT','SERVER_ADDR','SERVER_NAME');
my @envvars = ('browser.os','browser.type','browser.version','user.home','request.role');
my @loncvars = ('user.name','user.domain','request.course.sec','request.course.id');
- my @cookievars = ('lonID');
+ my @cookievars;
+ if ($ENV{'SERVER_PORT'} == 443) {
+ @cookievars = ('lonLinkID');
+ } else {
+ @cookievars = ('lonID');
+ }
my $admin = $Apache::lonnet::perlvar{'lonAdminMail'};
my $origmail = $Apache::lonnet::perlvar{'lonSupportEMail'};
@@ -694,7 +716,7 @@ sub print_request_receipt {
unless ($helpform{'course'} eq 'no') {
$formvars{'course'} = 1;
}
- unless ($helpform{'cc'} eq 'no') {
+ unless (($helpform{'cc'} eq 'no') || ($by_ip)) {
$formvars{'cc'} = 1;
}
unless ($helpform{'screenshot'} eq 'no') {
@@ -705,8 +727,12 @@ sub print_request_receipt {
$coursecode = $env{'form.coursecode'};
if ($coursecode eq '') {
my $totcodes = 0;
- my %coursecodes;
- $totcodes = &Apache::courseclassifier::retrieve_instcodes(\%coursecodes,$defdom);
+ my $instcats = &Apache::lonnet::get_dom_instcats($defdom);
+ if (ref($instcats) eq 'HASH') {
+ if (ref($instcats->{'codes'}) eq 'HASH') {
+ $totcodes = scalar(keys(%{$instcats->{'codes'}}));
+ }
+ }
my @standardnames = &Apache::loncommon::get_standard_codeitems();
if ($totcodes > 0) {
my $noregexps = 1;
@@ -882,7 +908,7 @@ $lt{'date'}: $reporttime
$env{'form.'.$field} =~ s/\s+$//;
}
if ($env{'form.uname'} =~ /^$match_username$/) {
- $requdom = $env{'form.udom'};
+ $requname = $env{'form.uname'};
}
if ($env{'form.udom'} =~ /^$match_domain$/) {
$requdom = $env{'form.udom'};
@@ -1016,7 +1042,9 @@ END
if ($$cookie{'lonID'} =~ /lonID=($LONCAPA::handle_re);/) {
$cookies{'lonID'} = $1;
}
-
+ if ($$cookie{'lonLinkID'} =~ /lonLinkID=([a-f0-9]+_linked);/) {
+ $cookies{'lonLinkID'} = $1;
+ }
if ($attachmentpath =~ m-/([^/]+)$-) {
$fname = $1;
$displaymsg .= '
'
@@ -1031,6 +1059,7 @@ END
foreach my $var(@ENVvars) {
$supportmsg .= "$var: $ENV{$var}\n";
}
+ $supportmsg .= "REMOTE_ADDR: $ip\n";
foreach my $var (@envvars) {
$supportmsg .= "$var: $env{$var}\n";
}
@@ -1051,6 +1080,7 @@ END
foreach my $var (@ENVvars) {
$attachment_text .= "$var: $ENV{$var}\n";
}
+ $attachment_text .= "REMOTE_ADDR: $ip\n";
foreach my $var (@envvars) {
$attachment_text .= "$var: $env{$var}\n";
}
@@ -1125,6 +1155,10 @@ END
$var.': '.$ENV{$var}.', ';
}
}
+ if ($ip ne '') {
+ $envmsg .= ''.
+ 'REMOTE_ADDR: '.$ip.', ';
+ }
foreach my $var (@envvars) {
if ($env{$var} ne '') {
$envmsg .= ''.