ljr/local/cgi-bin/LJ/OpenID.pm

package LJ::OpenID;

use strict;
use Digest::SHA1 qw(sha1 sha1_hex);
use LWPx::ParanoidAgent;

BEGIN {
    $LJ::OPTMOD_OPENID_CONSUMER = $LJ::OPENID_CONSUMER ? eval "use Net::OpenID::Consumer; 1;" : 0;
    $LJ::OPTMOD_OPENID_SERVER   = $LJ::OPENID_SERVER   ? eval "use Net::OpenID::Server; 1;" : 0;
}

# returns boolean whether consumer support is enabled and available
sub consumer_enabled {
    return 0 unless $LJ::OPENID_CONSUMER;
    return $LJ::OPTMOD_OPENID_CONSUMER || eval "use Net::OpenID::Consumer; 1;";
}

# returns boolean whether consumer support is enabled and available
sub server_enabled {
    return 0 unless $LJ::OPENID_SERVER;
    return $LJ::OPTMOD_OPENID_CONSUMER || eval "use Net::OpenID::Server; 1;";
}

sub server {
    my ($get, $post) = @_;

    return Net::OpenID::Server->new(
                                    compat       => $LJ::OPENID_COMPAT,
                                    get_args     => $get  || {},
                                    post_args    => $post || {},

                                    get_user     => \&LJ::get_remote,
                                    is_identity  => sub {
                                        my ($u, $ident) = @_;
                                        return LJ::OpenID::is_identity($u, $ident, $get);
                                    },
                                    is_trusted   => \&LJ::OpenID::is_trusted,

                                    setup_url    => "$LJ::SITEROOT/openid/approve.bml",

                                    server_secret => \&LJ::OpenID::server_secret,
                                    secret_gen_interval => 3600,
                                    secret_expire_age   => 86400 * 14,
                                    );
}

# Returns a Consumer object
# When planning to verify identity, needs GET
# arguments passed in
sub consumer {
    my $get_args = shift || {};

    my $ua;
    unless ($LJ::IS_DEV_SERVER) {
        $ua = LWPx::ParanoidAgent->new(
                                       timeout => 10,
                                       max_size => 1024*300,
                                       );
    }

    my $csr = Net::OpenID::Consumer->new(
                                         ua => $ua,
                                         args => $get_args,
                                         cache => eval { LJ::MemCache::get_memcache() },
                                         consumer_secret => \&LJ::OpenID::consumer_secret,
                                         debug => $LJ::IS_DEV_SERVER || 0,
                                         required_root => $LJ::SITEROOT,
                                         );

    return $csr;
}

sub consumer_secret {
    my $time = shift;
    return server_secret($time - $time % 3600);
}

sub server_secret {
    my $time = shift;
    my ($t2, $secret) = LJ::get_secret($time);
    die "ASSERT: didn't get t2 (t1=$time)" unless $t2;
    die "ASSERT: didn't get secret (t2=$t2)" unless $secret;
    die "ASSERT: time($time) != t2($t2)\n" unless $t2 == $time;
    return $secret;
}

sub is_trusted {
    my ($u, $trust_root, $is_identity) = @_;
    return 0 unless $u;
    # we always look up $is_trusted, even if $is_identity is false, to avoid timing attacks

    my $dbh = LJ::get_db_writer();
    my ($endpointid, $duration) = $dbh->selectrow_array("SELECT t.endpoint_id, t.duration ".
                                                        "FROM openid_trust t, openid_endpoint e ".
                                                        "WHERE t.userid=? AND t.endpoint_id=e.endpoint_id AND e.url=?",
                                                        undef, $u->{userid}, $trust_root);
    return 0 unless $endpointid;
    return 1;
}

sub is_identity {
    my ($u, $ident, $get) = @_;
    return 0 unless $u && $u->{journaltype} eq "P";

    my $user = $u->{user};
    return 1 if
        $ident eq "$LJ::SITEROOT/users/$user/" ||
        $ident eq "$LJ::SITEROOT/~$user/" ||
        $ident eq "http://$user.$LJ::USER_DOMAIN/";

    return 0;
}

sub getmake_endpointid {
    my $site = shift;

    my $dbh = LJ::get_db_writer()
        or return undef;

    my $rv = $dbh->do("INSERT IGNORE INTO openid_endpoint (url) VALUES (?)", undef, $site);
    my $end_id;
    if ($rv > 0) {
        $end_id = $dbh->{'mysql_insertid'};
    } else {
        $end_id = $dbh->selectrow_array("SELECT endpoint_id FROM openid_endpoint WHERE url=?",
                                        undef, $site);
    }
    return $end_id;
}

sub add_trust {
    my ($u, $site) = @_;

    my $end_id = LJ::OpenID::getmake_endpointid($site)
        or return 0;

    my $dbh = LJ::get_db_writer()
        or return undef;

    my $rv = $dbh->do("REPLACE INTO openid_trust (userid, endpoint_id, duration, trust_time) ".
                      "VALUES (?,?,?,UNIX_TIMESTAMP())", undef, $u->{userid}, $end_id, "always");
    return $rv;
}

# From Digest::HMAC
sub hmac_sha1_hex {
    unpack("H*", &hmac_sha1);
}
sub hmac_sha1 {
    hmac($_[0], $_[1], \&sha1, 64);
}
sub hmac {
    my($data, $key, $hash_func, $block_size) = @_;
    $block_size ||= 64;
    $key = &$hash_func($key) if length($key) > $block_size;

    my $k_ipad = $key ^ (chr(0x36) x $block_size);
    my $k_opad = $key ^ (chr(0x5c) x $block_size);

    &$hash_func($k_opad, &$hash_func($k_ipad, $data));
}

# Returns 1 if destination identity server
# is blocked
sub blocked_hosts {
    my $csr = shift;

    return do { my $dummy = 0; \$dummy; } if $LJ::IS_DEV_SERVER;

    my $tried_local_id = 0;
    $csr->ua->blocked_hosts(
                            sub {
                                my $dest = shift;

                                if ($dest =~ /((^|\.)\Q$LJ::DOMAIN\E$|demotivation\.me|anonymity\.com)/i) {
                                    $tried_local_id = 1;
                                    return 1;
                                }
                                return 0;
                            });
    return \$tried_local_id;
}

1;