![[site community profile]](https://www.dreamwidth.org/img/comm_staff.png){kind=small}
[dw-free] email alias code cleanup
[commit: http://hg.dwscoalition.org/dw-free/rev/d1255b65ba6a]
http://bugs.dwscoalition.org/show_bug.cgi?id=3176
New convenience method: $u->site_email_alias (no error/priv-checking, just
outputs in the appropriate format). Move emailcheck.pl to LJ::check_email in
LJ::User.
Patch by![[personal profile]](https://www.dreamwidth.org/img/silk/identity/user.png)
kareila.
Files modified:
http://bugs.dwscoalition.org/show_bug.cgi?id=3176
New convenience method: $u->site_email_alias (no error/priv-checking, just
outputs in the appropriate format). Move emailcheck.pl to LJ::check_email in
LJ::User.
Patch by
kareila.Files modified:
- bin/moveucluster.pl
- cgi-bin/LJ/User.pm
- cgi-bin/emailcheck.pl
- cgi-bin/modperl_subs.pl
- htdocs/manage/profile/index.bml
- htdocs/tools/tellafriend.bml
- t/console-reset.t
--------------------------------------------------------------------------------
diff -r 902e293aa620 -r d1255b65ba6a bin/moveucluster.pl
--- a/bin/moveucluster.pl Wed Nov 03 13:18:06 2010 +0800
+++ b/bin/moveucluster.pl Wed Nov 03 13:25:31 2010 +0800
@@ -523,7 +523,7 @@ sub moveUser {
$dbh->do("DELETE FROM domains WHERE userid = ?", undef, $u->id);
$dbh->do("DELETE FROM email_aliases WHERE alias = ?",
- undef, "$u->{user}\@$LJ::USER_DOMAIN");
+ undef, $u->site_email_alias );
$dbh->do("DELETE FROM userinterests WHERE userid = ?", undef, $u->id);
$dbh->do("DELETE FROM comminterests WHERE userid = ?", undef, $u->id);
$dbh->do("DELETE FROM syndicated WHERE userid = ?", undef, $u->id);
diff -r 902e293aa620 -r d1255b65ba6a cgi-bin/LJ/User.pm
--- a/cgi-bin/LJ/User.pm Wed Nov 03 13:18:06 2010 +0800
+++ b/cgi-bin/LJ/User.pm Wed Nov 03 13:25:31 2010 +0800
@@ -345,7 +345,7 @@ sub delete_and_purge_completely {
$dbh->do("DELETE FROM wt_edges WHERE from_userid = ? OR to_userid = ?", undef, $u->id, $u->id);
$dbh->do("DELETE FROM reluser WHERE targetid=?", undef, $u->id);
- $dbh->do("DELETE FROM email_aliases WHERE alias=?", undef, $u->user . "\@$LJ::USER_DOMAIN");
+ $dbh->do("DELETE FROM email_aliases WHERE alias=?", undef, $u->site_email_alias);
$dbh->do("DELETE FROM community WHERE userid=?", undef, $u->id)
if $u->is_community;
@@ -4301,13 +4301,11 @@ sub accounts_by_email {
sub delete_email_alias {
- my $u = shift;
-
- return if exists $LJ::FIXED_ALIAS{$u->user};
+ my $u = $_[0];
my $dbh = LJ::get_db_writer();
$dbh->do( "DELETE FROM email_aliases WHERE alias=?",
- undef, $u->user . "\@$LJ::USER_DOMAIN" );
+ undef, $u->site_email_alias );
return 0 if $dbh->err;
return 1;
@@ -4392,7 +4390,7 @@ sub emails_visible {
}
if ( $whatemail eq "B" || $whatemail eq "V" || $whatemail eq "L" ) {
- push @emails, $u->user . "\@$LJ::USER_DOMAIN"
+ push @emails, $u->site_email_alias
unless $u->prop( 'no_mail_alias' );
}
return wantarray ? @emails : $emails[0];
@@ -4478,17 +4476,23 @@ sub set_email {
}
+sub site_email_alias {
+ my $u = $_[0];
+ my $alias = $u->user . "\@$LJ::USER_DOMAIN";
+ return $alias;
+}
+
+
sub update_email_alias {
- my $u = shift;
+ my $u = $_[0];
return unless $u && $u->can_have_email_alias;
- return if exists $LJ::FIXED_ALIAS{$u->user};
return if $u->prop("no_mail_alias");
return unless $u->is_validated;
my $dbh = LJ::get_db_writer();
$dbh->do( "REPLACE INTO email_aliases (alias, rcpt) VALUES (?,?)",
- undef, $u->user . "\@$LJ::USER_DOMAIN", $u->email_raw );
+ undef, $u->site_email_alias, $u->email_raw );
return 0 if $dbh->err;
return 1;
@@ -5082,7 +5086,7 @@ sub ljtalk_id {
my $u = shift;
croak "Invalid user object passed" unless LJ::isu($u);
- return $u->user . '@' . $LJ::USER_DOMAIN;
+ return $u->site_email_alias;
}
@@ -8572,6 +8576,89 @@ sub rate_log
=head2 Email-Related Functions (LJ)
=cut
+# <LJFUNC>
+# name: LJ::check_email
+# des: checks for and rejects bogus e-mail addresses.
+# info: Checks that the address is of the form username@some.domain,
+# does not contain invalid characters. in the username, is a valid domain.
+# Also checks for mis-spellings of common webmail providers,
+# and web addresses instead of an e-mail address.
+# args:
+# returns: nothing on success, or error with error message if invalid/bogus e-mail address
+# </LJFUNC>
+sub check_email
+{
+ my ($email, $errors) = @_;
+
+ # Trim off whitespace and force to lowercase.
+ $email =~ s/^\s+//;
+ $email =~ s/\s+$//;
+ $email = lc $email;
+
+ my $reject = sub {
+ my $errcode = shift;
+ my $errmsg = shift;
+ # TODO: add $opts to end of check_email and make option
+ # to either return error codes, or let caller supply
+ # a subref to resolve error codes into native language
+ # error messages (probably via BML::ML hash, or something)
+ push @$errors, $errmsg;
+ return;
+ };
+
+ # Empty email addresses are not good.
+ unless ($email) {
+ return $reject->("empty",
+ "Your email address cannot be blank.");
+ }
+
+ # Check that the address is of the form username@some.domain.
+ my ($username, $domain);
+ if ($email =~ /^([^@]+)@([^@]+)/) {
+ $username = $1;
+ $domain = $2;
+ } else {
+ return $reject->("bad_form",
+ "You did not give a valid email address. An email address looks like username\@some.domain");
+ }
+
+ # Check the username for invalid characters.
+ unless ($username =~ /^[^\s\",;\(\)\[\]\{\}\<\>]+$/) {
+ return $reject->("bad_username",
+ "You have invalid characters in your email address username.");
+ }
+
+ # Check the domain name.
+ unless ($domain =~ /^[\w-]+(\.[\w-]+)*\.(ac|ad|ae|aero|af|ag|ai|al|am|an|ao|aq|ar|arpa|as|at|au|aw|az|ba|bb|bd|be|bf|bg|bh|bi|biz|bj|bm|bn|bo|br|bs|bt|bv|bw|by|bz|ca|cc|cd|cf|cg|ch|ci|ck|cl|cm|cn|co|com|coop|cr|cu|cv|cx|cy|cz|de|dj|dk|dm|do|dz|ec|edu|ee|eg|er|es|et|eu|fi|fj|fk|fm|fo|fr|ga|gb|gd|ge|gf|gg|gh|gi|gl|gm|gn|gov|gp|gq|gr|gs|gt|gu|gw|gy|hk|hm|hn|hr|ht|hu|id|ie|il|im|in|info|int|io|iq|ir|is|it|je|jm|jo|jp|ke|kg|kh|ki|km|kn|kr|kw|ky|kz|la|lb|lc|li|lk|lr|ls|lt|lu|lv|ly|ma|mc|md|me|mg|mh|mil|mk|ml|mm|mn|mo|mp|mq|mr|ms|mt|mu|museum|mv|mw|mx|my|mz|na|name|nc|ne|net|nf|ng|ni|nl|no|np|nr|nu|nz|om|org|pa|pe|pf|pg|ph|pk|pl|pm|pn|pr|pro|ps|pt|pw|py|qa|re|ro|rs|ru|rw|sa|sb|sc|sd|se|sg|sh|si|sj|sk|sl|sm|sn|so|sr|st|su|sv|sy|sz|tc|td|tf|tg|th|tj|tk|tl|tm|tn|to|tp|tr|tt|tv|tw|tz|ua|ug|uk|um|us|uy|uz|va|vc|ve|vg|vi|vn|vu|wf|ws|ye|yt|yu|za|zm|zw)$/)
+ {
+ return $reject->("bad_domain",
+ "Your email address domain is invalid.");
+ }
+
+ # Catch misspellings of hotmail.com
+ if ($domain =~ /^(otmail|hotmial|hotmil|hotamail|hotmaul|hoatmail|hatmail|htomail)\.(cm|co|com|cmo|om)$/ or
+ $domain =~ /^hotmail\.(cm|co|om|cmo)$/)
+ {
+ return $reject->("bad_hotmail_spelling",
+ "You gave $email as your email address. Are you sure you didn't mean hotmail.com?");
+ }
+
+ # Catch misspellings of aol.com
+ elsif ($domain =~ /^(ol|aoll)\.(cm|co|com|cmo|om)$/ or
+ $domain =~ /^aol\.(cm|co|om|cmo)$/)
+ {
+ return $reject->("bad_aol_spelling",
+ "You gave $email as your email address. Are you sure you didn't mean aol.com?");
+ }
+
+ # Catch web addresses (two or more w's followed by a dot)
+ elsif ($username =~ /^www*\./)
+ {
+ return $reject->("web_address",
+ "You gave $email as your email address, but it looks more like a web address to me.");
+ }
+}
+
sub set_email {
my ($userid, $email) = @_;
diff -r 902e293aa620 -r d1255b65ba6a cgi-bin/emailcheck.pl
--- a/cgi-bin/emailcheck.pl Wed Nov 03 13:18:06 2010 +0800
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,106 +0,0 @@
-#!/usr/bin/perl
-# This code was forked from the LiveJournal project owned and operated
-# by Live Journal, Inc. The code has been modified and expanded by
-# Dreamwidth Studios, LLC. These files were originally licensed under
-# the terms of the license supplied by Live Journal, Inc, which can
-# currently be found at:
-#
-# http://code.livejournal.org/trac/livejournal/browser/trunk/LICENSE-LiveJournal.txt
-#
-# In accordance with the original license, this code and all its
-# modifications are provided under the GNU General Public License.
-# A copy of that license can be found in the LICENSE file included as
-# part of this distribution.
-#
-#
-# Function to reject bogus email addresses
-#
-
-package LJ;
-use strict;
-
-# <LJFUNC>
-# name: LJ::check_email
-# des: checks for and rejects bogus e-mail addresses.
-# info: Checks that the address is of the form username@some.domain,
-# does not contain invalid characters. in the username, is a valid domain.
-# Also checks for mis-spellings of common webmail providers,
-# and web addresses instead of an e-mail address.
-# args:
-# returns: nothing on success, or error with error message if invalid/bogus e-mail address
-# </LJFUNC>
-sub check_email
-{
- my ($email, $errors) = @_;
-
- # Trim off whitespace and force to lowercase.
- $email =~ s/^\s+//;
- $email =~ s/\s+$//;
- $email = lc $email;
-
- my $reject = sub {
- my $errcode = shift;
- my $errmsg = shift;
- # TODO: add $opts to end of check_email and make option
- # to either return error codes, or let caller supply
- # a subref to resolve error codes into native language
- # error messages (probably via BML::ML hash, or something)
- push @$errors, $errmsg;
- return;
- };
-
- # Empty email addresses are not good.
- unless ($email) {
- return $reject->("empty",
- "Your email address cannot be blank.");
- }
-
- # Check that the address is of the form username@some.domain.
- my ($username, $domain);
- if ($email =~ /^([^@]+)@([^@]+)/) {
- $username = $1;
- $domain = $2;
- } else {
- return $reject->("bad_form",
- "You did not give a valid email address. An email address looks like username\@some.domain");
- }
-
- # Check the username for invalid characters.
- unless ($username =~ /^[^\s\",;\(\)\[\]\{\}\<\>]+$/) {
- return $reject->("bad_username",
- "You have invalid characters in your email address username.");
- }
-
- # Check the domain name.
- unless ($domain =~ /^[\w-]+(\.[\w-]+)*\.(ac|ad|ae|aero|af|ag|ai|al|am|an|ao|aq|ar|arpa|as|at|au|aw|az|ba|bb|bd|be|bf|bg|bh|bi|biz|bj|bm|bn|bo|br|bs|bt|bv|bw|by|bz|ca|cc|cd|cf|cg|ch|ci|ck|cl|cm|cn|co|com|coop|cr|cu|cv|cx|cy|cz|de|dj|dk|dm|do|dz|ec|edu|ee|eg|er|es|et|eu|fi|fj|fk|fm|fo|fr|ga|gb|gd|ge|gf|gg|gh|gi|gl|gm|gn|gov|gp|gq|gr|gs|gt|gu|gw|gy|hk|hm|hn|hr|ht|hu|id|ie|il|im|in|info|int|io|iq|ir|is|it|je|jm|jo|jp|ke|kg|kh|ki|km|kn|kr|kw|ky|kz|la|lb|lc|li|lk|lr|ls|lt|lu|lv|ly|ma|mc|md|me|mg|mh|mil|mk|ml|mm|mn|mo|mp|mq|mr|ms|mt|mu|museum|mv|mw|mx|my|mz|na|name|nc|ne|net|nf|ng|ni|nl|no|np|nr|nu|nz|om|org|pa|pe|pf|pg|ph|pk|pl|pm|pn|pr|pro|ps|pt|pw|py|qa|re|ro|rs|ru|rw|sa|sb|sc|sd|se|sg|sh|si|sj|sk|sl|sm|sn|so|sr|st|su|sv|sy|sz|tc|td|tf|tg|th|tj|tk|tl|tm|tn|to|tp|tr|tt|tv|tw|tz|ua|ug|uk|um|us|uy|uz|va|vc|ve|vg|vi|vn|vu|wf|ws|ye|yt|yu|za|zm|zw)$/)
- {
- return $reject->("bad_domain",
- "Your email address domain is invalid.");
- }
-
- # Catch misspellings of hotmail.com
- if ($domain =~ /^(otmail|hotmial|hotmil|hotamail|hotmaul|hoatmail|hatmail|htomail)\.(cm|co|com|cmo|om)$/ or
- $domain =~ /^hotmail\.(cm|co|om|cmo)$/)
- {
- return $reject->("bad_hotmail_spelling",
- "You gave $email as your email address. Are you sure you didn't mean hotmail.com?");
- }
-
- # Catch misspellings of aol.com
- elsif ($domain =~ /^(ol|aoll)\.(cm|co|com|cmo|om)$/ or
- $domain =~ /^aol\.(cm|co|om|cmo)$/)
- {
- return $reject->("bad_aol_spelling",
- "You gave $email as your email address. Are you sure you didn't mean aol.com?");
- }
-
- # Catch web addresses (two or more w's followed by a dot)
- elsif ($username =~ /^www*\./)
- {
- return $reject->("web_address",
- "You gave $email as your email address, but it looks more like a web address to me.");
- }
-}
-
-1;
-
diff -r 902e293aa620 -r d1255b65ba6a cgi-bin/modperl_subs.pl
--- a/cgi-bin/modperl_subs.pl Wed Nov 03 13:18:06 2010 +0800
+++ b/cgi-bin/modperl_subs.pl Wed Nov 03 13:25:31 2010 +0800
@@ -87,7 +87,6 @@ use LJ::CleanHTML;
use LJ::CleanHTML;
use LJ::Talk;
require "ljfeed.pl";
-require "emailcheck.pl";
require "ljmemories.pl";
require "ljmail.pl";
require "sysban.pl";
diff -r 902e293aa620 -r d1255b65ba6a htdocs/manage/profile/index.bml
--- a/htdocs/manage/profile/index.bml Wed Nov 03 13:18:06 2010 +0800
+++ b/htdocs/manage/profile/index.bml Wed Nov 03 13:25:31 2010 +0800
@@ -331,7 +331,7 @@ body<=
$ret .= "<tr class='field_block'><td class='field_name'>";
$ret .= BML::ml( '.fn.email.site', { siteabbrev => $LJ::SITENAMEABBREV } );
$ret .= "</td><td class='" . $zebra_row1->() . "' style='vertical-align: middle'>\n";
- $ret .= $u->username . "\@$LJ::USER_DOMAIN";
+ $ret .= $u->site_email_alias;
$ret .= "</td><td class='selectvis" . $zebra_row2->() . "'>";
# this is where we get BVL back
my $checked = ( $u->opt_whatemailshow =~ /[BVL]/ ) ? 'Y' : 'N';
diff -r 902e293aa620 -r d1255b65ba6a htdocs/tools/tellafriend.bml
--- a/htdocs/tools/tellafriend.bml Wed Nov 03 13:18:06 2010 +0800
+++ b/htdocs/tools/tellafriend.bml Wed Nov 03 13:25:31 2010 +0800
@@ -48,7 +48,7 @@ _c?>
my $u = LJ::load_userid($remote->{'userid'});
$u->{'emailpref'} = $u->email_raw;
if ( $u->can_have_email_alias ) {
- $u->{'emailpref'} = $u->{'user'} . '@' . $LJ::USER_DOMAIN;
+ $u->{'emailpref'} = $u->site_email_alias;
}
# Email not validated
diff -r 902e293aa620 -r d1255b65ba6a t/console-reset.t
--- a/t/console-reset.t Wed Nov 03 13:18:06 2010 +0800
+++ b/t/console-reset.t Wed Nov 03 13:25:31 2010 +0800
@@ -3,7 +3,6 @@ use Test::More;
use Test::More;
use lib "$ENV{LJHOME}/cgi-bin";
require 'ljlib.pl';
-require "emailcheck.pl";
use LJ::Console;
use LJ::Test qw (temp_user);
local $LJ::T_NO_COMMAND_PRINT = 1;
@@ -57,24 +56,25 @@ ok($u2->password ne $oldpass, "Password
# ------ EMAIL ALIASES ----------
my $user = $u2->user;
+my $alias = $u2->site_email_alias;
is($run->("email_alias show $user"),
"error: You are not authorized to run this command.");
$u->grant_priv("reset_email");
is($run->("email_alias show $user"),
- "error: $user\@$LJ::USER_DOMAIN is not currently defined.");
+ "error: $alias is not currently defined.");
is($run->("email_alias set $user testing\@example.com"),
- "success: Successfully set $user\@$LJ::USER_DOMAIN => testing\@example.com");
+ "success: Successfully set $alias => testing\@example.com");
is($run->("email_alias show $user"),
- "success: $user\@$LJ::USER_DOMAIN aliases to testing\@example.com");
+ "success: $alias aliases to testing\@example.com");
is($run->("email_alias delete $user"),
- "success: Successfully deleted $user\@$LJ::USER_DOMAIN alias.");
+ "success: Successfully deleted $alias alias.");
is($run->("email_alias show $user"),
- "error: $user\@$LJ::USER_DOMAIN is not currently defined.");
+ "error: $alias is not currently defined.");
$u->revoke_priv("reset_email");
--------------------------------------------------------------------------------