Parent Directory
| 
Revision Log
go back to old version while I think about the changes
1 #!/usr/local/bin/webwork-perl 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 use lib '.'; use webworkInit; # WeBWorKInitLine 12 use Global; 13 use CGI qw(:standard); 14 use CGI::Carp qw(fatalsToBrowser); 15 use HTML::Entities (); 16 use Net::SMTP; 17 18 $ENV{'PATH'} = ''; # try to avoid PATH attacks 19 20 # log access 21 &Global::log_info('', query_string); 22 23 my $Course = param('course'); 24 # establish environment for this script 25 &Global::getCourseEnvironment($Course) if defined $Course; 26 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 $smtp->mail($Global::smtpSender); 51 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 $smtp->reset; 57 &internal_error("SMTP server doesn't like this address: <$ADDR>."); 58 } 59 $smtp->quit; 60 &log("Mail sent to: " . $ADDR . " from: " .param('email') ); 61 } 62 # &log("Mail sent to: " . param('To') . " from: " .param('email') ); 63 &thank_you; 64 65 } 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 start_html('-title' => 'User error', -BGCOLOR=>"$BGCOLOR"), 99 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 $USER = $ADDR; #param('To'); 126 $USER =~s/@.*$//; # determine the user (the recipient of this message) from the mail message. This method may change. 127 $url =~ s/\?.*$//; 128 my $warning_limit = $^W; $^W=0; 129 $url .= '?probSetKey='.param('probSetKey').'&probNum='.param('probNum').'&Mode='.param('Mode').'&show_old_answers=1'.'&course='.param('course')."&user=$USER&key=".param('key'); 130 $^W= $warning_limit; 131 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 } 133 134 sub log { 135 my $msg = $_[0]; 136 # 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 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 my $from = param('email'); 158 $from = ' ' unless defined $from; 159 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 textfield(-name=>'email',-default => $from, -size=>'32',-override=>1), ' ', b('E-mail'), i(' (must be filled in!)'),br, 185 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 my $replyTo = param('email'); 199 $replyTo .= ', ' . $Global::defaultReply if ($Global::defaultReply =~ /\w/); 200 201 $msg = 202 # message header 203 "From: " . param('email') . " (" . param('name') . ")\n" . 204 "To: " . $addr . "\n" . 205 "Reply-To: " . $replyTo . "\n" . 206 "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 |