Parent Directory
| 
Revision Log
Revision 1059 - (view) (download) (as text)
| 1 : | gage | 1059 | #!/usr/local/bin/webwork-perl |
| 2 : | sam | 2 | |
| 3 : | # $Id$ | ||
| 4 : | |||
| 5 : | # feedback.pl: Mail feedback to a specified user, with the URL of the | ||
| 6 : | # referring page automagically included. Reject bogus | ||
| 7 : | # destination addresses. | ||
| 8 : | # | ||
| 9 : | # Usage: invoke as http://site/cgi-bin/feedback.pl?address1,address2,... | ||
| 10 : | |||
| 11 : | gage | 8 | use lib '.'; use webworkInit; # WeBWorKInitLine |
| 12 : | sam | 2 | use Global; |
| 13 : | use CGI qw(:standard); | ||
| 14 : | use CGI::Carp qw(fatalsToBrowser); | ||
| 15 : | apizer | 560 | use HTML::Entities (); |
| 16 : | sam | 2 | use Net::SMTP; |
| 17 : | |||
| 18 : | $ENV{'PATH'} = ''; # try to avoid PATH attacks | ||
| 19 : | |||
| 20 : | # log access | ||
| 21 : | &Global::log_info('', query_string); | ||
| 22 : | |||
| 23 : | apizer | 144 | my $Course = param('course'); |
| 24 : | # establish environment for this script | ||
| 25 : | &Global::getCourseEnvironment($Course) if defined $Course; | ||
| 26 : | sam | 2 | |
| 27 : | # local configuration stuff | ||
| 28 : | |||
| 29 : | $BGCOLOR = '#ffffff'; | ||
| 30 : | $LOGFILE = &Global::getWebworkLogsDirectory() . "webwork-feedback.log"; | ||
| 31 : | |||
| 32 : | # if path = '/send' we're processing a filled-out form | ||
| 33 : | my $ADDR; # define 'globally' so that it can be used by subroutines | ||
| 34 : | if (path_info() eq '/send') { | ||
| 35 : | |||
| 36 : | # Bad destinations shouldn't make it this far, since we already checked | ||
| 37 : | # for bad "To:" when generating the feedback form. However, it's still | ||
| 38 : | # possible that some evildoer has submitted a bogus form, so we check | ||
| 39 : | # again... | ||
| 40 : | foreach $ADDR (split(/\s*,\s*/, param('To'))) { | ||
| 41 : | &check_destination($ADDR); | ||
| 42 : | |||
| 43 : | &user_error('You didn\'t enter any comments.') | ||
| 44 : | if (param('comments') eq ''); | ||
| 45 : | &user_error('You didn\'t enter an e-mail address.') | ||
| 46 : | unless (param('email') =~/\@/); | ||
| 47 : | |||
| 48 : | my $smtp = Net::SMTP->new($Global::smtpServer, Timeout=>10) || | ||
| 49 : | &internal_error("Couldn't contact SMTP server."); | ||
| 50 : | apizer | 141 | $smtp->mail($Global::smtpSender); |
| 51 : | sam | 2 | |
| 52 : | if ( $smtp->recipient($ADDR)) { # this one's okay, keep going | ||
| 53 : | $smtp->data(&output(0,$ADDR) . access_link($ADDR) ) || | ||
| 54 : | &internal_error("Unknown problem sending message data to SMTP server."); | ||
| 55 : | } else { # we have a problem with this address | ||
| 56 : | apizer | 560 | $smtp->reset; |
| 57 : | sam | 2 | &internal_error("SMTP server doesn't like this address: <$ADDR>."); |
| 58 : | } | ||
| 59 : | $smtp->quit; | ||
| 60 : | apizer | 560 | &log("Mail sent to: " . $ADDR . " from: " .param('email') ); |
| 61 : | sam | 2 | } |
| 62 : | # &log("Mail sent to: " . param('To') . " from: " .param('email') ); | ||
| 63 : | &thank_you; | ||
| 64 : | apizer | 560 | |
| 65 : | sam | 2 | } else { |
| 66 : | |||
| 67 : | # No path info: we're generating a form to be filled-out | ||
| 68 : | |||
| 69 : | $To = $ENV{'QUERY_STRING'}; | ||
| 70 : | $To = $Global::webmaster if ($To eq ''); | ||
| 71 : | &check_destination($To); | ||
| 72 : | &generate_form; | ||
| 73 : | } | ||
| 74 : | |||
| 75 : | exit(0); | ||
| 76 : | |||
| 77 : | ############################## Subroutines ################################# | ||
| 78 : | |||
| 79 : | sub internal_error { | ||
| 80 : | my $msg = join " ", @_; | ||
| 81 : | &log("ERROR: $msg"); | ||
| 82 : | print header, | ||
| 83 : | start_html('-title' => "Internal Error", -bgcolor=>"$BGCOLOR"), | ||
| 84 : | h1('Internal Error'), | ||
| 85 : | b(HTML::Entities::encode($msg)), | ||
| 86 : | p, | ||
| 87 : | "Your message could not be sent. Please notify ", | ||
| 88 : | "<", a({href=>"mailto:$Global::webmaster"}, $Global::webmaster), ">. ", | ||
| 89 : | br, | ||
| 90 : | "We apologize for the inconvenience.", | ||
| 91 : | end_html; | ||
| 92 : | exit(1); | ||
| 93 : | } | ||
| 94 : | |||
| 95 : | sub user_error { | ||
| 96 : | my $msg = join " ", @_; | ||
| 97 : | print header, | ||
| 98 : | apizer | 560 | start_html('-title' => 'User error', -BGCOLOR=>"$BGCOLOR"), |
| 99 : | sam | 2 | h1('User error'), |
| 100 : | p, | ||
| 101 : | b(HTML::Entities::encode($msg)), | ||
| 102 : | p, | ||
| 103 : | "Please hit the "<B>Back</B>" button on your browser to ", | ||
| 104 : | "try again, or notify ", br, | ||
| 105 : | "<", a({href=>"mailto:$Global::webmaster"}, $Global::webmaster), "> ", | ||
| 106 : | "if you believe this message is in error.", | ||
| 107 : | end_html; | ||
| 108 : | exit(1); | ||
| 109 : | } | ||
| 110 : | |||
| 111 : | sub check_destination { | ||
| 112 : | my($address_list) = @_; | ||
| 113 : | |||
| 114 : | my (@address) = split(/\+*,\+*/, $address_list); | ||
| 115 : | for (@address) { | ||
| 116 : | &internal_error("Sorry, I'm not allowed to send mail to <$_>.") | ||
| 117 : | if !/$Global::legalAddress/; | ||
| 118 : | } | ||
| 119 : | } | ||
| 120 : | |||
| 121 : | #http://webwork.math.rochester.edu/cgi-bin/development/processProblem7.pl?probSetKey=51823&probNum=7&Mode=HTML_tth&course=mth161dev&user=gage&key=NQ18Kry70j*.8Lsok3ulG^QHAp3zRG0hjHE5emT4 | ||
| 122 : | sub access_link { | ||
| 123 : | my $ADDR = shift; | ||
| 124 : | my $url = param('referring_url'); | ||
| 125 : | apizer | 560 | $USER = $ADDR; #param('To'); |
| 126 : | $USER =~s/@.*$//; # determine the user (the recipient of this message) from the mail message. This method may change. | ||
| 127 : | sam | 2 | $url =~ s/\?.*$//; |
| 128 : | my $warning_limit = $^W; $^W=0; | ||
| 129 : | apizer | 255 | $url .= '?probSetKey='.param('probSetKey').'&probNum='.param('probNum').'&Mode='.param('Mode').'&show_old_answers=1'.'&course='.param('course')."&user=$USER&key=".param('key'); |
| 130 : | sam | 2 | $^W= $warning_limit; |
| 131 : | apizer | 213 | return ("-------\nTo go directly to the student's page, click on the Access Link and enter your password under Fast relogin.\nAccess Link " . $url . "\n"); |
| 132 : | sam | 2 | } |
| 133 : | |||
| 134 : | sub log { | ||
| 135 : | my $msg = $_[0]; | ||
| 136 : | apizer | 268 | # open(LOGFILE, ">> $LOGFILE") || &internal_error("Can't write to $LOGFILE"); # warn("Can't write to $LOGFILE\n"); |
| 137 : | open(LOGFILE, ">> $LOGFILE") || warn("Can't write to $LOGFILE\n"); ## above line leads to an infinite loop | ||
| 138 : | sam | 2 | print LOGFILE 'Date: ', scalar(localtime), "\n"; |
| 139 : | print LOGFILE $msg; | ||
| 140 : | print LOGFILE "\n------\n"; | ||
| 141 : | close(LOGFILE); | ||
| 142 : | } | ||
| 143 : | |||
| 144 : | sub thank_you { | ||
| 145 : | print header, | ||
| 146 : | start_html( '-title'=>'Thank You', -BGCOLOR=>"$BGCOLOR"), | ||
| 147 : | h1('Your message has been mailed.'), | ||
| 148 : | "To: ", param('To'), | ||
| 149 : | '<pre><br><br>',&output(0,param('To') ),'</pre>', | ||
| 150 : | end_html; | ||
| 151 : | } | ||
| 152 : | |||
| 153 : | sub generate_form { | ||
| 154 : | |||
| 155 : | my $list = "," . $To; | ||
| 156 : | $list =~ s/,/<li>/g; | ||
| 157 : | apizer | 144 | my $from = param('email'); |
| 158 : | $from = ' ' unless defined $from; | ||
| 159 : | sam | 2 | |
| 160 : | print header, | ||
| 161 : | start_html('-title'=>'WeBWorK - Feedback', -bgcolor=>"$BGCOLOR"), | ||
| 162 : | img({align=>'LEFT', alt=>"", src=>$Global::headerImgUrl}), | ||
| 163 : | p({align=>'right'}), | ||
| 164 : | br({clear=>'ALL'}), | ||
| 165 : | hr, | ||
| 166 : | h1('WeBWorK Feedback Gateway'), | ||
| 167 : | start_form('POST', url() . '/send'), | ||
| 168 : | hidden('To', $To), | ||
| 169 : | hidden('name'), | ||
| 170 : | hidden('id'), | ||
| 171 : | hidden('referring_url', referer()), | ||
| 172 : | hidden('probSetKey'), | ||
| 173 : | hidden('setnum'), | ||
| 174 : | hidden('probNum'), | ||
| 175 : | hidden('course'), | ||
| 176 : | hidden('section'), | ||
| 177 : | hidden('recitation'), | ||
| 178 : | hidden('Mode'), | ||
| 179 : | hidden('user'), | ||
| 180 : | hidden('key'), | ||
| 181 : | strong("To: "), kbd($To), br, | ||
| 182 : | strong("From: "), param('name'), br, | ||
| 183 : | p, | ||
| 184 : | apizer | 144 | textfield(-name=>'email',-default => $from, -size=>'32',-override=>1), ' ', b('E-mail'), i(' (must be filled in!)'),br, |
| 185 : | sam | 2 | p, |
| 186 : | b('Your comments:'), ' ', i('(must be filled in!)'), br, | ||
| 187 : | textarea('comments', '', 15, 70), | ||
| 188 : | p, | ||
| 189 : | b(submit('submit', 'Submit Your Comments')), | ||
| 190 : | end_form, | ||
| 191 : | end_html; | ||
| 192 : | } | ||
| 193 : | |||
| 194 : | sub output { | ||
| 195 : | my $suppress_output = $_[0]; | ||
| 196 : | my $addr = $_[1]; | ||
| 197 : | my $msg; | ||
| 198 : | apizer | 144 | my $replyTo = param('email'); |
| 199 : | $replyTo .= ', ' . $Global::defaultReply if ($Global::defaultReply =~ /\w/); | ||
| 200 : | apizer | 560 | |
| 201 : | sam | 2 | $msg = |
| 202 : | # message header | ||
| 203 : | "From: " . param('email') . " (" . param('name') . ")\n" . | ||
| 204 : | "To: " . $addr . "\n" . | ||
| 205 : | apizer | 144 | "Reply-To: " . $replyTo . "\n" . |
| 206 : | sam | 2 | "X-Remote-Host: " . remote_host . " (" . remote_addr . ")\n" . |
| 207 : | "Subject: WeBWorK Feedback from " . param('course'). "/" . param('user'). "\n" . | ||
| 208 : | "\n" . | ||
| 209 : | |||
| 210 : | # message body: student data | ||
| 211 : | "User: " . param('user') . "\n" . | ||
| 212 : | "Name: " . param('name') . "\n" . | ||
| 213 : | "Student ID: " . param('id') . "\n" . | ||
| 214 : | "Course: " . param('course') . "\n" . | ||
| 215 : | "Section: " . param('section') . "\n" . | ||
| 216 : | "Recitation: " . param('recitation') . "\n" . | ||
| 217 : | "PSVN: " . param('probSetKey') . "\n" . | ||
| 218 : | "Set number: " . param('setnum') . "\n" . | ||
| 219 : | "Problem number: " . param('probNum') . "\n" . | ||
| 220 : | "Mode: " . param('Mode') . "\n" . | ||
| 221 : | "Key: " . param('key') . "\n" . | ||
| 222 : | # "DataMunger URL: $munger" . "\n" . | ||
| 223 : | "\n"; | ||
| 224 : | |||
| 225 : | # for logs: don't log actual message, just student info | ||
| 226 : | return $msg if $suppress_output; | ||
| 227 : | |||
| 228 : | # message body: message | ||
| 229 : | $msg .= "Allegedly from: " . param('email') . "\n" . | ||
| 230 : | "Comments:\n-------\n" . param('comments') . "\n"; | ||
| 231 : | |||
| 232 : | return $msg; | ||
| 233 : | } | ||
| 234 : |
| aubreyja at gmail dot com | ViewVC Help |
| Powered by ViewVC 1.0.9 |