# HG changeset patch
# User mortenp
# Date 1230494626 -39600
# Node ID 1606ae6d900dfe0c5ee52e0233f80e60d618ad72
# Parent  72a79bb89dd38c543a523c03a48c4d04f2ad6219
Fixed injection in contrib/web/perl-user (Gerd von Egidy)

diff -r 72a79bb89dd3 -r 1606ae6d900d ChangeLog
--- a/ChangeLog	Fri Nov 14 03:20:05 2008 +1100
+++ b/ChangeLog	Mon Dec 29 07:03:46 2008 +1100
@@ -1,3 +1,4 @@
+ o Fixed injection in contrib/web/perl-user (Gerd von Egidy)
 1.2.16-RC1
  o Updated Dutch listtexts (Franky Van Liedekerke)
  o Updated Italian listtexts (Fabio Busatto)
diff -r 72a79bb89dd3 -r 1606ae6d900d contrib/web/perl-user/mlmmj.cgi
--- a/contrib/web/perl-user/mlmmj.cgi	Fri Nov 14 03:20:05 2008 +1100
+++ b/contrib/web/perl-user/mlmmj.cgi	Mon Dec 29 07:03:46 2008 +1100
@@ -60,14 +60,13 @@
 	my $date = `/bin/date -R`;
 
 	$mail = "Received: from " . $query->remote_addr()
-		. " by " .  $query->server_name() . " witn HTTP;\n"
+		. " by " .  $query->server_name() . " with HTTP;\n"
 		. "\t$date"
 		. "X-Originating-IP: " . $query->remote_addr() . "\n"
 		. "X-Mailer: mlmmj-webinterface powered by Perl\n"
 		. "Date: $date"
 		. "From: $from\n"
 		. "To: $to\n"
-		. "Cc: $from\n"
 		. "Subject: $subject\n"
 		. "\n"
 		. "$body\n";
@@ -89,6 +88,15 @@
 	return sprintf("%s%s%s@%s", $user, $delimiter, $job, $domain);
 }
 
+sub check_email {
+    my $addr = shift;
+
+    if ($addr !~ /^[-!#$%&\'*+\.\/0-9=?A-Z^_a-z{|}~]+@[-0-9A-Za-z]+\.[-\.0-9A-Za-z]+$/) {
+        return false;
+    } else {
+        return true;
+    }
+}
 
 $query = new CGI;
 
@@ -98,10 +106,7 @@
 $redirect_success = $query->param('redirect_success');
 $email = $query->param('email');
 
-print header;
-print $list;
-
-if (mlmmj_check_list($list) ne false) {
+if (mlmmj_check_list($list) ne false && check_email($email) ne false)) {
 	$to = mlmmj_gen_to($list, $job);
 	if ($to ne false) {
 		mlmmj_mail($email, $to, "$job to $list", $job);