head<=
<=head
body<=
" unless LJ::text_in(\%POST);
my $mode = $POST{'mode'};
my $code = $POST{'code'} || $GET{'code'};
if ($LJ::USE_SSL && ! $LJ::IS_SSL && $FORM{'ssl'} ne "no") {
return BML::redirect("$LJ::SSLROOT/create.bml");
}
# with no mode, decide which screen the user sees first, based
# on whether or not this LJ installation lets in free users
if ($mode eq "") {
$mode = $LJ::USE_ACCT_CODES ?
($code ? "codesubmit" : "entercode")
: "getinfo";
}
my $remote = LJ::get_remote();
my %errors;
my $error_msg = sub {
my $key = shift;
my $pre = shift;
my $post = shift;
my $msg = $errors{$key};
return unless $msg;
return "$pre $msg $post";
};
# Flag to indicate they've submitted with 'audio' as the answer to the spambot
# challenge.
my $wants_audio = 0;
# Captcha
my $recaptcha = Captcha::reCAPTCHA->new;
# validate a code they've entered and throw them back to entercode
# mode if it's invalid
if ($code && $mode eq "submit" || # account codes turned off, but one specified anyway
$LJ::USE_ACCT_CODES && ($mode eq "codesubmit" || $mode eq "submit")) # account codes required
{
my $error;
my $userid = 0; # acceptable userid for double-click protection
if ($mode eq "submit") {
my $u = LJ::load_user($POST{'user'});
$userid = $u->{'userid'};
}
$errors{'code'} = $error
unless (LJ::acct_code_check($code, \$error, $userid));
if (%errors) {
$mode = "entercode";
} elsif ($mode eq "codesubmit") {
$mode = "getinfo";
}
}
# MODE: entercode - enter an account code to proceed making an account
if ($LJ::USE_ACCT_CODES && $mode eq "entercode")
{
my $ret;
my $v;
$ret .= "\n";
open (REM, "$LJ::HOME/htdocs/inc/account-codes");
while () {
$ret .= $_;
}
close REM;
return $ret;
}
# MODE: submit - if they've given 'audio' as the answer to the spambot-blocker,
# reset the mode to 'getinfo' and set the audio flag
if ( $LJ::HUMAN_CHECK{create} && $mode eq 'submit' && lc($POST{answer}) eq 'audio' )
{
$mode = 'getinfo';
$wants_audio = 1;
}
# MODE: submit - try to create an account. might change mode
# if there are errors, we'll populate %errors and
# return to "getinfo" mode below
SUBMIT:
while ($mode eq "submit") # using while instead of if so we can 'last' out of it
{
return "$ML{'Error'}: $ML{'.error.postrequired'}" unless LJ::did_post();
my $user = LJ::canonical_username($POST{'user'});
my $email = LJ::trim(lc($POST{'email'}));
# setup global things that can be used to modify the user later
my $is_underage = 0; # turn on if the user should be marked as underage
my $ofage = 0; # turn on to note that the user is over 13 in actuality
# (but is_underage might be on which just means that their
# account is being marked as underage--even if they're old
# enough [unique cookie check])
# reject this email?
return LJ::sysban_block(0, "Create user blocked based on email",
{ 'new_user' => $user, 'email' => $email, 'name' => $user })
if LJ::sysban_check('email', $email);
my $dbh = LJ::get_db_writer();
if (length($user) > 15) {
$errors{'username'} = "$ML{'error.usernamelong'}";
}
if ($POST{'user'} && ! $user) {
$errors{'username'} = "$ML{'error.usernameinvalid'}";
}
unless ($POST{'user'}) {
$errors{'username'} = "$ML{'.error.username.mustenter'}";
}
foreach my $re ("^system\$", @LJ::PROTECTED_USERNAMES) {
next unless ($user =~ /$re/);
# you can give people sharedjournal priv ahead of time to create
# reserved communities:
next if LJ::check_priv($remote, "sharedjournal", $user);
$errors{'username'} = "$ML{'.error.username.reserved'}";
}
# see if they're confused and entered a valid account code
# for their username (happens often)
if ($LJ::USE_ACCT_CODES && $user =~ /^.....a[ab].....$/) {
# see if the acctcode is valid and unused
my ($acid, $auth) = LJ::acct_code_decode($user);
my $is_valid = $dbh->selectrow_array("SELECT COUNT(*) FROM acctcode ".
"WHERE acid=? AND rcptid=0",
undef, $acid);
$errors{'username'} = "$ML{'.error.username.iscode'}"
if $is_valid;
}
my $u = LJ::load_user($user);
my $second_submit = 0;
if ($u) {
my $in_use = 1;
if ($u->{'email'} eq $POST{'email'}) {
if (LJ::login_ip_banned($u)) {
# brute-force possible going on
} else {
if ($u->{'password'} eq $POST{'password1'}) {
# oh, they double-clicked the submit button
$second_submit = 1;
$in_use = 0;
} else {
LJ::handle_bad_login($u);
}
}
}
if ($in_use) {
$errors{'username'} = "$ML{'.error.username.inuse'}";
}
}
$POST{'password1'} = LJ::trim($POST{'password1'});
$POST{'password2'} = LJ::trim($POST{'password2'});
if ($POST{'password1'} ne $POST{'password2'}) {
$errors{'password'} = "$ML{'.error.password.nomatch'}";
} else {
my @checkpass = LJ::run_hooks("bad_password",
{ 'user' => $user, 'name' => $user,
'email' => $email, 'password' => $POST{'password1'} });
if (@checkpass && $checkpass[0]->[0]) {
$errors{'password'} = "Bad password: $checkpass[0]->[0]";
}
}
if (! $POST{'password1'}) {
$errors{'password'} = "$ML{'.error.password.blank'}";
} elsif (length $POST{'password1'} > 30) {
$errors{'password'} = "$ML{'password.max30'}";
}
unless (LJ::is_ascii($POST{'password1'})) {
$errors{'password'} = "$ML{'.error.password.asciionly'}";
}
### start COPPA_CHECK
# age checking to determine how old they are
if ($LJ::COPPA_CHECK) {
my $uniq;
if ($LJ::UNIQ_COOKIES) {
$uniq = Apache->request->notes('uniq');
if ($uniq) {
my $timeof = $dbh->selectrow_array('SELECT timeof FROM underage WHERE uniq = ?', undef, $uniq);
$is_underage = 1 if $timeof && $timeof > 0;
}
}
my ($year, $mon, $day) = ( $POST{"bday_yyyy"}+0, $POST{"bday_mm"}+0, $POST{"bday_dd"}+0 );
if ($year < 100) {
$POST{'bday_yyyy'} += 1900;
$year += 1900;
}
# get current time
my ($nday, $nmon, $nyear) = (gmtime())[3, 4, 5];
$nyear += 1900;
$nmon += 1;
# require dates in the 1900s (or beyond)
if ($year && $mon && $day && $year >= 1900 && $year <= $nyear) {
# now see how many years back they are
my $ofageyear = $year + 13;
if ($ofageyear > $nyear) {
$is_underage = 1;
} elsif ($ofageyear == $nyear) {
# years match, see if they were born after this month
if ($mon > $nmon) {
$is_underage = 1;
} elsif ($mon == $nmon) {
# now check the day
if ($day > $nday) {
$is_underage = 1;
} else {
$ofage = 1;
}
} else {
$ofage = 1;
}
} else {
$ofage = 1;
}
} else {
$errors{'bday'} = "$ML{'.error.birthday.invalid'}";
}
# note this unique cookie as underage (if we have a unique cookie)
if ($is_underage && $uniq) {
$dbh->do("REPLACE INTO underage (uniq, timeof) VALUES (?, UNIX_TIMESTAMP())", undef, $uniq);
}
}
### end COPPA_CHECK
if ($LJ::TOS_CHECK && ! $POST{'agree_tos'}) {
$errors{'agree_tos'} = $ML{'tos.error'};
}
# check the email address
{
my @email_errors;
LJ::check_email($email, \@email_errors);
if ($LJ::USER_EMAIL and $email =~ /\@\Q$LJ::USER_DOMAIN\E$/i) {
push @email_errors, BML::ml(".error.email.lj_domain",
{domain => $LJ::USER_DOMAIN});
}
$errors{'email'} = join(", ", @email_errors) if @email_errors;
}
# Check the turing test answer if it's turned on
if ($LJ::HUMAN_CHECK{create}) {
my $result = $recaptcha->check_answer($LJ::recaptcha_private_key, LJ::get_remote_ip(),
$POST{recaptcha_challenge_field},
$POST{recaptcha_response_field});
$errors{'captcha'} = $ML{'.captcha.invalid'} unless $result->{is_valid};
}
if ($LJ::LJR_NEWACC_RATE && $LJ::LJR_NEWACC_RATEPERIOD) {
my $numaccs = $dbh->selectrow_array(
"SELECT count(*) FROM userlog WHERE ip = ? and action = 'account_create' and logtime > UNIX_TIMESTAMP() - ?",
undef, LJ::get_remote_ip(), $LJ::LJR_NEWACC_RATEPERIOD);
if ($numaccs > $LJ::LJR_NEWACC_RATE) {
$errors{'banned'} = 'Sorry, we do not accept that much accounts from one person that fast.';
}
}
use Golem;
my $tnet = Golem::get_containing_net(LJ::get_remote_ip(), {"with_props" => 1});
$tnet = Golem::get_net(LJ::get_remote_ip(), 32, {"with_props" => 1}) unless $tnet;
if ($tnet && $tnet->{'props'}->{'data'}->{'ban_new_accounts'}) {
$errors{'banned'} = 'Sorry, we do not accept accounts from you.';
}
last SUBMIT if %errors;
my $clusterid = ($LJ::ALLOW_CLUSTER_SELECT
? $POST{'cluster_id'}
: LJ::new_account_cluster()) + 0;
die "Cluster 0 not supported" unless $clusterid;
my $userid = $u ? $u->{'userid'}+0 : 0;
unless ($second_submit)
{
my $caps = int($LJ::NEWUSER_CAPS);
my $status = ($LJ::EVERYONE_VALID ? 'A' : 'N');
my $errorcounter = 0;
my $old_print_error = $dbh->{PrintError}; # save PrintError mode
$dbh->{PrintError} = 0; # will check for errors manually
while (1) {
my $ruserid = LJ::get_new_userid("P");
if (!$ruserid) {
return "";
}
$dbh->do("set insert_id = $ruserid");
$dbh->do(
"INSERT INTO user (user, email, password, status, caps, name, clusterid, dversion) ".
"VALUES (?, ?, ?, ?, ?, ?, ?, ?)",
undef, $user, $email, $POST{'password1'}, $status, $caps,
$user, $clusterid, $LJ::MAX_DVERSION);
if ($dbh->err) {
# who wants to try forever
if ($errorcounter > 10) {
return "" . $dbh->errstr . " p?>";
}
$errorcounter++;
sleep 1; # let it breathe
next; # try again
}
else {
$userid = $dbh->{'mysql_insertid'}; # smells like success
$dbh->{PrintError} = $old_print_error; # restore error reporting
return 0 unless $userid; # but?
last; # finally
}
}
if ($LJ::LJR_FIF) {
use LJ::MemCache;
my $ljr_fif_id = LJ::get_userid($LJ::LJR_FIF);
if ($ljr_fif_id) {
$dbh->do("INSERT INTO friends (userid, friendid) VALUES (?, ?)", undef, $ljr_fif_id, $userid);
# refresh memcache
#my $memkey = [$ljr_fif_id, "friends:$ljr_fif_id"];
#LJ::MemCache::delete($memkey);
LJ::get_friends($ljr_fif_id, undef, undef, 'force', {} );
}
}
$dbh->do("REPLACE INTO useridmap (userid, user) VALUES (?, ?)", undef, $userid, $user);
$dbh->do("REPLACE INTO userusage (userid, timecreate) VALUES (?, NOW())", undef, $userid);
# if we're using account codes on this site, mark the code as used
if ($code) {
my ($acid, $auth) = LJ::acct_code_decode($code);
$dbh->do("UPDATE acctcode SET rcptid=$userid WHERE acid=$acid");
if ($dbh->err) { return $dbh->errstr; }
}
# if we have initial friends for new accounts, add them.
foreach my $friend (@LJ::INITIAL_FRIENDS) {
my $friendid = LJ::get_userid($friend);
LJ::add_friend($userid, $friendid) if $friendid;
}
foreach my $friend (@LJ::INITIAL_OPTIONAL_FRIENDS) {
my $friendid = LJ::get_userid($friend);
LJ::add_friend($userid, $friendid) if $friendid and $POST{"initial_optional_friend_$friend"};
}
# Set any properties that get set in new users
while (my ($name, $val) = each %LJ::USERPROP_INIT) {
LJ::set_userprop($userid, $name, $val);
}
LJ::run_hooks("post_create", {
'userid' => $userid,
'user' => $user,
'code' => $code,
});
}
# send welcome mail... unless they're underage
unless ($is_underage) {
my $aa = {};
if ($userid) {
$aa = LJ::register_authaction($userid, "validateemail", $email);
}
my $body = BML::ml('email.newacct2.body', {
"email" => $email,
"regurl" => "$LJ::SITEROOT/confirm/$aa->{'aaid'}.$aa->{'authcode'}",
"username" => $user,
"sitename" => $LJ::SITENAME,
"siteroot" => $LJ::SITEROOT,
"admin_email" => $LJ::ADMIN_EMAIL,
"bogus_email" => $LJ::BOGUS_EMAIL,
});
LJ::send_mail({
'to' => $email,
'from' => $LJ::ADMIN_EMAIL,
'fromname' => $LJ::SITENAME,
'charset' => 'utf-8',
'subject' => BML::ml('email.newacct.subject', {'sitename' => $LJ::SITENAME}),
'body' => $body,
});
}
my $nu = LJ::load_userid($userid, "force");
# now flag as underage (and set O to mean was old or Y to mean was young)
$nu->underage(1, $ofage ? 'O' : 'Y', 'account creation') if $is_underage;
if ($LJ::TOS_CHECK) {
my $err = "";
$nu->tosagree_set(\$err)
or return LJ::bad_input($err);
}
# record create information
$nu->log_event('account_create', { remote => $remote });
$nu->make_login_session;
# local sites may want to override what happens at this point
my $redirect = undef;
my $stop_output;
LJ::run_hooks("create.bml_postsession", {
post => \%POST,
u => $nu,
redirect => \$redirect,
ret => \$ret,
stop_output => \$stop_output,
});
return BML::redirect($redirect) if $redirect;
return $ret if $stop_output;
$ret = " $email, 'username' => $user}) ." p?>";
my $uri = LJ::journal_base($nu);
$ret .= "\n";
$ret .= "$uri/ standout?>\n";
$ret .= "\n";
$ret .= "\n";
return $ret;
}
if ($mode eq "getinfo" || %errors)
{
my $ret;
my $v;
if (%errors) {
my @errors_order = ('code', 'username', 'email', 'password', 'agree_tos', 'captcha');
my %errors_def;
$errors_def{$_} = 1 for @errors_order;
foreach my $key (keys %errors) { push @errors_order, $key unless $errors_def{$key}; }
$ret .= "$ML{'.errors.label'}