Untaint data when sending mail

Config is part of program, check email address

diff --git a/PciIds/Config.pm b/PciIds/Config.pm
index 8d7a98affe2f76f952854a284632d111fac1eab6..49f5599aad29c8b2e9d6887d4553dc33f0a10247 100644 (file)
--- 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 1043a9c05f2f058f2e26715b5babfeb0dc28a4ee..55d224cc2ba0a2625add49695d4f6489aa0e8efb 100644 (file)
--- 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 eb0b6f133608f25205ae895d39e9f743d35a14a1..69c03c109b61bdb4e42d7c09850997b88f7450ef 100644 (file)
--- 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 3f6e38eebdb3bdf4073a34168af61a20ff3aba0e..eb49ba3e21547f0404689d6651040614f59604ba 100644 (file)
--- 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 ) = @_;