From e18b0ccc55ae43b58052110f16e2591f2feea905 Mon Sep 17 00:00:00 2001 From: Kareila Date: Tue, 27 Jan 2015 22:04:42 -0600 Subject: [PATCH 1/2] [Bug 3965] move comment-related functions to LJ/Entry.pm This moves LJ::get_talktext2 next to similar LJ::get_logtext2, and LJ::load_talk_props2 next to similar load_log_props2. Pretty sure everything that uses these functions already relies on LJ::Entry being loaded, so no further tweaks should be needed. --- cgi-bin/LJ/Entry.pm | 156 +++++++++++++++++++++++++++++++++++++++++++- cgi-bin/ljlib.pl | 150 ------------------------------------------ 2 files changed, 153 insertions(+), 153 deletions(-) diff --git a/cgi-bin/LJ/Entry.pm b/cgi-bin/LJ/Entry.pm index 5b51fa6f19..f317b69adf 100644 --- a/cgi-bin/LJ/Entry.pm +++ b/cgi-bin/LJ/Entry.pm @@ -543,7 +543,7 @@ sub slug { croak $u->errstr if $u->err; LJ::MemCache::set( [ $jid, "logslug:$jid:$self->{jitemid}" ], $slug ); - + $self->{_loaded_slug} = 1; return $self->{slug} = $slug; } @@ -610,9 +610,9 @@ sub _load_comments { $row->{nodetype} = "L"; $row->{nodeid} = $nodeid; $comment->absorb_row(%$row); - + push @comment_list, $comment; - } + } $self->set_comment_list( @comment_list ); return $self; @@ -2044,6 +2044,70 @@ sub load_log_props2 } +# +# name: LJ::load_talk_props2 +# class: +# des: +# info: +# args: +# des-: +# returns: +# +sub load_talk_props2 +{ + my $db = LJ::DB::isdb( $_[0] ) ? shift @_ : undef; + my ($uuserid, $listref, $hashref) = @_; + + my $userid = want_userid($uuserid); + my $u = ref $uuserid ? $uuserid : undef; + + $hashref = {} unless ref $hashref eq "HASH"; + + my %need; + my @memkeys; + foreach (@$listref) { + my $id = $_+0; + $need{$id} = 1; + push @memkeys, [$userid,"talkprop:$userid:$id"]; + } + return $hashref unless %need; + + my $mem = LJ::MemCache::get_multi(@memkeys) || {}; + + # allow hooks to count memcaches in this function for testing + if ($LJ::_T_GET_TALK_PROPS2_MEMCACHE) { + $LJ::_T_GET_TALK_PROPS2_MEMCACHE->(); + } + + while (my ($k, $v) = each %$mem) { + next unless $k =~ /(\d+):(\d+)/ && ref $v eq "HASH"; + delete $need{$2}; + $hashref->{$2}->{$_[0]} = $_[1] while @_ = each %$v; + } + return $hashref unless %need; + + if (!$db || @LJ::MEMCACHE_SERVERS) { + $u ||= LJ::load_userid($userid); + $db = @LJ::MEMCACHE_SERVERS ? LJ::get_cluster_def_reader($u) : LJ::get_cluster_reader($u); + return $hashref unless $db; + } + + LJ::load_props("talk"); + my $in = join(',', keys %need); + my $sth = $db->prepare("SELECT jtalkid, tpropid, value FROM talkprop2 ". + "WHERE journalid=? AND jtalkid IN ($in)"); + $sth->execute($userid); + while (my ($jtalkid, $propid, $value) = $sth->fetchrow_array) { + my $p = $LJ::CACHE_PROPID{'talk'}->{$propid}; + next unless $p; + $hashref->{$jtalkid}->{$p->{'name'}} = $value; + } + foreach my $id (keys %need) { + LJ::MemCache::set([$userid,"talkprop:$userid:$id"], $hashref->{$id} || {}); + } + return $hashref; +} + # # name: LJ::delete_all_comments # des: deletes all comments from a post, permanently, for when a post is deleted @@ -2394,6 +2458,92 @@ sub get_logtext2 return $lt; } +# +# name: LJ::get_talktext2 +# des: Retrieves comment text. Tries slave servers first, then master. +# info: Efficiently retrieves batches of comment text. Will try alternate +# servers first. See also [func[LJ::get_logtext2]]. +# returns: Hashref with the talkids as keys, values being [ $subject, $event ]. +# args: u, opts?, jtalkids +# des-opts: A hashref of options. 'onlysubjects' will only retrieve subjects. +# des-jtalkids: A list of talkids to get text for. +# +sub get_talktext2 +{ + my $u = shift; + my $clusterid = $u->{'clusterid'}; + my $journalid = $u->{'userid'}+0; + + my $opts = ref $_[0] ? shift : {}; + + # return structure. + my $lt = {}; + return $lt unless $clusterid; + + # keep track of itemids we still need to load. + my %need; + my @mem_keys; + foreach (@_) { + my $id = $_+0; + $need{$id} = 1; + push @mem_keys, [$journalid,"talksubject:$clusterid:$journalid:$id"]; + unless ($opts->{'onlysubjects'}) { + push @mem_keys, [$journalid,"talkbody:$clusterid:$journalid:$id"]; + } + } + + # try the memory cache + my $mem = LJ::MemCache::get_multi(@mem_keys) || {}; + + if ($LJ::_T_GET_TALK_TEXT2_MEMCACHE) { + $LJ::_T_GET_TALK_TEXT2_MEMCACHE->(); + } + + while (my ($k, $v) = each %$mem) { + $k =~ /^talk(.*):(\d+):(\d+):(\d+)/; + if ($opts->{'onlysubjects'} && $1 eq "subject") { + delete $need{$4}; + $lt->{$4} = [ $v ]; + } + if (! $opts->{'onlysubjects'} && $1 eq "body" && + exists $mem->{"talksubject:$2:$3:$4"}) { + delete $need{$4}; + $lt->{$4} = [ $mem->{"talksubject:$2:$3:$4"}, $v ]; + } + } + return $lt unless %need; + + my $bodycol = $opts->{'onlysubjects'} ? "" : ", body"; + + # pass 1 (slave) and pass 2 (master) + foreach my $pass (1, 2) { + next unless %need; + my $db = $pass == 1 ? LJ::get_cluster_reader($clusterid) : + LJ::get_cluster_def_reader($clusterid); + + unless ($db) { + next if $pass == 1; + die "Could not get db handle"; + } + + my $in = join(",", keys %need); + my $sth = $db->prepare("SELECT jtalkid, subject $bodycol FROM talktext2 ". + "WHERE journalid=$journalid AND jtalkid IN ($in)"); + $sth->execute; + while (my ($id, $subject, $body) = $sth->fetchrow_array) { + $subject = "" unless defined $subject; + $body = "" unless defined $body; + LJ::text_uncompress(\$body); + $lt->{$id} = [ $subject, $body ]; + LJ::MemCache::add([$journalid,"talkbody:$clusterid:$journalid:$id"], $body) + unless $opts->{'onlysubjects'}; + LJ::MemCache::add([$journalid,"talksubject:$clusterid:$journalid:$id"], $subject); + delete $need{$id}; + } + } + return $lt; +} + # # name: LJ::item_link # class: component diff --git a/cgi-bin/ljlib.pl b/cgi-bin/ljlib.pl index 694be41b8f..57cf7da386 100644 --- a/cgi-bin/ljlib.pl +++ b/cgi-bin/ljlib.pl @@ -702,92 +702,6 @@ sub challenge_check_login } -# -# name: LJ::get_talktext2 -# des: Retrieves comment text. Tries slave servers first, then master. -# info: Efficiently retrieves batches of comment text. Will try alternate -# servers first. See also [func[LJ::get_logtext2]]. -# returns: Hashref with the talkids as keys, values being [ $subject, $event ]. -# args: u, opts?, jtalkids -# des-opts: A hashref of options. 'onlysubjects' will only retrieve subjects. -# des-jtalkids: A list of talkids to get text for. -# -sub get_talktext2 -{ - my $u = shift; - my $clusterid = $u->{'clusterid'}; - my $journalid = $u->{'userid'}+0; - - my $opts = ref $_[0] ? shift : {}; - - # return structure. - my $lt = {}; - return $lt unless $clusterid; - - # keep track of itemids we still need to load. - my %need; - my @mem_keys; - foreach (@_) { - my $id = $_+0; - $need{$id} = 1; - push @mem_keys, [$journalid,"talksubject:$clusterid:$journalid:$id"]; - unless ($opts->{'onlysubjects'}) { - push @mem_keys, [$journalid,"talkbody:$clusterid:$journalid:$id"]; - } - } - - # try the memory cache - my $mem = LJ::MemCache::get_multi(@mem_keys) || {}; - - if ($LJ::_T_GET_TALK_TEXT2_MEMCACHE) { - $LJ::_T_GET_TALK_TEXT2_MEMCACHE->(); - } - - while (my ($k, $v) = each %$mem) { - $k =~ /^talk(.*):(\d+):(\d+):(\d+)/; - if ($opts->{'onlysubjects'} && $1 eq "subject") { - delete $need{$4}; - $lt->{$4} = [ $v ]; - } - if (! $opts->{'onlysubjects'} && $1 eq "body" && - exists $mem->{"talksubject:$2:$3:$4"}) { - delete $need{$4}; - $lt->{$4} = [ $mem->{"talksubject:$2:$3:$4"}, $v ]; - } - } - return $lt unless %need; - - my $bodycol = $opts->{'onlysubjects'} ? "" : ", body"; - - # pass 1 (slave) and pass 2 (master) - foreach my $pass (1, 2) { - next unless %need; - my $db = $pass == 1 ? LJ::get_cluster_reader($clusterid) : - LJ::get_cluster_def_reader($clusterid); - - unless ($db) { - next if $pass == 1; - die "Could not get db handle"; - } - - my $in = join(",", keys %need); - my $sth = $db->prepare("SELECT jtalkid, subject $bodycol FROM talktext2 ". - "WHERE journalid=$journalid AND jtalkid IN ($in)"); - $sth->execute; - while (my ($id, $subject, $body) = $sth->fetchrow_array) { - $subject = "" unless defined $subject; - $body = "" unless defined $body; - LJ::text_uncompress(\$body); - $lt->{$id} = [ $subject, $body ]; - LJ::MemCache::add([$journalid,"talkbody:$clusterid:$journalid:$id"], $body) - unless $opts->{'onlysubjects'}; - LJ::MemCache::add([$journalid,"talksubject:$clusterid:$journalid:$id"], $subject); - delete $need{$id}; - } - } - return $lt; -} - # # name: LJ::clear_caches # des: This function is called from a HUP signal handler and is intentionally @@ -1017,70 +931,6 @@ sub flush_cleanup_handlers { } } -# -# name: LJ::load_talk_props2 -# class: -# des: -# info: -# args: -# des-: -# returns: -# -sub load_talk_props2 -{ - my $db = LJ::DB::isdb( $_[0] ) ? shift @_ : undef; - my ($uuserid, $listref, $hashref) = @_; - - my $userid = want_userid($uuserid); - my $u = ref $uuserid ? $uuserid : undef; - - $hashref = {} unless ref $hashref eq "HASH"; - - my %need; - my @memkeys; - foreach (@$listref) { - my $id = $_+0; - $need{$id} = 1; - push @memkeys, [$userid,"talkprop:$userid:$id"]; - } - return $hashref unless %need; - - my $mem = LJ::MemCache::get_multi(@memkeys) || {}; - - # allow hooks to count memcaches in this function for testing - if ($LJ::_T_GET_TALK_PROPS2_MEMCACHE) { - $LJ::_T_GET_TALK_PROPS2_MEMCACHE->(); - } - - while (my ($k, $v) = each %$mem) { - next unless $k =~ /(\d+):(\d+)/ && ref $v eq "HASH"; - delete $need{$2}; - $hashref->{$2}->{$_[0]} = $_[1] while @_ = each %$v; - } - return $hashref unless %need; - - if (!$db || @LJ::MEMCACHE_SERVERS) { - $u ||= LJ::load_userid($userid); - $db = @LJ::MEMCACHE_SERVERS ? LJ::get_cluster_def_reader($u) : LJ::get_cluster_reader($u); - return $hashref unless $db; - } - - LJ::load_props("talk"); - my $in = join(',', keys %need); - my $sth = $db->prepare("SELECT jtalkid, tpropid, value FROM talkprop2 ". - "WHERE journalid=? AND jtalkid IN ($in)"); - $sth->execute($userid); - while (my ($jtalkid, $propid, $value) = $sth->fetchrow_array) { - my $p = $LJ::CACHE_PROPID{'talk'}->{$propid}; - next unless $p; - $hashref->{$jtalkid}->{$p->{'name'}} = $value; - } - foreach my $id (keys %need) { - LJ::MemCache::set([$userid,"talkprop:$userid:$id"], $hashref->{$id} || {}); - } - return $hashref; -} - my $work_open = 0; sub work_report_start { $work_open = 1; work_report("start"); } sub work_report_end { return unless $work_open; work_report("end"); $work_open = 0; } From 10cd1b73d8def5827d550d69aa26a4bd6313526d Mon Sep 17 00:00:00 2001 From: Kareila Date: Tue, 27 Jan 2015 22:35:09 -0600 Subject: [PATCH 2/2] [Bug 3965] move auth-related functions from ljlib.pl into LJ/Auth.pm This is a straightforward cut and paste job - very little style review. I did reorder the functions so they would be listed alphabetically within their section of the new file. --- cgi-bin/LJ/Auth.pm | 275 +++++++++++++++++++++++++++++++++++++++++++- cgi-bin/ljlib.pl | 281 +-------------------------------------------- 2 files changed, 275 insertions(+), 281 deletions(-) diff --git a/cgi-bin/LJ/Auth.pm b/cgi-bin/LJ/Auth.pm index 9372f6cfcf..7f3f305088 100644 --- a/cgi-bin/LJ/Auth.pm +++ b/cgi-bin/LJ/Auth.pm @@ -79,7 +79,7 @@ sub check_ajax_auth_token { my $realsig = sha1_hex($chalbare, $secret); return 0 unless $realsig eq $chalsig; - return 0 unless + return 0 unless $remoteid == $req_remoteid && # remote id matches or logged-out 0=0 $sessid == $req_sessid && # remote sessid or logged-out uniq cookie match $uri eq $chal_uri && # uri matches @@ -134,4 +134,277 @@ sub check_sessionless_auth_token { return 1; } +# move over auth-related functions from ljlib.pl + +package LJ; + +use Digest::MD5 (); + +# +# name: LJ::auth_okay +# des: Validates a user's password. The "clear" or "md5" argument +# must be present, and either the "actual" argument (the correct +# password) must be set, or the first argument must be a user +# object ($u) with the 'password' key set. This is the preferred +# way to validate a password (as opposed to doing it by hand). +# returns: boolean; 1 if authentication succeeded, 0 on failure +# args: u, clear, md5, actual?, ip_banned? +# des-clear: Clear text password the client is sending. (need this or md5) +# des-md5: MD5 of the password the client is sending. (need this or clear). +# If this value instead of clear, clear can be anything, as md5 +# validation will take precedence. +# des-actual: The actual password for the user. Ignored if a pluggable +# authenticator is being used. Required unless the first +# argument is a user object instead of a username scalar. +# des-ip_banned: Optional scalar ref which this function will set to true +# if IP address of remote user is banned. +# +sub auth_okay { + my ( $u, $clear, $md5, $actual, $ip_banned ) = @_; + return 0 unless LJ::isu($u); + + $actual ||= $u->password; + + my $user = $u->{'user'}; + + # set the IP banned flag, if it was provided. + my $fake_scalar; + my $ref = ref $ip_banned ? $ip_banned : \$fake_scalar; + if (LJ::login_ip_banned($u)) { + $$ref = 1; + return 0; + } else { + $$ref = 0; + } + + my $bad_login = sub { + LJ::handle_bad_login($u); + return 0; + }; + + ## LJ default authorization: + return 0 unless $actual; + return 1 if $md5 && lc($md5) eq Digest::MD5::md5_hex($actual); + return 1 if $clear eq $actual; + return $bad_login->(); +} + +# Validate a challenge string previously supplied by challenge_generate +# return 1 "good" 0 "bad", plus sets keys in $opts: +# 'valid'=1/0 whether the string itself was valid +# 'expired'=1/0 whether the challenge expired, provided it's valid +# 'count'=N number of times we've seen this challenge, including this one, +# provided it's valid and not expired +# $opts also supports in parameters: +# 'dont_check_count' => if true, won't return a count field +# the return value is 1 if 'valid' and not 'expired' and 'count'==1 +sub challenge_check { + my ($chal, $opts) = @_; + my ($valid, $expired, $count) = (1, 0, 0); + + my ($c_ver, $stime, $s_age, $goodfor, $rand, $chalsig) = split /:/, $chal; + my $secret = LJ::get_secret($stime); + my $chalbare = "$c_ver:$stime:$s_age:$goodfor:$rand"; + + # Validate token + $valid = 0 + unless $secret && $c_ver eq 'c0'; # wrong version + $valid = 0 + unless Digest::MD5::md5_hex($chalbare . $secret) eq $chalsig; + + $expired = 1 + unless (not $valid) or time() - ($stime + $s_age) < $goodfor; + + # Check for token dups + if ($valid && !$expired && !$opts->{dont_check_count}) { + if (@LJ::MEMCACHE_SERVERS) { + $count = LJ::MemCache::incr("chaltoken:$chal", 1); + unless ($count) { + LJ::MemCache::add("chaltoken:$chal", 1, $goodfor); + $count = 1; + } + } else { + my $dbh = LJ::get_db_writer(); + my $rv = $dbh->do("SELECT GET_LOCK(?,5)", undef, $chal); + if ($rv) { + $count = $dbh->selectrow_array("SELECT count FROM challenges WHERE challenge=?", + undef, $chal); + if ($count) { + $dbh->do("UPDATE challenges SET count=count+1 WHERE challenge=?", + undef, $chal); + $count++; + } else { + $dbh->do("INSERT INTO challenges SET ctime=?, challenge=?, count=1", + undef, $stime + $s_age, $chal); + $count = 1; + } + } + $dbh->do("SELECT RELEASE_LOCK(?)", undef, $chal); + } + # if we couldn't get the count (means we couldn't store either) + # , consider it invalid + $valid = 0 unless $count; + } + + if ($opts) { + $opts->{'expired'} = $expired; + $opts->{'valid'} = $valid; + $opts->{'count'} = $count; + } + + return ($valid && !$expired && ($count==1 || $opts->{dont_check_count})); +} + +# Validate login/talk md5 responses. +# Return 1 on valid, 0 on invalid. +sub challenge_check_login { + my ($u, $chal, $res, $banned, $opts) = @_; + return 0 unless $u; + my $pass = $u->password; + return 0 if $pass eq ""; + + # set the IP banned flag, if it was provided. + my $fake_scalar; + my $ref = ref $banned ? $banned : \$fake_scalar; + if (LJ::login_ip_banned($u)) { + $$ref = 1; + return 0; + } else { + $$ref = 0; + } + + # check the challenge string validity + return 0 unless LJ::challenge_check($chal, $opts); + + # Validate password + my $hashed = Digest::MD5::md5_hex($chal . Digest::MD5::md5_hex($pass)); + if ($hashed eq $res) { + return 1; + } else { + LJ::handle_bad_login($u); + return 0; + } +} + +# Create a challenge token for secure logins +sub challenge_generate { + my ($goodfor, $attr) = @_; + + $goodfor ||= 60; + $attr ||= LJ::rand_chars(20); + + my ($stime, $secret) = LJ::get_secret(); + + # challenge version, secret time, secret age, time in secs token is good for, random chars. + my $s_age = time() - $stime; + my $chalbare = "c0:$stime:$s_age:$goodfor:$attr"; + my $chalsig = Digest::MD5::md5_hex($chalbare . $secret); + my $chal = "$chalbare:$chalsig"; + + return $chal; +} + +sub get_authaction { + my ($id, $action, $arg1, $opts) = @_; + + my $dbh = $opts->{force} ? LJ::get_db_writer() : LJ::get_db_reader(); + return $dbh->selectrow_hashref("SELECT aaid, authcode, datecreate FROM authactions " . + "WHERE userid=? AND arg1=? AND action=? AND used='N' LIMIT 1", + undef, $id, $arg1, $action); +} + +# Return challenge info. +# This could grow later - for now just return the rand chars used. +sub get_challenge_attributes { + return (split /:/, shift)[4]; +} + +# +# name: LJ::is_valid_authaction +# des: Validates a shared secret (authid/authcode pair) +# info: See [func[LJ::register_authaction]]. +# returns: Hashref of authaction row from database. +# args: dbarg?, aaid, auth +# des-aaid: Integer; the authaction ID. +# des-auth: String; the auth string. (random chars the client already got) +# +sub is_valid_authaction { + # we use the master db to avoid races where authactions could be + # used multiple times + my $dbh = LJ::get_db_writer(); + my ($aaid, $auth) = @_; + return $dbh->selectrow_hashref("SELECT * FROM authactions WHERE aaid=? AND authcode=?", + undef, $aaid, $auth); +} + +# +# name: LJ::make_auth_code +# des: Makes a random string of characters of a given length. +# returns: string of random characters, from an alphabet of 30 +# letters & numbers which aren't easily confused. +# args: length +# des-length: length of auth code to return +# +sub make_auth_code { + my $length = shift; + my $digits = "abcdefghjkmnpqrstvwxyz23456789"; + my $auth; + for (1..$length) { $auth .= substr($digits, int(rand(30)), 1); } + return $auth; +} + +# +# name: LJ::mark_authaction_used +# des: Marks an authaction as being used. +# args: aaid +# des-aaid: Either an authaction hashref or the id of the authaction to mark used. +# returns: 1 on success, undef on error. +# +sub mark_authaction_used { + my $aaid = ref $_[0] ? $_[0]->{aaid}+0 : $_[0]+0 + or return undef; + my $dbh = LJ::get_db_writer() + or return undef; + $dbh->do("UPDATE authactions SET used='Y' WHERE aaid = ?", undef, $aaid); + return undef if $dbh->err; + return 1; +} + +# +# name: LJ::register_authaction +# des: Registers a secret to have the user validate. +# info: Some things, like requiring a user to validate their e-mail address, require +# making up a secret, mailing it to the user, then requiring them to give it +# back (usually in a URL you make for them) to prove they got it. This +# function creates a secret, attaching what it's for and an optional argument. +# Background maintenance jobs keep track of cleaning up old unvalidated secrets. +# args: dbarg?, userid, action, arg? +# des-userid: Userid of user to register authaction for. +# des-action: Action type to register. Max chars: 50. +# des-arg: Optional argument to attach to the action. Max chars: 255. +# returns: 0 if there was an error. Otherwise, a hashref +# containing keys 'aaid' (the authaction ID) and the 'authcode', +# a 15 character string of random characters from +# [func[LJ::make_auth_code]]. +# +sub register_authaction { + my $dbh = LJ::get_db_writer(); + + my $userid = shift; $userid += 0; + my $action = $dbh->quote(shift); + my $arg1 = $dbh->quote(shift); + + # make the authcode + my $authcode = LJ::make_auth_code(15); + my $qauthcode = $dbh->quote($authcode); + + $dbh->do("INSERT INTO authactions (aaid, userid, datecreate, authcode, action, arg1) ". + "VALUES (NULL, $userid, NOW(), $qauthcode, $action, $arg1)"); + + return 0 if $dbh->err; + return { 'aaid' => $dbh->{'mysql_insertid'}, + 'authcode' => $authcode, + }; +} + 1; diff --git a/cgi-bin/ljlib.pl b/cgi-bin/ljlib.pl index 57cf7da386..d294e4a137 100644 --- a/cgi-bin/ljlib.pl +++ b/cgi-bin/ljlib.pl @@ -64,6 +64,7 @@ BEGIN use LJ::Hooks; use LJ::MemCache; use LJ::Error; +use LJ::Auth; # has a bunch of pkg LJ functions at bottom use LJ::User; # has a bunch of pkg LJ, non-OO methods at bottom use LJ::Entry; # has a bunch of pkg LJ, non-OO methods at bottom use LJ::Global::Constants; # formerly LJ::Constants @@ -304,106 +305,6 @@ sub gtop { } -# -# name: LJ::register_authaction -# des: Registers a secret to have the user validate. -# info: Some things, like requiring a user to validate their e-mail address, require -# making up a secret, mailing it to the user, then requiring them to give it -# back (usually in a URL you make for them) to prove they got it. This -# function creates a secret, attaching what it's for and an optional argument. -# Background maintenance jobs keep track of cleaning up old unvalidated secrets. -# args: dbarg?, userid, action, arg? -# des-userid: Userid of user to register authaction for. -# des-action: Action type to register. Max chars: 50. -# des-arg: Optional argument to attach to the action. Max chars: 255. -# returns: 0 if there was an error. Otherwise, a hashref -# containing keys 'aaid' (the authaction ID) and the 'authcode', -# a 15 character string of random characters from -# [func[LJ::make_auth_code]]. -# -sub register_authaction { - my $dbh = LJ::get_db_writer(); - - my $userid = shift; $userid += 0; - my $action = $dbh->quote(shift); - my $arg1 = $dbh->quote(shift); - - # make the authcode - my $authcode = LJ::make_auth_code(15); - my $qauthcode = $dbh->quote($authcode); - - $dbh->do("INSERT INTO authactions (aaid, userid, datecreate, authcode, action, arg1) ". - "VALUES (NULL, $userid, NOW(), $qauthcode, $action, $arg1)"); - - return 0 if $dbh->err; - return { 'aaid' => $dbh->{'mysql_insertid'}, - 'authcode' => $authcode, - }; -} - -sub get_authaction { - my ($id, $action, $arg1, $opts) = @_; - - my $dbh = $opts->{force} ? LJ::get_db_writer() : LJ::get_db_reader(); - return $dbh->selectrow_hashref("SELECT aaid, authcode, datecreate FROM authactions " . - "WHERE userid=? AND arg1=? AND action=? AND used='N' LIMIT 1", - undef, $id, $arg1, $action); -} - - -# -# name: LJ::is_valid_authaction -# des: Validates a shared secret (authid/authcode pair) -# info: See [func[LJ::register_authaction]]. -# returns: Hashref of authaction row from database. -# args: dbarg?, aaid, auth -# des-aaid: Integer; the authaction ID. -# des-auth: String; the auth string. (random chars the client already got) -# -sub is_valid_authaction { - # we use the master db to avoid races where authactions could be - # used multiple times - my $dbh = LJ::get_db_writer(); - my ($aaid, $auth) = @_; - return $dbh->selectrow_hashref("SELECT * FROM authactions WHERE aaid=? AND authcode=?", - undef, $aaid, $auth); -} - -# -# name: LJ::mark_authaction_used -# des: Marks an authaction as being used. -# args: aaid -# des-aaid: Either an authaction hashref or the id of the authaction to mark used. -# returns: 1 on success, undef on error. -# -sub mark_authaction_used -{ - my $aaid = ref $_[0] ? $_[0]->{aaid}+0 : $_[0]+0 - or return undef; - my $dbh = LJ::get_db_writer() - or return undef; - $dbh->do("UPDATE authactions SET used='Y' WHERE aaid = ?", undef, $aaid); - return undef if $dbh->err; - return 1; -} - -# -# name: LJ::make_auth_code -# des: Makes a random string of characters of a given length. -# returns: string of random characters, from an alphabet of 30 -# letters & numbers which aren't easily confused. -# args: length -# des-length: length of auth code to return -# -sub make_auth_code -{ - my $length = shift; - my $digits = "abcdefghjkmnpqrstvwxyz23456789"; - my $auth; - for (1..$length) { $auth .= substr($digits, int(rand(30)), 1); } - return $auth; -} - # Loads and caches one or more of the various *proplist (and ratelist) # tables, which describe the various meta-data that can be stored on log # (journal) items, comments, users, media, etc. @@ -522,186 +423,6 @@ sub load_codes { } } -# -# name: LJ::auth_okay -# des: Validates a user's password. The "clear" or "md5" argument -# must be present, and either the "actual" argument (the correct -# password) must be set, or the first argument must be a user -# object ($u) with the 'password' key set. This is the preferred -# way to validate a password (as opposed to doing it by hand). -# returns: boolean; 1 if authentication succeeded, 0 on failure -# args: u, clear, md5, actual?, ip_banned? -# des-clear: Clear text password the client is sending. (need this or md5) -# des-md5: MD5 of the password the client is sending. (need this or clear). -# If this value instead of clear, clear can be anything, as md5 -# validation will take precedence. -# des-actual: The actual password for the user. Ignored if a pluggable -# authenticator is being used. Required unless the first -# argument is a user object instead of a username scalar. -# des-ip_banned: Optional scalar ref which this function will set to true -# if IP address of remote user is banned. -# -sub auth_okay -{ - my $u = shift; - my $clear = shift; - my $md5 = shift; - my $actual = shift; - my $ip_banned = shift; - return 0 unless isu($u); - - $actual ||= $u->password; - - my $user = $u->{'user'}; - - # set the IP banned flag, if it was provided. - my $fake_scalar; - my $ref = ref $ip_banned ? $ip_banned : \$fake_scalar; - if (LJ::login_ip_banned($u)) { - $$ref = 1; - return 0; - } else { - $$ref = 0; - } - - my $bad_login = sub { - LJ::handle_bad_login($u); - return 0; - }; - - ## LJ default authorization: - return 0 unless $actual; - return 1 if $md5 && lc($md5) eq Digest::MD5::md5_hex($actual); - return 1 if $clear eq $actual; - return $bad_login->(); -} - -# Create a challenge token for secure logins -sub challenge_generate -{ - my ($goodfor, $attr) = @_; - - $goodfor ||= 60; - $attr ||= LJ::rand_chars(20); - - my ($stime, $secret) = LJ::get_secret(); - - # challenge version, secret time, secret age, time in secs token is good for, random chars. - my $s_age = time() - $stime; - my $chalbare = "c0:$stime:$s_age:$goodfor:$attr"; - my $chalsig = Digest::MD5::md5_hex($chalbare . $secret); - my $chal = "$chalbare:$chalsig"; - - return $chal; -} - -# Return challenge info. -# This could grow later - for now just return the rand chars used. -sub get_challenge_attributes -{ - return (split /:/, shift)[4]; -} - -# Validate a challenge string previously supplied by challenge_generate -# return 1 "good" 0 "bad", plus sets keys in $opts: -# 'valid'=1/0 whether the string itself was valid -# 'expired'=1/0 whether the challenge expired, provided it's valid -# 'count'=N number of times we've seen this challenge, including this one, -# provided it's valid and not expired -# $opts also supports in parameters: -# 'dont_check_count' => if true, won't return a count field -# the return value is 1 if 'valid' and not 'expired' and 'count'==1 -sub challenge_check { - my ($chal, $opts) = @_; - my ($valid, $expired, $count) = (1, 0, 0); - - my ($c_ver, $stime, $s_age, $goodfor, $rand, $chalsig) = split /:/, $chal; - my $secret = LJ::get_secret($stime); - my $chalbare = "$c_ver:$stime:$s_age:$goodfor:$rand"; - - # Validate token - $valid = 0 - unless $secret && $c_ver eq 'c0'; # wrong version - $valid = 0 - unless Digest::MD5::md5_hex($chalbare . $secret) eq $chalsig; - - $expired = 1 - unless (not $valid) or time() - ($stime + $s_age) < $goodfor; - - # Check for token dups - if ($valid && !$expired && !$opts->{dont_check_count}) { - if (@LJ::MEMCACHE_SERVERS) { - $count = LJ::MemCache::incr("chaltoken:$chal", 1); - unless ($count) { - LJ::MemCache::add("chaltoken:$chal", 1, $goodfor); - $count = 1; - } - } else { - my $dbh = LJ::get_db_writer(); - my $rv = $dbh->do("SELECT GET_LOCK(?,5)", undef, $chal); - if ($rv) { - $count = $dbh->selectrow_array("SELECT count FROM challenges WHERE challenge=?", - undef, $chal); - if ($count) { - $dbh->do("UPDATE challenges SET count=count+1 WHERE challenge=?", - undef, $chal); - $count++; - } else { - $dbh->do("INSERT INTO challenges SET ctime=?, challenge=?, count=1", - undef, $stime + $s_age, $chal); - $count = 1; - } - } - $dbh->do("SELECT RELEASE_LOCK(?)", undef, $chal); - } - # if we couldn't get the count (means we couldn't store either) - # , consider it invalid - $valid = 0 unless $count; - } - - if ($opts) { - $opts->{'expired'} = $expired; - $opts->{'valid'} = $valid; - $opts->{'count'} = $count; - } - - return ($valid && !$expired && ($count==1 || $opts->{dont_check_count})); -} - - -# Validate login/talk md5 responses. -# Return 1 on valid, 0 on invalid. -sub challenge_check_login -{ - my ($u, $chal, $res, $banned, $opts) = @_; - return 0 unless $u; - my $pass = $u->password; - return 0 if $pass eq ""; - - # set the IP banned flag, if it was provided. - my $fake_scalar; - my $ref = ref $banned ? $banned : \$fake_scalar; - if (LJ::login_ip_banned($u)) { - $$ref = 1; - return 0; - } else { - $$ref = 0; - } - - # check the challenge string validity - return 0 unless LJ::challenge_check($chal, $opts); - - # Validate password - my $hashed = Digest::MD5::md5_hex($chal . Digest::MD5::md5_hex($pass)); - if ($hashed eq $res) { - return 1; - } else { - LJ::handle_bad_login($u); - return 0; - } -} - - # # name: LJ::clear_caches # des: This function is called from a HUP signal handler and is intentionally