Fixed injection in contrib/web/perl-user (Gerd von Egidy)

diff --git a/ChangeLog b/ChangeLog
index 1ff096b60129c0c3591aa02090558de13653765f..9b4c64ac483d7189b313bdf5e72521d9a4e6351f 100644 (file)
--- a/ChangeLog
+++ b/ChangeLog
@@ -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 --git a/contrib/web/perl-user/mlmmj.cgi b/contrib/web/perl-user/mlmmj.cgi
index 84974fb293a2366e60eb2981f36b1ba668d56220..b05169b31d61ee8316e664577db97a78d53fe8ef 100755 (executable)
--- a/contrib/web/perl-user/mlmmj.cgi
+++ b/contrib/web/perl-user/mlmmj.cgi
@@ -60,14 +60,13 @@ sub mlmmj_mail {
        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 @@ sub mlmmj_gen_to {
        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_failure = $query->param('redirect_failure');
 $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);