[LON-CAPA-cvs] cvs: loncom /interface lonhelpmenu.pm lonsupportreq.pm
raeburn
lon-capa-cvs@mail.lon-capa.org
Tue, 13 Jul 2004 17:35:59 -0000
This is a MIME encoded message
--raeburn1089740159
Content-Type: text/plain
raeburn Tue Jul 13 13:35:59 2004 EDT
Modified files:
/loncom/interface lonhelpmenu.pm lonsupportreq.pm
Log:
Help support form allows user to include an uploaded file. Two perl modules required:
MIME::Types (used to determine mime-type of uploaded file) and MIME::Lite used to include file attachment in e-mail message sent to support e-mail address.
--raeburn1089740159
Content-Type: text/plain
Content-Disposition: attachment; filename="raeburn-20040713133559.txt"
Index: loncom/interface/lonhelpmenu.pm
diff -u loncom/interface/lonhelpmenu.pm:1.8 loncom/interface/lonhelpmenu.pm:1.9
--- loncom/interface/lonhelpmenu.pm:1.8 Mon Jul 12 13:02:07 2004
+++ loncom/interface/lonhelpmenu.pm Tue Jul 13 13:35:58 2004
@@ -130,7 +130,7 @@
}
if ($requestmail) {
$r->print('
- <td align="center"> <b><a href="/adm/support?origurl='.$origurl.'&function='.$function.'" target="bodyframe"><image src="/adm/lonMisc/feedback.gif" border="0" alt="(Ask helpdesk)" valign="middle" /> Ask helpdesk</a></b> </td>');
+ <td align="center"> <b><a href="/adm/support?origurl='.&Apache::lonnet::escape($origurl).'&function='.$function.'" target="bodyframe"><image src="/adm/lonMisc/feedback.gif" border="0" alt="(Ask helpdesk)" valign="middle" /> Ask helpdesk</a></b> </td>');
}
if ($faq && $ENV{'user.adv'}) {
$r->print(<<END)
@@ -234,7 +234,7 @@
if ($requestmail) {
$r->print("
<ul>
- <li><a href=\"/adm/support?origurl=$origurl&function=$function\">$lt{'cont'}</a></li>
+ <li><a href=\"/adm/support?origurl=".&Apache::lonnet::escape($origurl)."&function=$function\">$lt{'cont'}</a></li>
</ul>
<p>$lt{'suhr'}</p>
<ul>
Index: loncom/interface/lonsupportreq.pm
diff -u loncom/interface/lonsupportreq.pm:1.4 loncom/interface/lonsupportreq.pm:1.5
--- loncom/interface/lonsupportreq.pm:1.4 Fri Jul 9 17:08:24 2004
+++ loncom/interface/lonsupportreq.pm Tue Jul 13 13:35:58 2004
@@ -2,16 +2,13 @@
use strict;
use lib qw(/home/httpd/lib/perl);
+use MIME::Types;
+use MIME::Lite;
use Apache::Constants qw(:common);
use Apache::loncommon();
use Apache::lonnet();
-use localenroll;
use Apache::lonlocal;
-use Mail::Send;
-# use MIME::Lite;
-# use MIME::Types;
-
sub handler {
my ($r) = @_;
&Apache::loncommon::content_type($r,'text/html');
@@ -38,6 +35,9 @@
my ($os,$browser,$bversion,$uhost,$uname,$udom,$uhome,$urole,$usec,$email,$cid,$cdom,$cnum,$ctitle,$ccode,$sectionlist,$lastname,$firstname,$server);
my $bodytag = &Apache::loncommon::bodytag('',$function,'topmargin="0",marginheight="0"',1);
my $tablecolor = &Apache::loncommon::designparm($function.'.tabbg');
+ if (($tablecolor eq '') || ($tablecolor eq '#FFFFFF')) {
+ $tablecolor = '#CCCCFF';
+ }
$os = $ENV{'browser.os'};
$browser = $ENV{'browser.type'};
$bversion = $ENV{'browser.version'};
@@ -49,7 +49,17 @@
$usec = $ENV{'request.course.sec'};
$cid = $ENV{'request.course.id'};
$server = $ENV{'SERVER_NAME'};
- my $scripttag;
+ my $scripttag = (<<END);
+<script>
+function validate() {
+ if (document.logproblem.email.value.indexOf("\@") == -1) {
+ alert("You must enter a valid e-mail address");
+ return
+ }
+ document.logproblem.submit();
+}
+</script>
+END
if ($cid =~ m/_/) {
($cdom,$cnum) = split/_/,$cid;
}
@@ -77,11 +87,6 @@
my ($sec,$grp) = split/:/,$_;
$groupid{$sec} = $grp;
}
- $r->print(<<END);
-<html>
- <head>
- <title>LON-CAPA support request</title>
-END
my $defdom = $Apache::lonnet::perlvar{'lonDefDomain'};
my $codedom = $defdom;
my %coursecodes = ();
@@ -128,7 +133,7 @@
<tr>
<td>
<table width="100%" border="0" cellpadding="0" cellspacing="1" bgcolor="#ffffff">
- <form method="post" name="logproblem" onSubmit="return validate()">
+ <form method="post" name="logproblem" enctype="multipart/form-data">
<tr>
<td width="140" bgcolor="$tablecolor">
<table width="140" border="0" cellpadding="8" cellspacing="0">
@@ -249,7 +254,7 @@
<table width="100%" border="0" cellpadding="8" cellspacing="0">
<tr>
<td>
- $server$origurl<input type="hidden" name="origurl" value="$server$origurl" />
+ http://$server$origurl<input type="hidden" name="origurl" value="http://$server$origurl" />
</td>
</tr>
</table>
@@ -300,9 +305,9 @@
END
if ($coursecodes{$cnum}) {
foreach (@codetitles) {
- $r->print('<i>'.$_.'</i>: '.$codes{$cnum}{$_});
+ $r->print('<i>'.$_.'</i>: '.$codes{$cnum}{$_}.'; ');
}
- $r->print('. <input type="hidden" name="coursecode" value="'.$coursecodes{$cnum}.'" />');
+ $r->print(' <input type="hidden" name="coursecode" value="'.$coursecodes{$cnum}.'" />');
} else {
$r->print('Enter institutional course code:
<input type="text" name="coursecode" size="15" value="" />');
@@ -344,7 +349,7 @@
if ($_ eq $groupid{$_} || $groupid{$_} eq '') {
$r->print("<option value=\"$_\" />$_");
} else {
- $r->print("<option value=\"$_\" />$_ - (LON-CAPA sec: $groupid{$_}");
+ $r->print("<option value=\"$_\" />$_ - (LON-CAPA sec: $groupid{$_})");
}
}
$r->print("</select>");
@@ -410,6 +415,36 @@
<img src="/adm/lonMisc/blackdot.gif" /><br />
</td>
</tr>
+END
+ if (defined($ENV{'user.name'})) {
+ $r->print(<<END);
+ <tr>
+ <td width="140" bgcolor="$tablecolor">
+ <table width="140" border="0" cellpadding="8" cellspacing="0">
+ <tr>
+ <td align="right"><b>Optional file upload:</b>
+ </td>
+ </tr>
+ </table>
+ </td>
+ <td width="100%" valign="top">
+ <table width="100%" border="0" cellpadding="8" cellspacing="0">
+ <tr>
+ <td>
+ <input type="file" name="screenshot" size="20" /><br />Upload a file (e.g., a screenshot) relevant to your support request (128 KB max. size).
+ </td>
+ </tr>
+ </table>
+ </td>
+ </tr>
+ <tr>
+ <td width="100%" colspan="2" bgcolor="#000000">
+ <img src="/adm/lonMisc/blackdot.gif" /><br />
+ </td>
+ </tr>
+END
+ }
+ $r->print(<<END);
<tr>
<td width="140" bgcolor="$tablecolor">
<table width="140" border="0" cellpadding="8" cellspacing="0">
@@ -424,7 +459,7 @@
<tr>
<td>
<input type="hidden" name="action" value="process" />
- <input type="submit" value="Submit Request Form" />
+ <input type="button" value="Submit Request Form" onClick="validate()"/>
</td>
<td> </td>
<td>
@@ -445,49 +480,25 @@
</tr>
</table>
END
-
-
-# What do we know about this user?
-# foreach (sort keys %ENV) {
-# if ($_ =~ m/^browser/) {
-# $r->print("key is $_, value is $ENV{$_}");
-# } elsif ($_ =~ m/^environment/) {
-# $r->print("key is $_, value is $ENV{$_}");
-# } elsif ($_ =~ m/^request/) {
-# $r->print("key is $_, value is $ENV{$_}");
-# } elsif ($_ =~ m/^user\.(domain|home|name)/) {
-# $r->print("key is $_, value is $ENV{$_}");
-# } elsif ($_ =~ /^[A-Z]/) {
-# $r->print("key is $_, value is $ENV{$_}");
-# }
-# }
- return
+ return;
}
sub print_request_receipt {
my ($r,$url,$function) = @_;
my @envvars = ('lonID','HTTP_HOST','HTTP_USER_AGENT','REMOTE_ADDR','SERVER_ADDR','SERVER_NAME','browser.os','browser.type','browser.version','user.home','request.role');
+ my @loncvars = ('user.name','user.domain','request.course.sec','request.course.id');
+
my $bodytag = &Apache::loncommon::bodytag('',$function,'topmargin="0" marginheight="0"',1);
+ my $admin = $Apache::lonnet::perlvar{'lonAdminMail'};
my $to = $Apache::lonnet::perlvar{'lonSupportEMail'};
+ my $from = $admin;
my $reporttime = &Apache::lonlocal::locallocaltime(time);
my $fontcolor = &Apache::loncommon::designparm($function.'.font');
my $vlinkcolor = &Apache::loncommon::designparm($function.'.vlink');
my $tablecolor = &Apache::loncommon::designparm($function.'.tabbg');
- my @formvars = ('username','email','uname','udom','origurl','phone','section','coursecode','title','subject','description');
+ my @formvars = ('username','email','uname','udom','origurl','phone','section','coursecode','title','subject','description','screenshot');
&Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},\@formvars);
-# if ($ENV{'request.course.fn'}) {
-# my $formdatafile = $ENV{'request.course.fn'}.'.formdata';
-# if (-e $formdatafile) {
-# open(FILE,"<$formdatafile");
-# my @buffer =<FILE>;
-# close(FILE);
-# foreach (@buffer) {
-# print STDERR $_;
-# }
-# }
-# }
-
my $supportmsg = qq|
Name: $ENV{'form.username'}
Email: $ENV{'form.email'}
@@ -500,6 +511,20 @@
Date/Time: $reporttime
|;
+ my $descrip = $ENV{'form.description'};
+ $descrip =~ s#\n#<br />#g;
+ my $displaymsg = qq|
+<font color="$fontcolor">Name:</font><font color="$vlinkcolor"> $ENV{'form.username'}</font><br />
+<font color="$fontcolor">Email: </font><font color="$vlinkcolor">$ENV{'form.email'}</font><br />
+<font color="$fontcolor">Username/domain: </font><font color="$vlinkcolor">$ENV{'form.uname'} - $ENV{'form.udom'}</font><br />
+<font color="$fontcolor">Tel: </font><font color="$vlinkcolor">$ENV{'form.phone'}</font><br />
+<font color="$fontcolor">Course Information: </font><font color="$vlinkcolor">$ENV{'form.title'} - $ENV{'form.coursecode'} - section: $ENV{'form.section'}</font><br />
+<font color="$fontcolor">Subject: </font><font color="$vlinkcolor">$ENV{'form.subject'}</font><br />
+<font color="$fontcolor">Description: </font><font color="$vlinkcolor">$descrip</font><br />
+<font color="$fontcolor">URL: </font><font color="$vlinkcolor">$ENV{'form.origurl'}</font><br />
+<font color="$fontcolor">Date/Time: </font><font color="$vlinkcolor">$reporttime</font><br />
+ |;
+
if ($to =~ m/^[^\@]+\@[^\@]+$/) {
$r->print(<<END);
<html>
@@ -518,28 +543,86 @@
</head>
$bodytag
<h3>Warning: Problem with support e-mail address</h3>
-As the e-mail address provided for this LON-CAPA server ($to) does not appear to be a valid e-mail address, your support request has not been sent to the LON-CAPA support staff at your institution. Instead a copy has been sent to the LON-CAPA support team at Michigan State University.
+As the e-mail address provided for this LON-CAPA server ($to) does not appear to be a valid e-mail address, your support request has <b>not</b> been sent to the LON-CAPA support staff at your institution. Instead a copy has been sent to the LON-CAPA support team at Michigan State University.
END
}
- my $msg = new Mail::Send;
- $msg->to($to);
-# if (defined($ENV{'form.email'})) {
-# if ($ENV{'form.email'} =~ m/^[^\@]+\@[^\@]+$/) {
-# $msg->from($ENV{'form.email'});
-# }
-# }
- $msg->subject('[LON-CAPA] - support request');
- # ->open can cause an sh launch which can pass all of %ENV allong
+ if (defined($ENV{'form.email'})) {
+ if ($ENV{'form.email'} =~ m/^[^\@]+\@[^\@]+$/) {
+ $from = $ENV{'form.email'};
+ }
+ }
+
+ my $subject = $ENV{'form.subject'};
+ $subject =~ s#(`)#'#g;
+ $subject =~ s#\$#\(\$\)#g;
+ $supportmsg =~ s#(`)#'#g;
+ $supportmsg =~ s#\$#\(\$\)#g;
+ $displaymsg =~ s#(`)#'#g;
+ $displaymsg =~ s#\$#\(\$\)#g;
+ my $fname;
+
+ my $attachmentpath = '';
+ my $attachmentsize = '';
+ if (defined($ENV{'user.name'})) {
+ if ($ENV{'form.screenshot.filename'}) {
+ $attachmentsize = length($ENV{'form.screenshot'});
+ if ($attachmentsize > 131072) {
+ $displaymsg .= "<br />The uploaded screenshot file ($attachmentsize bytes) included with your request exceeded the maximum allowed size - 128 KB, and has therefore been discarded.";
+ } else {
+ $attachmentpath=&Apache::lonnet::userfileupload('screenshot',undef,'helprequests');
+ }
+ }
+ }
+
+ if ($attachmentpath =~ m-/([^/]+)$-) {
+ $fname = $1;
+ $displaymsg .= "<br />An uploaded screenshot file - $fname ($attachmentsize bytes) was included in the request sent by $ENV{'user.name'} from LON-CAPA domain: $ENV{'user.domain'}";
+ $supportmsg .= "\n";
+ foreach (@envvars) {
+ $supportmsg .= "$_: $ENV{$_}\n";
+ }
+ }
+
+ my $msg = MIME::Lite->new(
+ From => $from,
+ To => $to,
+ Subject => $subject,
+ Type =>'TEXT',
+ Data => $supportmsg,
+ );
+
+ if ($attachmentpath) {
+ my ($type, $encoding) = MIME::Types::by_suffix($attachmentpath);
+ $msg->attach(Type => $type,
+ Path => $attachmentpath,
+ Filename => $fname
+ );
+
+ } else {
+ my $envdata = '';
+ foreach (@envvars) {
+ $envdata .= "$_: $ENV{$_}\n";
+ }
+ foreach (@loncvars) {
+ $envdata .= "$_: $ENV{$_}\n";
+ }
+ $msg->attach(Type => 'TEXT',
+ Data => $envdata);
+ }
+
+### Send it:
+ # ->send can cause an sh launch which can pass all of %ENV along
# which can be to large for /bin/sh's little mind
my %oldENV=%ENV;
undef(%ENV);
- if (my $fh = $msg->open()) {
- print $fh $supportmsg;
- $fh->close;
- }
+ $msg->send('sendmail');
%ENV=%oldENV;
undef(%oldENV);
- $r->print(<<END);
+
+ if ($attachmentpath =~ m#$Apache::lonnet::perlvar{'lonDaemons'}/tmp/helprequests/(\d+)/[^/]+#) {
+ unlink($attachmentpath);
+ }
+ $r->print(qq|
<b>Your support request contained the following information</b>:<br /><br />
<table width="580" border="0" cellpadding="0" cellspacing="0" bgcolor="#000000">
<tr>
@@ -563,22 +646,19 @@
<td width="100%" valign="top">
<table width="100%" border="0" cellpadding="8" cellspacing="0">
<tr>
- <td>
-END
- my @textmsg = split/\n/,$supportmsg;
- foreach my $line (@textmsg) {
- $line =~ s|^|<font color="$fontcolor">|;
- $line =~ s|:|:</font><font color="$vlinkcolor">|;
- $r->print("$line</font><br />");
- }
- $r->print('</td>
+ <td>$displaymsg</td>
</tr>
</table>
</td>
</tr>
<tr>
- <td width="130" bgcolor="'.$tablecolor.'">
- <table width="130" border="0" cellpadding="8" cellspacing="0">
+ <td width="100%" colspan="2" bgcolor="#000000">
+ <img src="/adm/lonMisc/blackdot.gif" /><br />
+ </td>
+ </tr>
+ <tr>
+ <td width="140" bgcolor="$tablecolor">
+ <table width="140" border="0" cellpadding="8" cellspacing="0">
<tr>
<td align="right"><b>Additional information recorded</b>
</td>
@@ -589,10 +669,11 @@
<table width="100%" border="0" cellpadding="8" cellspacing="0">
<tr>
<td>
- ');
+ |);
foreach (@envvars) {
- $r->print("$_: <font color='$vlinkcolor>$ENV{$_}</font>, ");
- $supportmsg .= "$_: $ENV{$_}\n";
+ unless($ENV{$_} eq '') {
+ $r->print("$_: <font color='$vlinkcolor'>$ENV{$_}</font>, ");
+ }
}
$r->print("
</td>
--raeburn1089740159--