From d612c24f206624a4bf5f3b0a862d181ccf16ae99 Mon Sep 17 00:00:00 2001
From: Michal Vaner <vorner@ucw.cz>
Date: Tue, 26 Aug 2008 18:10:50 +0200
Subject: [PATCH] Untaint data when sending mail

Config is part of program, check email address
---
 PciIds/Config.pm     |  1 +
 PciIds/Email.pm      |  4 ++++
 PciIds/Html/Users.pm |  9 ---------
 PciIds/Users.pm      | 11 ++++++++++-
 4 files changed, 15 insertions(+), 10 deletions(-)

diff --git a/PciIds/Config.pm b/PciIds/Config.pm
index 8d7a98a..49f5599 100644
--- a/PciIds/Config.pm
+++ b/PciIds/Config.pm
@@ -16,6 +16,7 @@ sub loadConf() {
 		my( $name, $val );
 		die "Invalid syntax on line $_\n" unless( ( $name, $val ) = /^\s*(.*\S)\s*=\s*(.*\S)\s*$/ );
 		$val =~ s/^"(.*)"$/$1/;
+		( $val ) = ( $val =~ /(.*)/ ); #Untaint the value - config is considered part of the program
 		$config{$name} = $val;
 	}
 	close CONFIG;
diff --git a/PciIds/Email.pm b/PciIds/Email.pm
index 1043a9c..55d224c 100644
--- a/PciIds/Email.pm
+++ b/PciIds/Email.pm
@@ -2,6 +2,7 @@ package PciIds::Email;
 use strict;
 use warnings;
 use PciIds::Config;
+use PciIds::Users;
 use base 'Exporter';
 
 our @EXPORT = qw(&sendMail);
@@ -12,6 +13,9 @@ defConf( { 'sendmail' => '/usr/sbin/sendmail' } );
 sub sendMail( $$$ ) {
 	my( $to, $subject, $body ) = @_;
 	my( $from, $sendmail ) = confList( [ 'from_addr', 'sendmail' ] );
+	my $error;
+	( $error, $to ) = emailCheck( $to, undef );
+	die "Invalid email in database $to\n" if defined $error;
 	$body =~ s/^\.$/../gm;
 	open SENDMAIL, "|$sendmail -f$from $to" or die 'Can not send mail';
 	print SENDMAIL "From: $from\n".
diff --git a/PciIds/Html/Users.pm b/PciIds/Html/Users.pm
index eb0b6f1..69c03c1 100644
--- a/PciIds/Html/Users.pm
+++ b/PciIds/Html/Users.pm
@@ -43,15 +43,6 @@ sub loginCheck( $$ ) {
 	return undef;
 }
 
-sub emailCheck( $$ ) {
-	my( $email, $tables ) = @_;
-	my $newmail;
-	return 'Does not look like an email address' unless ( ( $newmail ) = ( $email =~ /^([^,? "'`;]+@[^@,?\/ "'`;]+)$/ ) );#make sure the mail is not only reasonable looking, but safe to work with too
-	return 'Email too long' if length $newmail > 255;
-	return 'An account for this email address already exists' if( $tables->hasEmail( $newmail ) );
-	return ( undef, $newmail );
-}
-
 sub registerSubmit( $$$ ) {#A registration form has been submited
 	my( $req, $args, $tables ) = @_;
 	my( $data, $error ) = getForm( {
diff --git a/PciIds/Users.pm b/PciIds/Users.pm
index 3f6e38e..eb49ba3 100644
--- a/PciIds/Users.pm
+++ b/PciIds/Users.pm
@@ -13,7 +13,16 @@ use Apache2::Connection;
 
 my( %privnames, %privnums );
 
-our @EXPORT = qw(&addUser &emailConfirm &checkConfirmHash &saltedPasswd &genAuthToken &checkAuthToken &hasRight &getRightDefs &genResetHash &changePasswd &pushProfile);
+our @EXPORT = qw(&addUser &emailConfirm &checkConfirmHash &saltedPasswd &genAuthToken &checkAuthToken &hasRight &getRightDefs &genResetHash &changePasswd &pushProfile &emailCheck);
+
+sub emailCheck( $$ ) {
+	my( $email, $tables ) = @_;
+	my $newmail;
+	return 'Does not look like an email address' unless ( ( $newmail ) = ( $email =~ /^([^,? "'`;]+@[^@,?\/ "'`;]+)$/ ) );#make sure the mail is not only reasonable looking, but safe to work with too
+	return 'Email too long' if length $newmail > 255;
+	return 'An account for this email address already exists' if( ( defined $tables ) && $tables->hasEmail( $newmail ) );
+	return ( undef, $newmail );
+}
 
 sub saltedPasswd( $$ ) {
 	my( $email, $passwd ) = @_;
-- 
2.39.2