mourningdove/cgi-bin/LJ/OpenID.pm

# 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.

package LJ::OpenID;

use strict;
use Digest::SHA1 qw(sha1 sha1_hex);
use LJ::OpenID::Cache;
use Net::OpenID::Server;
use Net::OpenID::Consumer;

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

    my %args = ( %{ $get || {} }, %{ $post || {} } );

    return Net::OpenID::Server->new(
        args => \%args,

        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",

        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 || {};

    # always use a paranoid useragent
    my $ua = LJ::get_useragent(
        role     => "OpenID",
        timeout  => 10,
        max_size => 1024 * 300,
    );

    my $cache = undef;
    if ( !$LJ::OPENID_STATELESS && scalar(@LJ::MEMCACHE_SERVERS) ) {
        $cache = LJ::OpenID::Cache->new;
    }

    my $csr = Net::OpenID::Consumer->new(
        ua              => $ua,
        args            => $get_args,
        cache           => $cache,
        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->is_person;

    # canonicalize trailing slash
    $ident .= "/" unless $ident =~ m!/$!;

    my $user = $u->user;
    my $url  = $u->journal_base . "/";

    return 1
        if $ident eq $url
        ||

        # legacy:
           $ident eq "$LJ::SITEROOT/users/$user/"
        || $ident eq "$LJ::SITEROOT/~$user/"
        || $ident eq "http://$user.$LJ::USER_DOMAIN/"
        || $ident eq "https://$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;

    # uncomment this if you need to bypass this check for testing purposes
    # 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$/i ) {
                    $tried_local_id = 1;
                    return 1;
                }
                return 0;
            }
        ]
    );
    return \$tried_local_id;
}

1;